Skip to content

Commit bac0d7a

Browse files
ansgarbeckeransgarbecker
committed
feat: recreate basic TExtFileOpenDialog without OS owned dialog and room for customization
Refs #2268
1 parent 00627ae commit bac0d7a

File tree

7 files changed

+2367
-2141
lines changed

7 files changed

+2367
-2141
lines changed

‎heidisql.lpi‎

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -437,6 +437,14 @@
437437
<Filename Value="source\crashdialog.pas"/>
438438
<IsPartOfProject Value="True"/>
439439
<ComponentName Value="frmCrashDialog"/>
440+
<HasResources Value="True"/>
441+
<ResourceBaseClass Value="Form"/>
442+
</Unit>
443+
<Unit>
444+
<Filename Value="source\extfiledialog.pas"/>
445+
<IsPartOfProject Value="True"/>
446+
<ComponentName Value="frmExtFileDialog"/>
447+
<HasResources Value="True"/>
440448
<ResourceBaseClass Value="Form"/>
441449
</Unit>
442450
</Units>

‎source/extfiledialog.lfm‎

Lines changed: 142 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,142 @@
1+
object frmExtFileDialog: TfrmExtFileDialog
2+
Left = 306
3+
Height = 544
4+
Top = 123
5+
Width = 872
6+
BorderIcons = [biSystemMenu]
7+
Caption = 'Open existing file'
8+
ClientHeight = 544
9+
ClientWidth = 872
10+
DesignTimePPI = 120
11+
OnCreate = FormCreate
12+
OnDestroy = FormDestroy
13+
OnShow = FormShow
14+
object pnlBottom: TPanel
15+
Left = 10
16+
Height = 68
17+
Top = 466
18+
Width = 852
19+
Align = alBottom
20+
AutoSize = True
21+
BorderSpacing.Around = 10
22+
BevelOuter = bvNone
23+
ClientHeight = 68
24+
ClientWidth = 852
25+
TabOrder = 2
26+
object editFilename: TEdit
27+
AnchorSideLeft.Control = lblFilename
28+
AnchorSideLeft.Side = asrBottom
29+
AnchorSideTop.Control = pnlBottom
30+
AnchorSideRight.Control = comboFileType
31+
Left = 77
32+
Height = 28
33+
Top = 0
34+
Width = 505
35+
Anchors = [akTop, akLeft, akRight]
36+
BorderSpacing.Left = 10
37+
BorderSpacing.Right = 10
38+
TabOrder = 0
39+
Text = 'editFilename'
40+
end
41+
object lblFilename: TLabel
42+
AnchorSideLeft.Control = pnlBottom
43+
AnchorSideTop.Control = editFilename
44+
AnchorSideTop.Side = asrCenter
45+
Left = 0
46+
Height = 20
47+
Top = 4
48+
Width = 67
49+
Caption = 'File name:'
50+
end
51+
object comboFileType: TComboBox
52+
AnchorSideLeft.Control = btnOk
53+
AnchorSideTop.Control = pnlBottom
54+
AnchorSideRight.Control = pnlBottom
55+
AnchorSideRight.Side = asrBottom
56+
Left = 592
57+
Height = 28
58+
Top = 0
59+
Width = 260
60+
Anchors = [akTop, akLeft, akRight]
61+
BorderSpacing.Bottom = 10
62+
ItemHeight = 20
63+
Items.Strings = (
64+
''
65+
)
66+
Style = csDropDownList
67+
TabOrder = 1
68+
OnChange = comboFileTypeChange
69+
end
70+
object btnOk: TButton
71+
AnchorSideLeft.Control = pnlBottom
72+
AnchorSideTop.Control = comboFileType
73+
AnchorSideTop.Side = asrBottom
74+
AnchorSideRight.Control = btnCancel
75+
AnchorSideBottom.Control = pnlBottom
76+
AnchorSideBottom.Side = asrBottom
77+
Left = 592
78+
Height = 30
79+
Top = 38
80+
Width = 125
81+
Anchors = [akTop, akRight, akBottom]
82+
BorderSpacing.Right = 10
83+
Caption = 'OK'
84+
Constraints.MinWidth = 125
85+
Default = True
86+
ModalResult = 1
87+
TabOrder = 2
88+
end
89+
object btnCancel: TButton
90+
AnchorSideTop.Control = comboFileType
91+
AnchorSideTop.Side = asrBottom
92+
AnchorSideRight.Control = pnlBottom
93+
AnchorSideRight.Side = asrBottom
94+
Left = 727
95+
Height = 30
96+
Top = 38
97+
Width = 125
98+
Anchors = [akTop, akRight]
99+
AutoSize = True
100+
Cancel = True
101+
Caption = 'Cancel'
102+
Constraints.MinWidth = 125
103+
ModalResult = 2
104+
TabOrder = 3
105+
end
106+
end
107+
object ShellTreeView: TShellTreeView
108+
Left = 10
109+
Height = 446
110+
Top = 10
111+
Width = 261
112+
Align = alLeft
113+
BorderSpacing.Left = 10
114+
BorderSpacing.Top = 10
115+
HideSelection = False
116+
ReadOnly = False
117+
TabOrder = 0
118+
Options = [tvoAutoItemHeight, tvoKeepCollapsedNodes, tvoShowButtons, tvoShowLines, tvoShowRoot, tvoToolTips, tvoThemedDraw]
119+
ShellListView = ShellListView
120+
end
121+
object splitterMain: TSplitter
122+
Left = 271
123+
Height = 456
124+
Top = 0
125+
Width = 6
126+
end
127+
object ShellListView: TShellListView
128+
Left = 277
129+
Height = 446
130+
Top = 10
131+
Width = 585
132+
Align = alClient
133+
BorderSpacing.Top = 10
134+
BorderSpacing.Right = 10
135+
Color = clDefault
136+
TabOrder = 1
137+
ShellTreeView = ShellTreeView
138+
OnClick = ShellListViewClick
139+
OnDblClick = ShellListViewDblClick
140+
OnSelectItem = ShellListViewSelectItem
141+
end
142+
end

‎source/extfiledialog.pas‎

Lines changed: 174 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,174 @@
1+
unit extfiledialog;
2+
3+
{$mode delphi}{$H+}
4+
5+
interface
6+
7+
uses
8+
Classes, SysUtils, LCLType, Forms, Controls, Graphics, Dialogs,
9+
ExtCtrls, StdCtrls, ShellCtrls, ComCtrls, apphelpers;
10+
11+
type
12+
13+
{ TfrmExtFileDialog }
14+
15+
TfrmExtFileDialog = class(TForm)
16+
btnCancel: TButton;
17+
btnOk: TButton;
18+
comboFileType: TComboBox;
19+
editFilename: TEdit;
20+
lblFilename: TLabel;
21+
pnlBottom: TPanel;
22+
ShellListView: TShellListView;
23+
ShellTreeView: TShellTreeView;
24+
splitterMain: TSplitter;
25+
procedure comboFileTypeChange(Sender: TObject);
26+
procedure FormCreate(Sender: TObject);
27+
procedure FormDestroy(Sender: TObject);
28+
procedure FormShow(Sender: TObject);
29+
procedure ShellListViewClick(Sender: TObject);
30+
procedure ShellListViewDblClick(Sender: TObject);
31+
procedure ShellListViewSelectItem(Sender: TObject; Item: TListItem;
32+
Selected: Boolean);
33+
private
34+
FInitialDir: String;
35+
FFilterNames: TStringList;
36+
FFilterMasks: TStringList;
37+
FDefaultExt: String;
38+
FEncodings: TStringList;
39+
FEncodingIndex: Cardinal;
40+
FOptions: TOpenOptions;
41+
FFiles: TStringList;
42+
function GetFileName: String;
43+
procedure SetFileName(const AValue: String);
44+
procedure SetInitialDir(const AValue: String);
45+
public
46+
function Execute: Boolean;
47+
procedure AddFileType(FileMask, DisplayName: String);
48+
property FileName: String read GetFileName write SetFileName;
49+
property InitialDir: String read FInitialDir write SetInitialDir;
50+
class var PreviousDir: String;
51+
property DefaultExt: String read FDefaultExt write FDefaultExt;
52+
property Encodings: TStringList read FEncodings write FEncodings;
53+
property EncodingIndex: Cardinal read FEncodingIndex write FEncodingIndex;
54+
property Options: TOpenOptions read FOptions write FOptions;
55+
property Files: TStringList read FFiles;
56+
57+
end;
58+
59+
// File-open-dialog with encoding selector
60+
TExtFileOpenDialog = class(TfrmExtFileDialog);
61+
62+
63+
implementation
64+
65+
{$R *.lfm}
66+
67+
function TfrmExtFileDialog.Execute: Boolean;
68+
begin
69+
Result := ShowModal = mrOK;
70+
end;
71+
72+
procedure TfrmExtFileDialog.AddFileType(FileMask, DisplayName: String);
73+
begin
74+
FFilterNames.Add(DisplayName);
75+
FFilterMasks.Add(FileMask);
76+
comboFileType.Items.Add(DisplayName + ' (' + FileMask + ')');
77+
end;
78+
79+
procedure TfrmExtFileDialog.FormCreate(Sender: TObject);
80+
begin
81+
FFilterNames := TStringList.Create;
82+
FFilterMasks := TStringList.Create;
83+
FEncodings := TStringList.Create;
84+
FFiles := TStringList.Create;
85+
comboFileType.Items.Clear;
86+
editFilename.Text := '';
87+
end;
88+
89+
procedure TfrmExtFileDialog.FormDestroy(Sender: TObject);
90+
begin
91+
PreviousDir := ShellTreeView.Path;
92+
FFilterNames.Free;
93+
FFilterMasks.Free;
94+
FEncodings.Free;
95+
FFiles.Free;
96+
end;
97+
98+
procedure TfrmExtFileDialog.FormShow(Sender: TObject);
99+
begin
100+
ShellListView.MultiSelect := ofAllowMultiSelect in FOptions;
101+
ShellTreeView.Enabled := not (ofNoChangeDir in FOptions);
102+
// Todo: support ofOverwritePrompt, ofFileMustExist
103+
if FInitialDir.IsEmpty then begin
104+
if not PreviousDir.IsEmpty then
105+
SetInitialDir(PreviousDir)
106+
else
107+
SetInitialDir(GetUserDir);
108+
end;
109+
comboFileType.ItemIndex := 0;
110+
comboFileType.OnChange(Sender);
111+
end;
112+
113+
procedure TfrmExtFileDialog.comboFileTypeChange(Sender: TObject);
114+
var
115+
FileMask: String;
116+
begin
117+
if (comboFileType.ItemIndex >= 0) and (FFilterMasks.Count > comboFileType.ItemIndex) then
118+
FileMask := FFilterMasks[comboFileType.ItemIndex]
119+
else
120+
FileMask := '*.*';
121+
ShellListView.Mask := FileMask;
122+
end;
123+
124+
procedure TfrmExtFileDialog.ShellListViewClick(Sender: TObject);
125+
begin
126+
if ShellListView.Selected <> nil then
127+
editFilename.Text := ShellListView.Selected.Caption
128+
else
129+
editFilename.Text := '';
130+
end;
131+
132+
procedure TfrmExtFileDialog.ShellListViewDblClick(Sender: TObject);
133+
begin
134+
ModalResult := mrOK;
135+
end;
136+
137+
procedure TfrmExtFileDialog.ShellListViewSelectItem(Sender: TObject;
138+
Item: TListItem; Selected: Boolean);
139+
var
140+
ListItem: TListItem;
141+
begin
142+
FFiles.Clear;
143+
for ListItem in ShellListView.Items do begin
144+
if ListItem.Selected then begin
145+
FFiles.Add(ShellListView.GetPathFromItem(ListItem));
146+
end;
147+
end;
148+
end;
149+
150+
function TfrmExtFileDialog.GetFileName: String;
151+
begin
152+
if ShellListView.Selected <> nil then
153+
Result := ShellListView.GetPathFromItem(ShellListView.Selected)
154+
else
155+
Result := '';
156+
end;
157+
158+
procedure TfrmExtFileDialog.SetFileName(const AValue: String);
159+
var
160+
fn: String;
161+
begin
162+
fn := ExpandFileName(AValue);
163+
ShellTreeView.Path := ExtractFilePath(fn);
164+
editFilename.Text := ExtractFileName(fn);
165+
ShellListView.Selected := ShellListView.FindCaption(0, fn, false, true, true);
166+
end;
167+
168+
procedure TfrmExtFileDialog.SetInitialDir(const AValue: String);
169+
begin
170+
ShellTreeView.Path := AValue;
171+
end;
172+
173+
end.
174+

0 commit comments

Comments
 (0)