mirror of
https://github.com/HeidiSQL/HeidiSQL.git
synced 2026-03-13 09:24:25 +08:00
494 lines
15 KiB
ObjectPascal
494 lines
15 KiB
ObjectPascal
unit extfiledialog;
|
|
|
|
{$mode delphi}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, LCLType, Forms, Controls, Graphics, Dialogs,
|
|
ExtCtrls, StdCtrls, ShellCtrls, ComCtrls, apphelpers, extra_controls, Math, generic_types;
|
|
|
|
type
|
|
|
|
{ TfrmExtFileDialog }
|
|
|
|
TfrmExtFileDialog = class(TExtForm)
|
|
btnCancel: TButton;
|
|
btnOk: TButton;
|
|
comboLineBreaks: TComboBox;
|
|
comboEncoding: TComboBox;
|
|
comboFileType: TComboBox;
|
|
editFilename: TEdit;
|
|
IdleTimerTreeNodeScrolltoview: TIdleTimer;
|
|
lblPath: TLabel;
|
|
lblLinebreaks: TLabel;
|
|
lblEncoding: TLabel;
|
|
lblFilename: TLabel;
|
|
pnlBottom: TPanel;
|
|
ShellListView: TShellListView;
|
|
ShellTreeView: TShellTreeView;
|
|
splitterMain: TSplitter;
|
|
procedure comboEncodingChange(Sender: TObject);
|
|
procedure comboFileTypeChange(Sender: TObject);
|
|
procedure comboLineBreaksChange(Sender: TObject);
|
|
procedure editFilenameEditingDone(Sender: TObject);
|
|
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
|
|
procedure FormCreate(Sender: TObject);
|
|
procedure FormDestroy(Sender: TObject);
|
|
procedure FormShow(Sender: TObject);
|
|
procedure IdleTimerTreeNodeScrolltoviewTimer(Sender: TObject);
|
|
procedure lblPathClick(Sender: TObject);
|
|
procedure lblPathMouseDown(Sender: TObject; Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
procedure lblPathMouseMove(Sender: TObject; Shift: TShiftState; X,
|
|
Y: Integer);
|
|
procedure ShellListViewClick(Sender: TObject);
|
|
procedure ShellListViewDblClick(Sender: TObject);
|
|
procedure ShellListViewFileAdded(Sender: TObject; Item: TListItem);
|
|
procedure ShellListViewSelectItem(Sender: TObject; Item: TListItem;
|
|
Selected: Boolean);
|
|
procedure ShellTreeViewChange(Sender: TObject; Node: TTreeNode);
|
|
procedure ShellTreeViewChanging(Sender: TObject; Node: TTreeNode;
|
|
var AllowChange: Boolean);
|
|
procedure ShellTreeViewGetImageIndex(Sender: TObject; Node: TTreeNode);
|
|
procedure ShellTreeViewGetSelectedIndex(Sender: TObject; Node: TTreeNode);
|
|
private
|
|
FInitialDir: String;
|
|
FFilterNames: TStringList;
|
|
FFilterMasks: TStringList;
|
|
FFilterIndex: Integer;
|
|
FDefaultExt: String;
|
|
FEncodings: TStringList;
|
|
FEncodingIndex: Integer;
|
|
FLineBreakIndex: TLineBreaks;
|
|
FOptions: TOpenOptions;
|
|
FFiles: TStringList;
|
|
FOnTypeChange: TNotifyEvent;
|
|
FClickedPathPart: String;
|
|
procedure SetTitle(AValue: String);
|
|
function GetFileName: String;
|
|
procedure SetFileName(const AValue: String);
|
|
procedure SetInitialDir(const AValue: String);
|
|
procedure SetFilterIndex(AValue: Integer);
|
|
function GetPathPartAt(X: Integer): String;
|
|
procedure SetOptions(AValue: TOpenOptions);
|
|
public
|
|
property OnTypeChange: TNotifyEvent read FOnTypeChange write FOnTypeChange;
|
|
property Title: String write SetTitle;
|
|
function Execute: Boolean;
|
|
procedure AddFileType(FileMask, DisplayName: String);
|
|
property FileName: String read GetFileName write SetFileName;
|
|
property InitialDir: String read FInitialDir write SetInitialDir;
|
|
property DefaultExt: String read FDefaultExt write FDefaultExt;
|
|
property Options: TOpenOptions read FOptions write SetOptions;
|
|
property Files: TStringList read FFiles;
|
|
property FilterIndex: Integer read FFilterIndex write SetFilterIndex;
|
|
end;
|
|
|
|
// File-open-dialog with encoding selector
|
|
TExtFileOpenDialog = class(TfrmExtFileDialog)
|
|
procedure FormCreate(Sender: TObject); overload;
|
|
procedure FormShow(Sender: TObject); overload;
|
|
public
|
|
property Encodings: TStringList read FEncodings write FEncodings;
|
|
property EncodingIndex: Integer read FEncodingIndex write FEncodingIndex;
|
|
end;
|
|
|
|
TExtFileSaveDialog = class(TfrmExtFileDialog)
|
|
procedure FormCreate(Sender: TObject); overload;
|
|
procedure FormShow(Sender: TObject); overload;
|
|
public
|
|
property LineBreakIndex: TLineBreaks read FLineBreakIndex write FLineBreakIndex;
|
|
end;
|
|
|
|
implementation
|
|
|
|
{$R *.lfm}
|
|
|
|
uses main;
|
|
|
|
|
|
function TfrmExtFileDialog.Execute: Boolean;
|
|
begin
|
|
Result := ShowModal = mrOK;
|
|
end;
|
|
|
|
procedure TfrmExtFileDialog.AddFileType(FileMask, DisplayName: String);
|
|
begin
|
|
FFilterNames.Add(DisplayName);
|
|
FFilterMasks.Add(FileMask);
|
|
comboFileType.Items.Add(DisplayName + ' (' + FileMask + ')');
|
|
end;
|
|
|
|
procedure TfrmExtFileDialog.FormCreate(Sender: TObject);
|
|
begin
|
|
if ClassType = TfrmExtFileDialog then
|
|
raise Exception.CreateFmt('Constructor of base class %s called. Use one of its descendants instead.', [ClassName]);
|
|
{$IfNDef WINDOWS}
|
|
ShellTreeView.Images := MainForm.ImageListMain;
|
|
ShellTreeView.OnGetImageIndex := ShellTreeViewGetImageIndex;
|
|
ShellTreeView.OnGetSelectedIndex := ShellTreeViewGetSelectedIndex;
|
|
ShellListView.SmallImages := MainForm.ImageListMain;
|
|
ShellListView.OnFileAdded := ShellListViewFileAdded;
|
|
{$ENDIF}
|
|
FFilterNames := TStringList.Create;
|
|
FFilterMasks := TStringList.Create;
|
|
FFilterIndex := 0;
|
|
FDefaultExt := '';
|
|
FEncodings := TStringList.Create;
|
|
FLineBreakIndex := lbsNone;
|
|
FFiles := TStringList.Create;
|
|
comboFileType.Items.Clear;
|
|
editFilename.Text := '';
|
|
comboLineBreaks.Items.Clear;
|
|
FOnTypeChange := nil;
|
|
end;
|
|
|
|
procedure TfrmExtFileDialog.FormDestroy(Sender: TObject);
|
|
begin
|
|
AppSettings.WriteString(asFileDialogPreviousDir, ShellTreeView.Path);
|
|
FFilterNames.Free;
|
|
FFilterMasks.Free;
|
|
FEncodings.Free;
|
|
FFiles.Free;
|
|
end;
|
|
|
|
procedure TfrmExtFileDialog.FormShow(Sender: TObject);
|
|
var
|
|
LineBreakIndexInt: Integer;
|
|
PreviousDir: String;
|
|
begin
|
|
PreviousDir := AppSettings.ReadString(asFileDialogPreviousDir);
|
|
if not FInitialDir.IsEmpty then
|
|
SetInitialDir(FInitialDir)
|
|
else if not PreviousDir.IsEmpty then
|
|
SetInitialDir(PreviousDir)
|
|
else
|
|
SetInitialDir(GetUserDir);
|
|
|
|
SetFilterIndex(FFilterIndex);
|
|
|
|
comboEncoding.Items.AddStrings(FEncodings, True);
|
|
if (FEncodingIndex >=0) and (FEncodingIndex < comboEncoding.Items.Count) then
|
|
comboEncoding.ItemIndex := FEncodingIndex;
|
|
|
|
comboLineBreaks.Items.Add(_('Windows linebreaks'));
|
|
comboLineBreaks.Items.Add(_('UNIX linebreaks'));
|
|
comboLineBreaks.Items.Add(_('Mac OS linebreaks'));
|
|
LineBreakIndexInt := Integer(FLineBreakIndex)-1; // we skip lbsNone
|
|
if (LineBreakIndexInt >=0) and (LineBreakIndexInt < comboLineBreaks.Items.Count) then
|
|
comboLineBreaks.ItemIndex := LineBreakIndexInt;
|
|
end;
|
|
|
|
procedure TfrmExtFileDialog.IdleTimerTreeNodeScrolltoviewTimer(Sender: TObject);
|
|
begin
|
|
// Work around tree node not being in scroll area in the first place
|
|
if not Visible then
|
|
Exit;
|
|
if Assigned(ShellTreeView.Selected) then
|
|
ShellTreeView.Selected.MakeVisible;
|
|
IdleTimerTreeNodeScrolltoview.AutoEnabled := False;
|
|
IdleTimerTreeNodeScrolltoview.Enabled := False;
|
|
end;
|
|
|
|
procedure TfrmExtFileDialog.lblPathClick(Sender: TObject);
|
|
begin
|
|
if (not FClickedPathPart.IsEmpty) and DirectoryExists(FClickedPathPart) then begin
|
|
if ofNoChangeDir in FOptions then
|
|
ErrorDialog('You cannot change the directory in this context.')
|
|
else
|
|
ShellTreeView.Path := FClickedPathPart;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmExtFileDialog.lblPathMouseDown(Sender: TObject;
|
|
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
begin
|
|
FClickedPathPart := GetPathPartAt(X);
|
|
end;
|
|
|
|
function TfrmExtFileDialog.GetPathPartAt(X: Integer): String;
|
|
var
|
|
i, CharIndex, CurrentWidth: Integer;
|
|
TextWidth: Integer;
|
|
begin
|
|
CharIndex := -1;
|
|
CurrentWidth := 0;
|
|
Result := '';
|
|
|
|
lblPath.Canvas.Font := lblPath.Font;
|
|
for i := 1 to Length(lblPath.Caption) do
|
|
begin
|
|
TextWidth := lblPath.Canvas.TextWidth(Copy(lblPath.Caption, i, 1));
|
|
if (X >= CurrentWidth) and (X < CurrentWidth + TextWidth) then
|
|
begin
|
|
CharIndex := i; // 1-based character index clicked
|
|
Break;
|
|
end;
|
|
Inc(CurrentWidth, TextWidth);
|
|
end;
|
|
if CharIndex > 0 then begin
|
|
i := 0;
|
|
for i:=CharIndex to Length(lblPath.Caption) do begin
|
|
if Copy(lblPath.Caption, i, 1) = PathDelim then
|
|
break;
|
|
end;
|
|
Result := Copy(lblPath.Caption, 1, i);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmExtFileDialog.SetOptions(AValue: TOpenOptions);
|
|
begin
|
|
if FOptions = AValue then
|
|
Exit;
|
|
FOptions := AValue;
|
|
if (ofAllowMultiSelect in FOptions) <> ShellListView.MultiSelect then begin
|
|
// This would crash if we would do it in FormShow. See issue #2410
|
|
ShellListView.MultiSelect := ofAllowMultiSelect in FOptions;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmExtFileDialog.lblPathMouseMove(Sender: TObject;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
begin
|
|
lblPath.Hint := GetPathPartAt(X);
|
|
end;
|
|
|
|
procedure TfrmExtFileDialog.comboFileTypeChange(Sender: TObject);
|
|
var
|
|
FileMask: String;
|
|
begin
|
|
FFilterIndex := comboFileType.ItemIndex;
|
|
if (comboFileType.ItemIndex >= 0) and (FFilterMasks.Count > comboFileType.ItemIndex) then
|
|
FileMask := FFilterMasks[comboFileType.ItemIndex]
|
|
else
|
|
FileMask := '*.*';
|
|
if ShellListView.Items.Count > 0 then
|
|
ShellListView.Items[0].MakeVisible(false);
|
|
ShellListView.Mask := FileMask;
|
|
if Assigned(FOnTypeChange) then
|
|
FOnTypeChange(Self);
|
|
end;
|
|
|
|
procedure TfrmExtFileDialog.comboLineBreaksChange(Sender: TObject);
|
|
begin
|
|
case comboLineBreaks.ItemIndex of
|
|
0: FLineBreakIndex := lbsWindows;
|
|
1: FLineBreakIndex := lbsUnix;
|
|
2: FLineBreakIndex := lbsMac;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmExtFileDialog.editFilenameEditingDone(Sender: TObject);
|
|
begin
|
|
FFiles.Clear;
|
|
FFiles.Add(GetFileName);
|
|
end;
|
|
|
|
procedure TfrmExtFileDialog.FormCloseQuery(Sender: TObject;
|
|
var CanClose: Boolean);
|
|
begin
|
|
CanClose := True;
|
|
|
|
if ModalResult = mrCancel then
|
|
Exit;
|
|
|
|
// Do nothing when user clicks OK without a selected file. Imitates Windows behaviour.
|
|
if FileName.IsEmpty then begin
|
|
CanClose := False;
|
|
Exit;
|
|
end;
|
|
|
|
// Only for save dialogs: Ask user whether to overwrite the selected file
|
|
if (ofOverwritePrompt in FOptions) and (FileExists(FileName)) then begin
|
|
CanClose := MessageDialog(f_('File already exists: %s'+sLineBreak+sLineBreak+'Overwrite it?', [FileName]), mtConfirmation, [mbYes, mbNo]) = mrYes;
|
|
end;
|
|
|
|
// Only for open dialogs: Error if file does not exist
|
|
if (ofFileMustExist in FOptions) and (not FileExists(FileName)) then begin
|
|
ErrorDialog(f_('File does not exist: %s', [FileName]));
|
|
CanClose := False;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmExtFileDialog.comboEncodingChange(Sender: TObject);
|
|
begin
|
|
FEncodingIndex := comboEncoding.ItemIndex;
|
|
end;
|
|
|
|
procedure TfrmExtFileDialog.ShellListViewClick(Sender: TObject);
|
|
begin
|
|
if ShellListView.Selected <> nil then
|
|
editFilename.Text := ShellListView.Selected.Caption
|
|
else
|
|
editFilename.Text := '';
|
|
end;
|
|
|
|
procedure TfrmExtFileDialog.ShellListViewDblClick(Sender: TObject);
|
|
begin
|
|
if ShellListView.Selected <> nil then
|
|
ModalResult := mrOK;
|
|
end;
|
|
|
|
procedure TfrmExtFileDialog.ShellListViewFileAdded(Sender: TObject;
|
|
Item: TListItem);
|
|
var
|
|
Ext: String;
|
|
begin
|
|
if TShellListItem(Item).IsFolder then
|
|
Item.ImageIndex := ICONINDEX_FOLDER
|
|
else begin
|
|
Ext := ExtractFileExt(ShellListView.GetPathFromItem(Item));
|
|
Item.ImageIndex := GetFileExtImageIndex(Ext);
|
|
if Item.ImageIndex = -1 then
|
|
Item.ImageIndex := 66; // page with question mark
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmExtFileDialog.ShellListViewSelectItem(Sender: TObject;
|
|
Item: TListItem; Selected: Boolean);
|
|
var
|
|
ListItem: TListItem;
|
|
begin
|
|
FFiles.Clear;
|
|
for ListItem in ShellListView.Items do begin
|
|
if ListItem.Selected then begin
|
|
FFiles.Add(ShellListView.GetPathFromItem(ListItem));
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmExtFileDialog.ShellTreeViewChange(Sender: TObject; Node: TTreeNode
|
|
);
|
|
begin
|
|
lblPath.Caption := ShellTreeView.Path;
|
|
end;
|
|
|
|
procedure TfrmExtFileDialog.ShellTreeViewChanging(Sender: TObject;
|
|
Node: TTreeNode; var AllowChange: Boolean);
|
|
begin
|
|
AllowChange := not (ofNoChangeDir in FOptions);
|
|
if AllowChange and (ShellListView.Items.Count > 0) then
|
|
ShellListView.Items[0].MakeVisible(false);
|
|
end;
|
|
|
|
procedure TfrmExtFileDialog.ShellTreeViewGetImageIndex(Sender: TObject;
|
|
Node: TTreeNode);
|
|
begin
|
|
Node.ImageIndex := IfThen(Node.Level = 0, 1, ICONINDEX_FOLDER);
|
|
end;
|
|
|
|
procedure TfrmExtFileDialog.ShellTreeViewGetSelectedIndex(Sender: TObject;
|
|
Node: TTreeNode);
|
|
begin
|
|
Node.SelectedIndex := IfThen(Node.Level = 0, 1, ICONINDEX_FOLDER);
|
|
end;
|
|
|
|
procedure TfrmExtFileDialog.SetTitle(AValue: String);
|
|
begin
|
|
Caption := AValue;
|
|
end;
|
|
|
|
function TfrmExtFileDialog.GetFileName: String;
|
|
begin
|
|
if (editFilename.Text <> '') and (ShellTreeView.Selected <> nil) then begin
|
|
Result := ShellTreeView.Path + editFilename.Text;
|
|
if IsEmpty(ExtractFileExt(Result)) and (not FDefaultExt.IsEmpty) then
|
|
Result := Result + '.' + FDefaultExt;
|
|
end
|
|
else if ShellListView.Selected <> nil then
|
|
Result := ShellListView.GetPathFromItem(ShellListView.Selected)
|
|
else
|
|
Result := '';
|
|
end;
|
|
|
|
procedure TfrmExtFileDialog.SetFileName(const AValue: String);
|
|
var
|
|
fn: String;
|
|
begin
|
|
if AValue.IsEmpty then
|
|
Exit;
|
|
fn := ExpandFileName(AValue);
|
|
SetInitialDir(ExtractFilePath(fn));
|
|
editFilename.Text := ExtractFileName(fn);
|
|
ShellListView.Selected := ShellListView.FindCaption(0, fn, false, true, true);
|
|
end;
|
|
|
|
procedure TfrmExtFileDialog.SetInitialDir(const AValue: String);
|
|
var
|
|
CurPath: String;
|
|
i: Integer;
|
|
begin
|
|
// Try to set path on tree
|
|
// Note both .FileName and .InitialDir go here, and .FileName := '' sets the initial dir to the app directory.
|
|
if AValue.IsEmpty then
|
|
Exit;
|
|
FInitialDir := AValue;
|
|
CurPath := AValue;
|
|
for i:=0 to 10 do begin
|
|
try
|
|
ShellTreeView.Path := CurPath;
|
|
Break;
|
|
except
|
|
on E:EShellCtrl do begin
|
|
// Go up to parent folder
|
|
// Testable on connections > advanced > file logging, due to virtual template strings.
|
|
CurPath := ExtractFilePath(ExcludeTrailingPathDelimiter(CurPath));
|
|
// In case, re-enable changing directory in tree
|
|
Exclude(FOptions, ofNoChangeDir);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmExtFileDialog.SetFilterIndex(AValue: Integer);
|
|
begin
|
|
if (AValue >= 0) and (AValue < comboFileType.Items.Count) then begin
|
|
comboFileType.ItemIndex := AValue;
|
|
comboFileTypeChange(Self);
|
|
end;
|
|
end;
|
|
|
|
|
|
{ TExtFileOpenDialog }
|
|
|
|
procedure TExtFileOpenDialog.FormCreate(Sender: TObject);
|
|
begin
|
|
inherited;
|
|
Include(FOptions, ofFileMustExist);
|
|
Caption := _('Open existing file');
|
|
end;
|
|
|
|
procedure TExtFileOpenDialog.FormShow(Sender: TObject);
|
|
var
|
|
EncodingVisible: Boolean;
|
|
begin
|
|
inherited;
|
|
EncodingVisible := comboEncoding.Items.Count > 0;
|
|
lblEncoding.Visible := EncodingVisible;
|
|
comboEncoding.Visible := EncodingVisible;
|
|
end;
|
|
|
|
|
|
|
|
{ TExtFileSaveDialog }
|
|
|
|
procedure TExtFileSaveDialog.FormCreate(Sender: TObject);
|
|
begin
|
|
inherited;
|
|
Caption := _('Save to file');
|
|
end;
|
|
|
|
procedure TExtFileSaveDialog.FormShow(Sender: TObject);
|
|
var
|
|
LinebreaksVisible: Boolean;
|
|
begin
|
|
inherited;
|
|
LinebreaksVisible := FLineBreakIndex in [lbsWindows, lbsUnix, lbsMac];
|
|
lblLinebreaks.Visible := LinebreaksVisible;
|
|
comboLineBreaks.Visible := LinebreaksVisible;
|
|
end;
|
|
|
|
end.
|
|
|