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