1 unit LazDialogs;
2
3 {$mode objfpc}{$H+}
4
5 interface
6
7 uses
8 // RTL
9 Classes, SysUtils, math,
10 // LCL
11 Graphics, Forms, ShellCtrls, Buttons, StdCtrls, ExtCtrls, FileCtrl, ComCtrls,
12 Dialogs, ButtonPanel, LCLStrConsts, FileUtil, Controls;
13
14 type
15 TLazFileDialogKind = (
16 ldkOpenDesktop, ldkSaveDesktop, ldkOpenPDA, ldkSavePDA, ldkSelectDirectory);
17
18 { TLazarusFileDialogForm }
19
20 TLazarusFileDialogForm = class(TForm)
21 private
22 FKind: TLazFileDialogKind;
23 procedure SetFilter(AFilter: string);
24 public
25 // User interface
26 ButtonPanel: TButtonPanel;
27 ShellTreeView: TShellTreeView;
28 ShellListView: TShellListView;
29 SaveEdit: TEdit;
30 FilterComboBox: TFilterComboBox;
31 // input/output
32 FileName: string;
33 Filter: string;
34 InitialDir: string;
35 Title: string;
36 //
37 constructor CreateNew(AOwner: TComponent; Num: Integer = 0); override;
38 procedure Initialize(AKind: TLazFileDialogKind);
39 procedure HandleOkClick(ASender: TObject);
40 procedure HandleCancelClick(ASender: TObject);
41 procedure HandleCloseQuery(Sender : TObject; var CanClose : boolean);
42 procedure HandleEditChange(ASender: TObject);
43 procedure HandleSelectItem(Sender: TObject;
44 Item: TListItem; Selected: Boolean);
45 procedure HandleTreeViewSelectionChanged(ASender: TObject);
46 end;
47
48 { TLazOpenDialog }
49
50 TLazOpenDialog = class(TOpenDialog)
51 protected
52 FForm: TLazarusFileDialogForm;
53 class procedure WSRegisterClass; override;
DoExecutenull54 function DoExecute: boolean; override;
55 procedure DoInitialize; virtual;
56 public
57 constructor Create(TheOwner: TComponent); override;
58 end;
59
60 { TLazSaveDialog }
61
62 TLazSaveDialog = class(TLazOpenDialog)
63 protected
64 procedure DoInitialize; override;
65 end;
66
67 { TLazSelectDirectoryDialog }
68
69 TLazSelectDirectoryDialog = class(TLazOpenDialog)
70 protected
71 procedure DoInitialize; override;
72 end;
73
74 { TLazMessageDialog }
75 TLazMessageDialog = class(TForm)
76 private
77 Image1: TImage;
78 Label1: TLabel; // we need a TLabel to be able to resize it properly
79 btnList: array [0..11] of TBitBtn;
80 NumButtons: Integer;
81 public
82 constructor CreateNew(TheOwner: TComponent; Num: Integer = 0); override;
83 end;
84
LazMessageDlgnull85 function LazMessageDlg(const aCaption, aMsg: string; DlgType: TMsgDlgType;
86 Buttons: TMsgDlgButtons; HelpCtx: Longint): Integer;
LazMessageDlgnull87 function LazMessageDlg(const aMsg: string; DlgType: TMsgDlgType;
88 Buttons: TMsgDlgButtons; HelpCtx: Longint): Integer;
89
90 implementation
91
92 var
93 { Declared here for the time being to make it possibly work with LCLCustodrawn}
94 LazMessageDialog: TLazMessageDialog;
95
96 { TLazarusFileDialogForm }
97
98 procedure TLazarusFileDialogForm.SetFilter(AFilter: string);
99 begin
100 if AFilter = '' then
101 FilterComboBox.Filter := Format(rsAllFiles,[GetAllFilesMask, GetAllFilesMask,''])
102 else
103 FilterComboBox.Filter := AFilter;
104 end;
105
106 {
107 The size of the window is determined only when creating the
108 handle, so any reference to TForm.Width and TForm.Height
109 here doesnt correspond to the final value.
110 }
111 constructor TLazarusFileDialogForm.CreateNew(AOwner: TComponent; Num: Integer = 0);
112 begin
113 inherited CreateNew(AOwner, Num);
114
115 Self.Position := poScreenCenter;
116 end;
117
118 procedure TLazarusFileDialogForm.Initialize(AKind: TLazFileDialogKind);
119 begin
120 FKind := AKind;
121
122 ButtonPanel := TButtonPanel.Create(Self);
123 ButtonPanel.Parent := Self;
124 ButtonPanel.Left := 0;
125 ButtonPanel.Height := 20;
126 ButtonPanel.Top := Height - ButtonPanel.Height;
127 ButtonPanel.Width := Width;
128 ButtonPanel.Align := alBottom;
129 ButtonPanel.ShowButtons := [pbOK, pbCancel];
130 ButtonPanel.OKButton.OnClick := @HandleOkClick;
131 ButtonPanel.CancelButton.OnClick := @HandleCancelClick;
132
133 if AKind in [ldkOpenDesktop, ldkSaveDesktop, ldkOpenPDA, ldkSavePDA] then
134 begin
135 // Add the ShellTreeView to the dialog
136 ShellTreeView := TShellTreeView.Create(Self);
137 ShellTreeView.Parent := Self;
138 ShellTreeView.Left := 0;
139 ShellTreeView.Top := 0;
140 ShellTreeView.Width := Width;
141 ShellTreeView.Height := 100;
142 ShellTreeView.Align := alTop;
143
144 // Add the ShellListView to the dialog
145 ShellListView := TShellListView.Create(Self);
146 ShellListView.Parent := Self;
147 ShellListView.Left := 0;
148 ShellListView.Top := ShellTreeView.Height;
149 ShellListView.Width := Width;
150 ShellListView.Height := Height - ShellTreeView.Height - ButtonPanel.Height;
151 ShellListView.Align := alClient;
152 ShellListView.ShellTreeView := ShellTreeView;
153 ShellListView.ScrollBars := ssVertical;
154 ShellListView.OnSelectItem := @HandleSelectItem;
155
156 // TEdit for save dialog
157 if AKind in [ldkSaveDesktop, ldkSavePDA] then
158 begin
159 SaveEdit := TEdit.Create(Self);
160 SaveEdit.Parent := Self;
161 SaveEdit.Left := 0;
162 SaveEdit.Height := 20;
163 SaveEdit.Top := Height - ButtonPanel.Height - SaveEdit.Height;
164 SaveEdit.Width := Width;
165 SaveEdit.Align := alBottom;
166 SaveEdit.Text := SysUtils.ExtractFileName(FileName);
167 SaveEdit.OnChange := @HandleEditChange;
168 end;
169
170 // TFilterComboBox
171 FilterComboBox := TFilterComboBox.Create(Self);
172 FilterComboBox.Parent := Self;
173 FilterComboBox.Left := 0;
174 FilterComboBox.Height := 20;
175 FilterComboBox.Top := Height - ButtonPanel.Height - FilterComboBox.Height;
176 if SaveEdit <> nil then
177 FilterComboBox.Top := FilterComboBox.Top - SaveEdit.Height;
178 FilterComboBox.Width := Width;
179 FilterComboBox.Align := alBottom;
180 SetFilter(Filter);
181 FilterComboBox.ShellListView := ShellListView;
182
183 // In the save dialog it is enabled when there is a text in the TEdit
184 if AKind in [ldkSaveDesktop, ldkSavePDA] then
185 ButtonPanel.OKButton.Enabled := SaveEdit.Text <> ''
186 // In a TOpenDialog the Ok button is only enabled when a file is selected
187 else
188 ButtonPanel.OkButton.Enabled := False;
189 end
190 else if FKind = ldkSelectDirectory then
191 begin
192 // Add the ShellTreeView to the dialog
193 ShellTreeView := TShellTreeView.Create(Self);
194 ShellTreeView.Parent := Self;
195 ShellTreeView.Left := 0;
196 ShellTreeView.Top := 0;
197 ShellTreeView.Align := alClient;
198 ShellTreeView.OnSelectionChanged := @HandleTreeViewSelectionChanged;
199
200 ButtonPanel.OKButton.Enabled := False;
201 end;
202
203 // Form events
204 OnCloseQuery := @HandleCloseQuery;
205 end;
206
207 // The Ok button code should be only a simple mrOk,
208 // because there is the dialog Ok button, which will
209 // always be active and will set the ModalResult to mrOk
210 // so the code needs to affect it too, and this can be
211 // done in CloseQuery
212 procedure TLazarusFileDialogForm.HandleOkClick(ASender: TObject);
213 begin
214 ModalResult := mrOk;
215 end;
216
217 procedure TLazarusFileDialogForm.HandleCancelClick(ASender: TObject);
218 begin
219 ModalResult := mrCancel;
220 end;
221
222 procedure TLazarusFileDialogForm.HandleCloseQuery(Sender: TObject;
223 var CanClose: boolean);
224 begin
225 if ModalResult = mrCancel then
226 begin
227 CanClose := True;
228 Exit;
229 end;
230
231 CanClose := False;
232
233 if FKind in [ldkSaveDesktop, ldkSavePDA] then
234 begin
235 if SaveEdit.Text = '' then Exit;
236
237 FileName := ShellTreeView.GetPathFromNode(ShellTreeView.Selected);
238 FileName := IncludeTrailingPathDelimiter(FileName);
239 FileName := FileName + SaveEdit.Text;
240 CanClose := True;
241 end
242 else if FKind in [ldkOpenDesktop, ldkOpenPDA] then
243 begin
244 if ShellListView.Selected = nil then Exit;
245
246 FileName := ShellListView.GetPathFromItem(ShellListView.Selected);
247 CanClose := True;
248 end
249 else
250 begin
251 if ShellTreeView.Selected = nil then Exit;
252
253 FileName := ShellTreeView.GetPathFromNode(ShellTreeView.Selected);
254 CanClose := True;
255 end;
256 end;
257
258 procedure TLazarusFileDialogForm.HandleEditChange(ASender: TObject);
259 begin
260 ButtonPanel.OkButton.Enabled := SaveEdit.Text <> '';
261 end;
262
263 procedure TLazarusFileDialogForm.HandleSelectItem(Sender: TObject;
264 Item: TListItem; Selected: Boolean);
265 begin
266 // Selecting an item changes the filename in the TEdit
267 // in save dialogs
268 if (FKind in [ldkSaveDesktop, ldkSavePDA]) and Selected then
269 begin
270 SaveEdit.Text := Item.Caption;
271 end
272 // In the OpenDialog the state of the Ok button is dependent
273 // on the selection of an item
274 else
275 begin
276 ButtonPanel.OkButton.Enabled := Selected;
277 end;
278 end;
279
280 // Used only in the TLazSelectDirectoryDialog
281 procedure TLazarusFileDialogForm.HandleTreeViewSelectionChanged(ASender: TObject);
282 begin
283 ButtonPanel.OKButton.Enabled := True;
284 end;
285
286 { TLazOpenDialog }
287
288 class procedure TLazOpenDialog.WSRegisterClass;
289 begin
290 // Do nothing, because this dialog doesn't require a WS implementation
291 end;
292
DoExecutenull293 function TLazOpenDialog.DoExecute: boolean;
294 begin
295 Result := FForm.ShowModal <> mrCancel;
296 FileName := FForm.FileName;
297 end;
298
299 procedure TLazOpenDialog.DoInitialize;
300 begin
301 FForm.Initialize(ldkOpenDesktop);
302 end;
303
304 constructor TLazOpenDialog.Create(TheOwner: TComponent);
305 begin
306 inherited Create(TheOwner);
307 FForm := TLazarusFileDialogForm.CreateNew(Self);
308 FForm.FileName := FileName;
309 FForm.Filter := Filter;
310 FForm.Title := Title;
311 DoInitialize;
312 FForm.Hide;
313 end;
314
315 { TLazSaveDialog }
316
317 procedure TLazSaveDialog.DoInitialize;
318 begin
319 FForm.Initialize(ldkSaveDesktop);
320 end;
321
322 { TLazSelectDirectoryDialog }
323
324 procedure TLazSelectDirectoryDialog.DoInitialize;
325 begin
326 FForm.Initialize(ldkSelectDirectory);
327 end;
328 { Dialog Functions }
329
330 function LazMessageDlg(const aCaption, aMsg: string; DlgType: TMsgDlgType;
331 Buttons: TMsgDlgButtons; HelpCtx: Longint): Integer;
332 Var
333 I: Integer;
334 textWidth: Integer;
335 ButtonPos: Integer;
336 RequiredWidth: Integer;
337 BlankRight: Integer; // blank space at the right of last button
338 begin
339 {$ifdef LCLCustomdrawn} if not assigned(LazMessageDialog) then {$endif}
340 LazMessageDialog:= TLazMessageDialog.CreateNew(Application);
341 with LazMessageDialog do begin
342 Label1.Caption:= aMsg;
343 Label1.Parent:= LazMessageDialog;
344 {Select Image (and Caption) from DlgType}
345 case DlgType of
346 mtWarning: begin
347 Caption:= rsMtWarning;
348 image1.Picture.LoadFromResourceName(hInstance, 'dialog_warning', TPortableNetworkGraphic);
349 end;
350 mtError: begin
351 Caption:= rsMtError;
352 image1.Picture.LoadFromResourceName(hInstance, 'dialog_error', TPortableNetworkGraphic);
353 end;
354 mtConfirmation: begin
355 Caption:= rsMtConfirmation;
356 image1.Picture.LoadFromResourceName(hInstance, 'dialog_confirmation', TPortableNetworkGraphic);
357 end;
358 mtInformation: begin
359 Caption:= rsMtInformation;
360 image1.Picture.LoadFromResourceName(hInstance, 'dialog_information', TPortableNetworkGraphic);
361 end;
362 mtCustom: begin
363 Caption:= ApplicationName;
364 Image1.Width:= 8;
365 Image1.Hide;
366 end;
367 end;
368 Image1.Parent := LazMessageDialog;
369
370 if aCaption <> '' then //A custom dialog caption has been required
371 Caption:= aCaption;
372 Label1.Left:= Image1.Left + Image1.Width + 8;
373
374 {Select Buttons from Buttons}
375 if (Buttons = []) or (Buttons = [mbHelp]) then
376 Buttons:= Buttons + [mbOK]; // the dialog must provide a modal result
377 NumButtons:= 0;
378 { The order of Buttons is the same as in Qt - Totally different from GTK2}
379 if mbHelp in Buttons then begin
380 btnList[NumButtons] := TBitBtn.Create(LazMessageDialog);
381 btnList[NumButtons].Parent := LazMessageDialog;
382 btnList[NumButtons].Kind:= bkHelp;
383 inc(NumButtons);
384 end;
385 if mbYes in Buttons then begin
386 btnList[NumButtons] := TBitBtn.Create(LazMessageDialog);
387 btnList[NumButtons].Parent := LazMessageDialog;
388 btnList[NumButtons].Kind:= bkYes;
389 inc(NumButtons);
390 end;
391 if mbYesToAll in Buttons then begin
392 btnList[NumButtons] := TBitBtn.Create(LazMessageDialog);
393 btnList[NumButtons].Parent := LazMessageDialog;
394 btnList[NumButtons].Kind:= bkYesToAll;
395 inc(NumButtons);
396 end;
397 if mbNo in Buttons then begin
398 btnList[NumButtons] := TBitBtn.Create(LazMessageDialog);
399 btnList[NumButtons].Parent := LazMessageDialog;
400 btnList[NumButtons].Kind:= bkNo;
401 inc(NumButtons);
402 end;
403 if mbNoToAll in Buttons then begin
404 btnList[NumButtons] := TBitBtn.Create(LazMessageDialog);
405 btnList[NumButtons].Parent := LazMessageDialog;
406 btnList[NumButtons].Kind:= bkNoToAll;
407 inc(NumButtons);
408 end;
409 if mbAll in Buttons then begin
410 btnList[NumButtons] := TBitBtn.Create(LazMessageDialog);
411 btnList[NumButtons].Parent := LazMessageDialog;
412 btnList[NumButtons].Kind:= bkAll;
413 inc(NumButtons);
414 end;
415 if mbOK in Buttons then begin
416 btnList[NumButtons] := TBitBtn.Create(LazMessageDialog);
417 btnList[NumButtons].Parent := LazMessageDialog;
418 btnList[NumButtons].Kind:= bkOK;
419 inc(NumButtons);
420 end;
421 if mbRetry in Buttons then begin
422 btnList[NumButtons] := TBitBtn.Create(LazMessageDialog);
423 btnList[NumButtons].Parent := LazMessageDialog;
424 btnList[NumButtons].Kind:= bkRetry;
425 inc(NumButtons);
426 end;
427 if mbIgnore in Buttons then begin
428 btnList[NumButtons] := TBitBtn.Create(LazMessageDialog);
429 btnList[NumButtons].Parent := LazMessageDialog;
430 btnList[NumButtons].Kind:= bkIgnore;
431 inc(NumButtons);
432 end;
433 if mbCancel in Buttons then begin
434 btnList[NumButtons] := TBitBtn.Create(LazMessageDialog);
435 btnList[NumButtons].Parent := LazMessageDialog;
436 btnList[NumButtons].Kind:= bkCancel;
437 inc(NumButtons);
438 end;
439 if mbAbort in Buttons then begin
440 btnList[NumButtons] := TBitBtn.Create(LazMessageDialog);
441 btnList[NumButtons].Parent := LazMessageDialog;
442 btnList[NumButtons].Kind:= bkAbort;
443 inc(NumButtons);
444 end;
445 if mbClose in Buttons then begin
446 btnList[NumButtons] := TBitBtn.Create(LazMessageDialog);
447 btnList[NumButtons].Parent := LazMessageDialog;
448 btnList[NumButtons].Kind:= bkClose;
449 inc(NumButtons);
450 end;
451
452 ButtonPos:= Image1.Left;
453 for I:= 0 to NumButtons -1 do begin
454 btnList[I].Constraints.MinHeight:= 25;
455 btnList[I].Constraints.MinWidth:= 75;
456 btnList[I].Left:= ButtonPos;
457 btnList[I].Top:= Image1.Top + Image1.Height + 10;
458 {next line is required because even if Auyosize is true,
459 width property is changed only when the button is
460 painted. Either we wait (but Application.ProcessMessages is not enough)
461 or we force the actual width. We may safely use form canvas, because our
462 components inherit the font from the form (ParentFont = true by default)}
463 btnList[I].Width:= LazMessageDialog.Canvas.TextExtent(btnList[I].Caption).cx
464 + btnList[I].Glyph.Width + 20;
465
466 btnList[I].Visible:= True;
467 ButtonPos:= ButtonPos + btnList[I].Width + 8;
468 end;
469
470 { See comment above for width property. Static Text apparently doesn't behave
471 properly when Text is changed at run time. The width is set as appropriate, but
472 the text is written only up to the previous width. Therefore we must use a TLabel}
473 textWidth:= LazMessageDialog.Canvas.TextExtent(Label1.Caption).cx;
474
475 Label1.Width:= textWidth;
476 textWidth:= label1.Left + label1.Width;
477 RequiredWidth:= Max(textWidth,ButtonPos);
478 Width := RequiredWidth + 10;
479 Height:= btnList[0].Top + btnList[0].Height + 10;
480 // now let's move our buttons to the right side of dialog, if appropriate
481 BlankRight:= Width - ButtonPos;
482 if BlankRight > 10 then
483 for I:= 0 to NumButtons-1 do btnList[I].Left:= btnList[I].Left+BlankRight ;
484 end;
485 result := LazMessageDialog.ShowModal;
486 {$ifndef LCLCustomdrawn}LazMessageDialog.Release;{$endif}
487 end;
488
489 function LazMessageDlg(const aMsg: string; DlgType: TMsgDlgType;
490 Buttons: TMsgDlgButtons; HelpCtx: Longint): Integer;
491 begin
492 result := LazMessageDlg('',aMsg,DlgType,Buttons,HelpCtx);
493 end;
494
495 { TLazMessageDialog }
496
497 constructor TLazMessageDialog.CreateNew(TheOwner: TComponent; Num: Integer = 0);
498 begin
499 inherited CreateNew(TheOwner);
500 FormStyle:= fsStayOnTop;
501 Position:= poMainFormCenter;
502 Image1 := TImage.Create(Self);
503 Image1.Top:= 10;
504 Image1.Left:= 10;
505 Image1.Width:= 48;
506 Image1.Height:= 48;
507 Label1 := TLabel.Create(Self);
508 Label1.Top:= Image1.Top;
509 Label1.Left:= Image1.Left + Image1.Width + 10;
510 Label1.Caption:= 'Label1';
511 Width:= Image1.Width + Label1.Width + 20;
512 Height:= Image1.Height + 20;
513 end;
514
515
516 end.
517
518