1{%MainUnit ../dialogs.pp}
2
3{******************************************************************************
4                                  MessageDialogs
5 ******************************************************************************
6
7 *****************************************************************************
8  This file is part of the Lazarus Component Library (LCL)
9
10  See the file COPYING.modifiedLGPL.txt, included in this distribution,
11  for details about the license.
12 *****************************************************************************
13  current design flaws:
14
15  - ??? There has to be at least one :-)
16
17  Delphi compatibility:
18
19   - the interface is almost like in delphi 5
20
21  TODO:
22    - Help Context
23    - Help-button
24    - User ability to customize Button order
25
26}
27function ModalEscapeValue(Buttons: TMsgDlgButtons): TModalResult;
28begin
29    Result := mrCancel;
30end;
31
32function ModalDefaultButton(Buttons : TMsgDlgButtons) : TMsgDlgbtn;
33var
34  b: TMsgDlgBtn;
35begin
36  Result := mbYes;               // Some default return value.
37  If mbYes in Buttons then
38    Result := mbYes
39  else
40    If mbOk in Buttons then
41      Result := mbOk
42  else
43    If mbYesToAll in Buttons then
44      Result := mbYesToAll
45  else
46    If mbAll in Buttons then
47      Result := mbAll
48  else
49    If mbRetry in Buttons then
50      Result := mbRetry
51  else
52    If mbCancel in Buttons then
53      Result := mbCancel
54  else
55    If mbNo in Buttons then
56      Result := mbNo
57  else
58    If mbNoToAll in Buttons then
59      Result := mbNoToAll
60  else
61    If mbAbort in Buttons then
62      Result := mbAbort
63  else
64    If mbIgnore in Buttons then
65      Result := mbIgnore
66  else
67  begin
68    for b := Low(TMsgDlgBtn) to High(TMsgDlgBtn) do
69      if b in Buttons then
70        Result := b;
71  end;
72end;
73
74const
75  DialogIds : Array[mtWarning..mtCustom] of Longint = (idDialogWarning,
76    idDialogError, idDialogInfo, idDialogConfirm, idDialogBase);
77
78  ButtonIds : Array[TMsgDlgbtn] of Longint = (idButtonYes, idButtonNo,
79    idButtonOK, idButtonCancel, idButtonAbort, idButtonRetry, idButtonIgnore,
80    idButtonAll, idButtonNoToAll, idButtonYesToAll, idButtonHelp,
81    idButtonClose);
82
83  DialogResults : Array[idButtonOK..idButtonNoToAll] of TModalResult = (
84      mrOk, mrCancel,
85    mrNone{Help - when a mbHelp button is pressed the help system is started,
86                  the dialog does not close },
87    mrYes, mrNo, mrClose, mrAbort, mrRetry,
88    mrIgnore, mrAll, mrYesToAll, mrNoToAll);
89
90function GetPromptUserButtons(Buttons: TMsgDlgButtons; var CancelValue,
91  DefaultIndex, ButtonCount : Longint; UseDefButton: Boolean; DefButton: TMsgDlgBtn) : PLongint;
92var
93  CurBtn      : TMsgDlgBtn; // variable to loop through TMsgDlgButtons
94  DefaultButton : TMsgDlgBtn;
95begin
96 if (Buttons = []) or (Buttons = [mbHelp]) then
97    Buttons := Buttons + [mbOk];
98  //Native PromptUser() dialog should return mrCancel on Escape or [X]-bordericon
99  //TPromptDialog.CreatMessageDialog responds to Escape in "old Delhpi" style,
100  //it will return mrCancel, mrNo, or mrOK if one of these buttons is present, else it will not respons to Escape key,
101  //TPromptDialog.CreatMessageDialog does not use the CancelValue variable
102  CancelValue := idButtonCancel;
103  if UseDefButton then
104    DefaultButton := DefButton
105  else
106    DefaultButton := ModalDefaultButton(Buttons);
107  DefaultIndex := 0;
108  ButtonCount := 0;
109  Result := nil;
110  for CurBtn := Low(TMsgDlgBtn) to High(TMsgDlgBtn) do
111  begin
112    if CurBtn in Buttons then
113    begin
114      ReallocMem(Result, (ButtonCount + 1) * SizeOf(Longint));
115      Result[ButtonCount] := ButtonIds[CurBtn];
116      if DefaultButton = CurBtn then
117        DefaultIndex := ButtonCount;
118      Inc(ButtonCount)
119    end;
120  end;
121end;
122
123function MessageDlg(const aMsg: string; DlgType: TMsgDlgType;
124  Buttons: TMsgDlgButtons; HelpCtx: Longint): TModalResult;
125var
126  DefaultIndex,
127  CancelValue,
128  ButtonCount : Longint;
129  Btns : PLongint;
130begin
131  Btns := GetPromptUserButtons(Buttons, CancelValue, DefaultIndex, ButtonCount,
132    False, mbYes);
133  Result := DialogResults[PromptUser(LineBreaksToSystemLineBreaks(aMsg),
134    DialogIds[DlgType], Btns, ButtonCount, DefaultIndex, CancelValue)];
135  ReallocMem(Btns, 0);
136end;
137
138function MessageDlg(const aCaption, aMsg: string; DlgType: TMsgDlgType;
139  Buttons: TMsgDlgButtons; HelpCtx: Longint): TModalResult;
140var
141  DefaultIndex,
142  CancelValue,
143  ButtonCount : Longint;
144  Btns : PLongint;
145begin
146  Btns := GetPromptUserButtons(Buttons, CancelValue, DefaultIndex, ButtonCount,
147    False, mbYes);
148  Result := DialogResults[PromptUser(aCaption, LineBreaksToSystemLineBreaks(aMsg),
149    DialogIds[DlgType], Btns, ButtonCount, DefaultIndex, CancelValue)];
150  ReallocMem(Btns, 0);
151end;
152
153function MessageDlg(const aCaption, aMsg: string; DlgType: TMsgDlgType;
154  Buttons: TMsgDlgButtons; HelpCtx: Longint; DefaultButton: TMsgDlgBtn): TModalResult;
155var
156  DefaultIndex,
157  CancelValue,
158  ButtonCount : Longint;
159  Btns : PLongint;
160begin
161  Btns := GetPromptUserButtons(Buttons, CancelValue, DefaultIndex, ButtonCount,
162    True, DefaultButton);
163  Result := DialogResults[PromptUser(aCaption, LineBreaksToSystemLineBreaks(aMsg),
164    DialogIds[DlgType], Btns, ButtonCount, DefaultIndex, CancelValue)];
165  ReallocMem(Btns, 0);
166end;
167
168function MessageDlg(const aMsg: string; DlgType: TMsgDlgType;
169  Buttons: TMsgDlgButtons; HelpCtx: Longint; DefaultButton: TMsgDlgBtn
170  ): TModalResult;
171begin
172  Result := MessageDlg('', aMsg, DlgType, Buttons, HelpCtx, DefaultButton);
173end;
174
175function MessageDlg(const aCaption, aMsg: string; DlgType: TMsgDlgType;
176  Buttons: TMsgDlgButtons; const HelpKeyword: string): TModalResult;
177begin
178  // TODO: handle HelpKeyword
179  Result:=MessageDlg(aCaption, aMsg, DlgType, Buttons, 0);
180end;
181
182function MessageDlgPos(const aMsg: string; DlgType: TMsgDlgType;
183  Buttons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer): TModalResult;
184var
185  DefaultIndex,
186  CancelValue,
187  ButtonCount : Longint;
188  Btns : PLongint;
189begin
190  Btns := GetPromptUserButtons(Buttons, CancelValue, DefaultIndex, ButtonCount,
191    False, mbYes);
192  Result := DialogResults[PromptUserAtXY(LineBreaksToSystemLineBreaks(aMsg),
193    DialogIds[DlgType], Btns, ButtonCount, DefaultIndex, CancelValue, X, Y)];
194  ReallocMem(Btns, 0);
195end;
196
197function MessageDlgPosHelp(const aMsg: string; DlgType: TMsgDlgType;
198  Buttons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer;
199  const HelpFileName: string): TModalResult;
200begin
201  DebugLn ('MessageDlgPosHelp ****** NOT YET FULLY IMPLEMENTED ********');
202//TODO: set helpcontext and helpfile
203  result := MessageDlgPos(aMsg, DlgType, buttons, helpctx, X, Y);
204end;
205
206procedure ShowMessage(const aMsg: string);
207begin
208  NotifyUser(LineBreaksToSystemLineBreaks(aMsg), idDialogBase);
209end;
210
211procedure ShowMessageFmt(const aMsg: string; Params: array of const);
212begin
213  NotifyUser(LineBreaksToSystemLineBreaks(Format(aMsg, Params)), idDialogBase);
214end;
215
216procedure ShowMessagePos(const aMsg: string; X, Y: Integer);
217begin
218  NotifyUserAtXY(LineBreaksToSystemLineBreaks(aMsg), idDialogBase, X, Y);
219end;
220
221//----------------------------------------------------------------------------//
222//-----------------------Prompt User For Information--------------------------//
223function InputBox(const ACaption, APrompt, ADefault : String) : String;
224begin
225  Result := ADefault;
226  InputQuery(ACaption, APrompt, Result);
227end;
228
229function PasswordBox(const ACaption, APrompt : String) : String;
230begin
231  Result := '';
232  InputQuery(ACaption, APrompt, True, Result);
233end;
234
235procedure DialogCopyToClipboard(Self, Sender: TObject; var Key: Word;
236  Shift: TShiftState);
237var
238  S: string;
239  Dlg: TCustomForm;
240  Cnt, LastCnt: TControl;
241begin
242  if not ((Key in [VK_C, VK_INSERT]) and (Shift = [ssModifier])) then
243    Exit;
244
245  Dlg := Self as TCustomForm;
246
247  S := Format('[%s]', [Dlg.Caption]) + sLineBreak;
248  LastCnt := nil;
249
250  if Dlg is TCustomCopyToClipboardDialog then
251    S := S + sLineBreak + TCustomCopyToClipboardDialog(Dlg).GetMessageText + sLineBreak;
252
253  for Cnt in Dlg.GetEnumeratorControls do
254  begin
255    if (Cnt is TCustomLabel) then
256    begin
257      S := S + sLineBreak + Cnt.Caption + sLineBreak;
258      LastCnt := nil;
259    end else
260    begin
261      if (LastCnt=nil) or (LastCnt.Top > Cnt.Top) then
262        S := S + sLineBreak+sLineBreak
263      else
264        S := S + ' ';
265
266      S := S + Format('[%s]', [StripHotKey(Cnt.Caption)]);
267      LastCnt := Cnt;
268    end;
269  end;
270
271  Clipboard.AsText := TrimRight(S);
272end;
273
274procedure RegisterDialogForCopyToClipboard(const ADlg: TCustomForm);
275var
276  Mtd: TMethod;
277begin
278  ADlg.KeyPreview := True;
279  Mtd.Code := @DialogCopyToClipboard;
280  Mtd.Data := ADlg;
281  ADlg.AddHandlerOnKeyDown(TKeyEvent(Mtd));
282end;
283
284function SelectDirectory(const Caption, InitialDirectory: string;
285  out Directory: string): boolean;
286begin
287  Result:=SelectDirectory(Caption,InitialDirectory,Directory,false);
288end;
289
290function SelectDirectory(const Caption, InitialDirectory: string;
291  out Directory: string; ShowHidden: boolean; HelpCtx: Longint): boolean;
292var
293  SelectDirectoryDialog: TSelectDirectoryDialog;
294begin
295  SelectDirectoryDialog:=TSelectDirectoryDialog.Create(nil);
296  try
297    if ShowHidden then
298      SelectDirectoryDialog.Options:=SelectDirectoryDialog.Options
299                                     +[ofForceShowHidden];
300    SelectDirectoryDialog.InitialDir:=InitialDirectory;
301    SelectDirectoryDialog.Title:=Caption;
302    SelectDirectoryDialog.HelpContext:=HelpCtx;
303    Result:=SelectDirectoryDialog.Execute;
304    if Result then
305      Directory:=SelectDirectoryDialog.Filename
306    else
307      Directory:='';
308  finally
309    SelectDirectoryDialog.Free;
310  end;
311end;
312
313function SelectDirectory(out Directory: string;
314  Options: TSelectDirOpts; HelpCtx: Longint): Boolean;
315var
316  SelectDirectoryDialog: TSelectDirectoryDialog;
317begin
318  SelectDirectoryDialog:=TSelectDirectoryDialog.Create(nil);
319  // TODO: sdAllowCreate,
320  // TODO: sdPrompt
321  try
322    SelectDirectoryDialog.HelpContext:=HelpCtx;
323    Result:=SelectDirectoryDialog.Execute;
324    if Result then begin
325      Directory:=SelectDirectoryDialog.Filename;
326      if (sdPerformCreate in Options) and (not DirPathExists(Directory)) then
327        ForceDirectoriesUTF8(Directory);
328    end else
329      Directory:='';
330  finally
331    SelectDirectoryDialog.Free;
332  end;
333end;
334
335function InputQuery(const ACaption, APrompt : String; MaskInput : Boolean;
336  var Value : String) : Boolean;
337begin
338  Result := LCLIntf.RequestInput(ACaption, LineBreaksToSystemLineBreaks(APrompt),
339    MaskInput, Value);
340end;
341
342function InputQuery(const ACaption, APrompt : String; var Value : String) : Boolean;
343begin
344  Result := InputQuery(ACaption, APrompt, False, Value);
345end;
346
347{ TDummyForInput }
348
349type
350  TDummyEditList = array of TEdit;
351  PDummyEditList = ^TDummyEditList;
352
353  TDummyForInput = class(TForm)
354  public
355    FEditsPtr: PDummyEditList;
356    FOnCloseEvent: TInputCloseQueryEvent;
357    procedure FOnClick(Sender: TObject);
358  end;
359
360procedure TDummyForInput.FOnClick(Sender: TObject);
361var
362  Cfm: boolean;
363  Str: array of string;
364  i: integer;
365begin
366  Cfm:= true;
367  if Assigned(FOnCloseEvent) then
368  begin
369    SetLength(Str, Length(FEditsPtr^));
370    for i:= 0 to Length(Str)-1 do
371      Str[i]:= FEditsPtr^[i].Text;
372    FOnCloseEvent(nil, Str, Cfm);
373  end;
374  if Cfm then
375    ModalResult:= mrOk;
376end;
377
378
379function InputQuery(const ACaption: string; const APrompts: array of string;
380  var AValues: array of string; ACloseEvent: TInputCloseQueryEvent): boolean;
381var
382  FPanels: array of TPanel;
383  FEdits: array of TEdit;
384  FLabels: array of TPanel;
385  FButtons: TButtonPanel;
386  FForm: TDummyForInput;
387  Len, NSpacing, NEditWidth, i: integer;
388
389  function GetPromptCaption(const APrompt: string): string;
390  begin
391    Result:= APrompt;
392    if (Result<>'') and (Result[1]<' ') then
393      Delete(Result, 1, 1);
394  end;
395
396  function GetPasswordChar(const APrompt: string): Char;
397  begin
398    if (APrompt<>'') and (APrompt[1]<' ') then
399      Result := '*'
400    else
401      Result := #0;
402  end;
403
404begin
405  Result:= false;
406  if Length(APrompts)<1 then
407    raise EInvalidOperation.Create('InputQuery: prompt array cannot be empty');
408  if Length(APrompts)>Length(AValues) then
409    raise EInvalidOperation.Create('InputQuery: prompt array length must be <= value array length');
410
411  Len:= Length(AValues);
412  SetLength(FPanels, Len);
413  SetLength(FLabels, Len);
414  SetLength(FEdits, Len);
415
416  FForm:= TDummyForInput.CreateNew(nil);
417  try
418    FForm.Width:= FForm.Scale96ToForm(600);
419    FForm.Height:= FForm.Scale96ToForm(400);
420    FForm.BorderStyle:= bsDialog;
421    FForm.Position:= poScreenCenter;
422    FForm.Caption:= ACaption;
423    FForm.FOnCloseEvent:= ACloseEvent;
424
425    NSpacing:= FForm.Scale96ToForm(cInputQuerySpacingSize);
426    NEditWidth:= Max(
427      FForm.Scale96ToForm(cInputQueryEditSizePixels),
428      _InputQueryActiveMonitor.Width * cInputQueryEditSizePercents div 100);
429
430    FButtons:= TButtonPanel.Create(FForm);
431    FButtons.Parent:= FForm;
432    FButtons.ShowButtons:= [pbOK, pbCancel];
433    FButtons.ShowBevel:= false;
434    FButtons.OKButton.OnClick:= @FForm.FOnClick;
435    FButtons.OKButton.ModalResult:= mrNone;
436
437    for i:= 0 to Len-1 do
438    begin
439      FPanels[i]:= TPanel.Create(FForm);
440      FPanels[i].Parent:= FForm;
441      FPanels[i].Align:= alTop;
442      FPanels[i].BevelInner:= bvNone;
443      FPanels[i].BevelOuter:= bvNone;
444      FPanels[i].AutoSize:= true;
445      FPanels[i].BorderSpacing.Around:= NSpacing;
446
447      //fix order of panels
448      if i>0 then
449        FPanels[i].Top:= FPanels[i-1].Top+10;
450
451      FEdits[i]:= TEdit.Create(FForm);
452      FEdits[i].Parent:= FPanels[i];
453      FEdits[i].Align:= alRight;
454      FEdits[i].Width:= NEditWidth;
455      FEdits[i].Text:= AValues[i];
456      if i<Length(APrompts) then
457        FEdits[i].PasswordChar:= GetPasswordChar(APrompts[i]);
458
459      FLabels[i]:= TPanel.Create(FForm);
460      FLabels[i].Parent:= FPanels[i];
461      FLabels[i].Align:= alRight;
462      FLabels[i].BevelInner:= bvNone;
463      FLabels[i].BevelOuter:= bvNone;
464      if i<Length(APrompts) then
465        FLabels[i].Caption:= GetPromptCaption(APrompts[i]);
466      FLabels[i].BorderSpacing.Right:= NSpacing;
467      FLabels[i].Width:= FLabels[i].Canvas.TextWidth(FLabels[i].Caption);
468
469      FEdits[i].Left:= FForm.Width; // place edits to right
470    end;
471
472    FButtons.Align:= alTop;
473    FButtons.Top:= FPanels[Len-1].Top+10; // place buttons to bottom
474
475    FForm.AutoSize:= true;
476    FForm.ActiveControl:= FEdits[0];
477    FForm.FEditsPtr:= @FEdits;
478
479    Result:= FForm.ShowModal=mrOk;
480    if Result then
481      for i:= 0 to Len-1 do
482        AValues[i]:= FEdits[i].Text;
483  finally
484    FreeAndNil(FForm);
485  end;
486end;
487
488// included by dialogs.pp
489
490