Source/TntDialogs.pas

   1
   2 {*****************************************************************************}
   3 {                                                                             }
   4 {    Tnt Delphi Unicode Controls                                              }
   5 {      http://www.tntware.com/delphicontrols/unicode/                         }
   6 {        Version: 2.3.0                                                       }
   7 {                                                                             }
   8 {    Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com)       }
   9 {                                                                             }
  10 {*****************************************************************************}
  11
  12 unit TntDialogs;
  13
  14 {$INCLUDE TntCompilers.inc}
  15
  16 interface
  17
  18 { TODO: TFindDialog and TReplaceDialog. }
  19 { TODO: Property editor for TTntOpenDialog.Filter }
  20
  21 uses
  22   Classes, Messages, CommDlg, Windows, Dialogs,
  23   TntClasses, TntForms, TntSysUtils;
  24
  25 type
  26 {TNT-WARN TIncludeItemEvent}
  27   TIncludeItemEventW = procedure (const OFN: TOFNotifyExW; var Include: Boolean) of object;
  28
  29 {TNT-WARN TOpenDialog}
  30   TTntOpenDialog = class(TOpenDialog{TNT-ALLOW TOpenDialog})
  31   private
  32     FDefaultExt: WideString;
  33     FFileName: TWideFileName;
  34     FFilter: WideString;
  35     FInitialDir: WideString;
  36     FTitle: WideString;
  37     FFiles: TTntStrings;
  38     FOnIncludeItem: TIncludeItemEventW;
  39     function GetDefaultExt: WideString;
  40     procedure SetInheritedDefaultExt(const Value: AnsiString);
  41     procedure SetDefaultExt(const Value: WideString);
  42     function GetFileName: TWideFileName;
  43     procedure SetFileName(const Value: TWideFileName);
  44     function GetFilter: WideString;
  45     procedure SetInheritedFilter(const Value: AnsiString);
  46     procedure SetFilter(const Value: WideString);
  47     function GetInitialDir: WideString;
  48     procedure SetInheritedInitialDir(const Value: AnsiString);
  49     procedure SetInitialDir(const Value: WideString);
  50     function GetTitle: WideString;
  51     procedure SetInheritedTitle(const Value: AnsiString);
  52     procedure SetTitle(const Value: WideString);
  53     function GetFiles: TTntStrings;
  54   private
  55     FProxiedOpenFilenameA: TOpenFilenameA;
  56   protected
  57     FAllowDoCanClose: Boolean;
  58     procedure DefineProperties(Filer: TFiler); override;
  59     function CanCloseW(var OpenFileName: TOpenFileNameW): Boolean;
  60     function DoCanClose: Boolean; override;
  61     procedure GetFileNamesW(var OpenFileName: TOpenFileNameW);
  62     procedure DoIncludeItem(const OFN: TOFNotifyEx; var Include: Boolean); override;
  63     procedure WndProc(var Message: TMessage); override;
  64     function DoExecuteW(Func: Pointer; ParentWnd: HWND): Bool; overload;
  65     function DoExecuteW(Func: Pointer): Bool; overload;
  66   public
  67     constructor Create(AOwner: TComponent); override;
  68     destructor Destroy; override;
  69     function Execute: Boolean; override;
  70     {$IFDEF COMPILER_9_UP}
  71     function Execute(ParentWnd: HWND): Boolean; override;
  72     {$ENDIF}
  73     property Files: TTntStrings read GetFiles;
  74   published
  75     property DefaultExt: WideString read GetDefaultExt write SetDefaultExt;
  76     property FileName: TWideFileName read GetFileName write SetFileName;
  77     property Filter: WideString read GetFilter write SetFilter;
  78     property InitialDir: WideString read GetInitialDir write SetInitialDir;
  79     property Title: WideString read GetTitle write SetTitle;
  80     property OnIncludeItem: TIncludeItemEventW read FOnIncludeItem write FOnIncludeItem;
  81   end;
  82
  83 {TNT-WARN TSaveDialog}
  84   TTntSaveDialog = class(TTntOpenDialog)
  85   public
  86     function Execute: Boolean; override;
  87     {$IFDEF COMPILER_9_UP}
  88     function Execute(ParentWnd: HWND): Boolean; override;
  89     {$ENDIF}
  90   end;
  91
  92 { Message dialog }
  93
  94 {TNT-WARN CreateMessageDialog}
  95 function WideCreateMessageDialog(const Msg: WideString; DlgType: TMsgDlgType;
  96   Buttons: TMsgDlgButtons): TTntForm;overload;
  97 function WideCreateMessageDialog(const Msg: WideString; DlgType: TMsgDlgType;
  98   Buttons: TMsgDlgButtons; DefaultButton: TMsgDlgBtn): TTntForm; overload;
  99
 100 {TNT-WARN MessageDlg}
 101 function WideMessageDlg(const Msg: WideString; DlgType: TMsgDlgType;
 102   Buttons: TMsgDlgButtons; HelpCtx: Longint): Integer; overload;
 103 function WideMessageDlg(const Msg: WideString; DlgType: TMsgDlgType;
 104   Buttons: TMsgDlgButtons; HelpCtx: Longint; DefaultButton: TMsgDlgBtn): Integer; overload;
 105
 106 {TNT-WARN MessageDlgPos}
 107 function WideMessageDlgPos(const Msg: WideString; DlgType: TMsgDlgType;
 108   Buttons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer): Integer; overload;
 109 function WideMessageDlgPos(const Msg: WideString; DlgType: TMsgDlgType;
 110   Buttons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer; DefaultButton: TMsgDlgBtn): Integer; overload;
 111
 112 {TNT-WARN MessageDlgPosHelp}
 113 function WideMessageDlgPosHelp(const Msg: WideString; DlgType: TMsgDlgType;
 114   Buttons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer;
 115   const HelpFileName: WideString): Integer; overload;
 116 function WideMessageDlgPosHelp(const Msg: WideString; DlgType: TMsgDlgType;
 117   Buttons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer;
 118   const HelpFileName: WideString; DefaultButton: TMsgDlgBtn): Integer; overload;
 119
 120 {TNT-WARN ShowMessage}
 121 procedure WideShowMessage(const Msg: WideString);
 122 {TNT-WARN ShowMessageFmt}
 123 procedure WideShowMessageFmt(const Msg: WideString; Params: array of const);
 124 {TNT-WARN ShowMessagePos}
 125 procedure WideShowMessagePos(const Msg: WideString; X, Y: Integer);
 126
 127 { Input dialog }
 128
 129 {TNT-WARN InputQuery}
 130 function WideInputQuery(const ACaption, APrompt: WideString;
 131    var Value: WideString): Boolean;
 132 {TNT-WARN InputBox}
 133 function WideInputBox(const ACaption, APrompt, ADefault: WideString): WideString;
 134
 135 {TNT-WARN PromptForFileName}
 136 function WidePromptForFileName(var AFileName: WideString; const AFilter: WideString = '';
 137   const ADefaultExt: WideString = ''; const ATitle: WideString = '';
 138   const AInitialDir: WideString = ''; SaveDialog: Boolean = False): Boolean;
 139
 140 function GetModalParentWnd: HWND;
 141
 142 implementation
 143
 144 uses
 145   Controls, Forms, Types, SysUtils, Graphics, Consts, Math,
 146   TntWindows, TntStdCtrls, TntClipBrd, TntExtCtrls,
 147   {$IFDEF COMPILER_9_UP} WideStrUtils, {$ENDIF} TntWideStrUtils;
 148
 149 function GetModalParentWnd: HWND;
 150 begin
 151   {$IFDEF COMPILER_9}
 152   Result := Application.ActiveFormHandle;
 153   {$ELSE}
 154   Result := 0;
 155   {$ENDIF}
 156   {$IFDEF COMPILER_10_UP}
 157   if Application.ModalPopupMode <> pmNone then
 158   begin
 159     Result := Application.ActiveFormHandle;
 160   end;
 161   {$ENDIF}
 162   if Result = 0 then begin
 163     Result := Application.Handle;
 164   end;
 165 end;
 166
 167 var
 168   ProxyExecuteDialog: TTntOpenDialog;
 169
 170 function ProxyGetOpenFileNameA(var OpenFile: TOpenFilename): Bool; stdcall;
 171 begin
 172   ProxyExecuteDialog.FProxiedOpenFilenameA := OpenFile;
 173   Result := False; { as if user hit "Cancel". }
 174 end;
 175
 176 { TTntOpenDialog }
 177
 178 constructor TTntOpenDialog.Create(AOwner: TComponent);
 179 begin
 180   inherited;
 181   FFiles := TTntStringList.Create;
 182 end;
 183
 184 destructor TTntOpenDialog.Destroy;
 185 begin
 186   FreeAndNil(FFiles);
 187   inherited;
 188 end;
 189
 190 procedure TTntOpenDialog.DefineProperties(Filer: TFiler);
 191 begin
 192   inherited;
 193   TntPersistent_AfterInherited_DefineProperties(Filer, Self);
 194 end;
 195
 196 function TTntOpenDialog.GetDefaultExt: WideString;
 197 begin
 198   Result := GetSyncedWideString(FDefaultExt, inherited DefaultExt);
 199 end;
 200
 201 procedure TTntOpenDialog.SetInheritedDefaultExt(const Value: AnsiString);
 202 begin
 203   inherited DefaultExt := Value;
 204 end;
 205
 206 procedure TTntOpenDialog.SetDefaultExt(const Value: WideString);
 207 begin
 208   SetSyncedWideString(Value, FDefaultExt, inherited DefaultExt, SetInheritedDefaultExt);
 209 end;
 210
 211 function TTntOpenDialog.GetFileName: TWideFileName;
 212 var
 213   Path: array[0..MAX_PATH] of WideChar;
 214 begin
 215   if Win32PlatformIsUnicode and NewStyleControls and (Handle <> 0) then begin
 216     // get filename from handle
 217     SendMessageW(GetParent(Handle), CDM_GETFILEPATH, SizeOf(Path), Integer(@Path));
 218     Result := Path;
 219   end else
 220     Result := GetSyncedWideString(WideString(FFileName), inherited FileName);
 221 end;
 222
 223 procedure TTntOpenDialog.SetFileName(const Value: TWideFileName);
 224 begin
 225   FFileName := Value;
 226   inherited FileName := Value;
 227 end;
 228
 229 function TTntOpenDialog.GetFilter: WideString;
 230 begin
 231   Result := GetSyncedWideString(FFilter, inherited Filter);
 232 end;
 233
 234 procedure TTntOpenDialog.SetInheritedFilter(const Value: AnsiString);
 235 begin
 236   inherited Filter := Value;
 237 end;
 238
 239 procedure TTntOpenDialog.SetFilter(const Value: WideString);
 240 begin
 241   SetSyncedWideString(Value, FFilter, inherited Filter, SetInheritedFilter);
 242 end;
 243
 244 function TTntOpenDialog.GetInitialDir: WideString;
 245 begin
 246   Result := GetSyncedWideString(FInitialDir, inherited InitialDir);
 247 end;
 248
 249 procedure TTntOpenDialog.SetInheritedInitialDir(const Value: AnsiString);
 250 begin
 251   inherited InitialDir := Value;
 252 end;
 253
 254 procedure TTntOpenDialog.SetInitialDir(const Value: WideString);
 255
 256   function RemoveTrailingPathDelimiter(const Value: WideString): WideString;
 257   var
 258     L: Integer;
 259   begin
 260     // remove trailing path delimiter (except 'C:\')
 261     L := Length(Value);
 262     if (L > 1) and WideIsPathDelimiter(Value, L) and not WideIsDelimiter(':', Value, L - 1) then
 263       Dec(L);
 264     Result := Copy(Value, 1, L);
 265   end;
 266
 267 begin
 268   SetSyncedWideString(RemoveTrailingPathDelimiter(Value), FInitialDir,
 269     inherited InitialDir, SetInheritedInitialDir);
 270 end;
 271
 272 function TTntOpenDialog.GetTitle: WideString;
 273 begin
 274   Result := GetSyncedWideString(FTitle, inherited Title)
 275 end;
 276
 277 procedure TTntOpenDialog.SetInheritedTitle(const Value: AnsiString);
 278 begin
 279   inherited Title := Value;
 280 end;
 281
 282 procedure TTntOpenDialog.SetTitle(const Value: WideString);
 283 begin
 284   SetSyncedWideString(Value, FTitle, inherited Title, SetInheritedTitle);
 285 end;
 286
 287 function TTntOpenDialog.GetFiles: TTntStrings;
 288 begin
 289   if (not Win32PlatformIsUnicode) then
 290     FFiles.Assign(inherited Files);
 291   Result := FFiles;
 292 end;
 293
 294 function TTntOpenDialog.DoCanClose: Boolean;
 295 begin
 296   if FAllowDoCanClose then
 297     Result := inherited DoCanClose
 298   else
 299     Result := True;
 300 end;
 301
 302 function TTntOpenDialog.CanCloseW(var OpenFileName: TOpenFileNameW): Boolean;
 303 begin
 304   GetFileNamesW(OpenFileName);
 305   FAllowDoCanClose := True;
 306   try
 307     Result := DoCanClose;
 308   finally
 309     FAllowDoCanClose := False;
 310   end;
 311   FFiles.Clear;
 312   inherited Files.Clear;
 313 end;
 314
 315 procedure TTntOpenDialog.DoIncludeItem(const OFN: TOFNotifyEx; var Include: Boolean);
 316 begin
 317   // CDN_INCLUDEITEM -> DoIncludeItem() is only be available on Windows 2000 +
 318   // Therefore, just cast OFN as a TOFNotifyExW, since that's what it really is.
 319   if Win32PlatformIsUnicode and Assigned(FOnIncludeItem) then
 320     FOnIncludeItem(TOFNotifyExW(OFN), Include)
 321 end;
 322
 323 procedure TTntOpenDialog.WndProc(var Message: TMessage);
 324 begin
 325   Message.Result := 0;
 326   if (Message.Msg = WM_INITDIALOG) and not (ofOldStyleDialog in Options) then begin
 327     { If not ofOldStyleDialog then DoShow on CDN_INITDONE, not WM_INITDIALOG }
 328     Exit;
 329   end;
 330   if Win32PlatformIsUnicode
 331   and (Message.Msg = WM_NOTIFY) then begin
 332     case (POFNotify(Message.LParam)^.hdr.code) of
 333       CDN_FILEOK:
 334         if not CanCloseW(POFNotifyW(Message.LParam)^.lpOFN^) then
 335         begin
 336           Message.Result := 1;
 337           SetWindowLong(Handle, DWL_MSGRESULT, Message.Result);
 338           Exit;
 339         end;
 340     end;
 341   end;
 342   inherited WndProc(Message);
 343 end;
 344
 345 function TTntOpenDialog.DoExecuteW(Func: Pointer): Bool;
 346 begin
 347   Result := DoExecuteW(Func, GetModalParentWnd);
 348 end;
 349
 350 function TTntOpenDialog.DoExecuteW(Func: Pointer; ParentWnd: HWND): Bool;
 351 var
 352   OpenFilename: TOpenFilenameW;
 353
 354   function GetResNamePtr(var ScopedStringStorage: WideString; lpszName: PAnsiChar): PWideChar;
 355   // duplicated from TntTrxResourceUtils.pas
 356   begin
 357     if Tnt_Is_IntResource(PWideChar(lpszName)) then
 358       Result := PWideChar(lpszName)
 359     else begin
 360       ScopedStringStorage := lpszName;
 361       Result := PWideChar(ScopedStringStorage);
 362     end;
 363   end;
 364
 365   function AllocFilterStr(const S: WideString): WideString;
 366   var
 367     P: PWideChar;
 368   begin
 369     Result := '';
 370     if S <> '' then
 371     begin
 372       Result := S + #0#0;  // double null terminators (an additional zero added in case Description/Filter pair not even.)
 373       P := WStrScan(PWideChar(Result), '|');
 374       while P <> nil do
 375       begin
 376         P^ := #0;
 377         Inc(P);
 378         P := WStrScan(P, '|');
 379       end;
 380     end;
 381   end;
 382
 383 var
 384   TempTemplate, TempFilter, TempFilename, TempExt: WideString;
 385 begin
 386   FFiles.Clear;
 387
 388   // 1. Init inherited dialog defaults.
 389   // 2. Populate OpenFileName record with ansi defaults
 390   ProxyExecuteDialog := Self;
 391   try
 392     DoExecute(@ProxyGetOpenFileNameA);
 393   finally
 394     ProxyExecuteDialog := nil;
 395   end;
 396   OpenFileName := TOpenFilenameW(FProxiedOpenFilenameA);
 397
 398   with OpenFilename do
 399   begin
 400     if not IsWindow(hWndOwner) then begin
 401       hWndOwner := ParentWnd;
 402     end;
 403     // Filter (PChar -> PWideChar)
 404     TempFilter := AllocFilterStr(Filter);
 405     lpstrFilter := PWideChar(TempFilter);
 406     // FileName (PChar -> PWideChar)
 407     SetLength(TempFilename, nMaxFile + 2);
 408     lpstrFile := PWideChar(TempFilename);
 409     FillChar(lpstrFile^, (nMaxFile + 2) * SizeOf(WideChar), 0);
 410     WStrLCopy(lpstrFile, PWideChar(FileName), nMaxFile);
 411     // InitialDir (PChar -> PWideChar)
 412     if (InitialDir = '') and ForceCurrentDirectory then
 413       lpstrInitialDir := '.'
 414     else
 415       lpstrInitialDir := PWideChar(InitialDir);
 416     // Title (PChar -> PWideChar)
 417     lpstrTitle := PWideChar(Title);
 418     // DefaultExt (PChar -> PWideChar)
 419     TempExt := DefaultExt;
 420     if (TempExt = '') and (Flags and OFN_EXPLORER = 0) then
 421     begin
 422       TempExt := WideExtractFileExt(Filename);
 423       Delete(TempExt, 1, 1);
 424     end;
 425     if TempExt <> '' then
 426       lpstrDefExt := PWideChar(TempExt);
 427     // resource template (PChar -> PWideChar)
 428     lpTemplateName := GetResNamePtr(TempTemplate, Template);
 429     // start modal dialog
 430     Result := TaskModalDialog(Func, OpenFileName);
 431     if Result then
 432     begin
 433       GetFileNamesW(OpenFilename);
 434       if (Flags and OFN_EXTENSIONDIFFERENT) <> 0 then
 435         Options := Options + [ofExtensionDifferent]
 436       else
 437         Options := Options - [ofExtensionDifferent];
 438       if (Flags and OFN_READONLY) <> 0 then
 439         Options := Options + [ofReadOnly]
 440       else
 441         Options := Options - [ofReadOnly];
 442       FilterIndex := nFilterIndex;
 443     end;
 444   end;
 445 end;
 446
 447 procedure TTntOpenDialog.GetFileNamesW(var OpenFileName: TOpenFileNameW);
 448 var
 449   Separator: WideChar;
 450
 451   procedure ExtractFileNamesW(P: PWideChar);
 452   var
 453     DirName, FileName: TWideFileName;
 454     FileList: TWideStringDynArray;
 455     i: integer;
 456   begin
 457     FileList := ExtractStringsFromStringArray(P, Separator);
 458     if Length(FileList) = 0 then
 459       FFiles.Add('')
 460     else begin
 461       DirName := FileList[0];
 462       if Length(FileList) = 1 then
 463         FFiles.Add(DirName)
 464       else begin
 465         // prepare DirName
 466         if WideLastChar(DirName) <> WideString(PathDelim) then
 467           DirName := DirName + PathDelim;
 468         // add files
 469         for i := 1 {second item} to High(FileList) do begin
 470           FileName := FileList[i];
 471           // prepare FileName
 472           if (FileName[1] <> PathDelim)
 473           and ((Length(FileName) <= 3) or (FileName[2] <> DriveDelim) or (FileName[3] <> PathDelim))
 474           then
 475             FileName := DirName + FileName;
 476           // add to list
 477           FFiles.Add(FileName);
 478         end;
 479       end;
 480     end;
 481   end;
 482
 483 var
 484   P: PWideChar;
 485 begin
 486   Separator := #0;
 487   if (ofAllowMultiSelect in Options) and
 488     ((ofOldStyleDialog in Options) or not NewStyleControls) then
 489     Separator := ' ';
 490   with OpenFileName do
 491   begin
 492     if ofAllowMultiSelect in Options then
 493     begin
 494       ExtractFileNamesW(lpstrFile);
 495       FileName := FFiles[0];
 496     end else
 497     begin
 498       P := lpstrFile;
 499       FileName := ExtractStringFromStringArray(P, Separator);
 500       FFiles.Add(FileName);
 501     end;
 502   end;
 503
 504   // Sync inherited Files
 505   inherited Files.Assign(FFiles);
 506 end;
 507
 508 function TTntOpenDialog.Execute: Boolean;
 509 begin
 510   if (not Win32PlatformIsUnicode) then
 511     Result := DoExecute(@GetOpenFileNameA)
 512   else
 513     Result := DoExecuteW(@GetOpenFileNameW);
 514 end;
 515
 516 {$IFDEF COMPILER_9_UP}
 517 function TTntOpenDialog.Execute(ParentWnd: HWND): Boolean;
 518 begin
 519   if (not Win32PlatformIsUnicode) then
 520     Result := DoExecute(@GetOpenFileNameA, ParentWnd)
 521   else
 522     Result := DoExecuteW(@GetOpenFileNameW, ParentWnd);
 523 end;
 524 {$ENDIF}
 525
 526 { TTntSaveDialog }
 527
 528 function TTntSaveDialog.Execute: Boolean;
 529 begin
 530   if (not Win32PlatformIsUnicode) then
 531     Result := DoExecute(@GetSaveFileNameA)
 532   else
 533     Result := DoExecuteW(@GetSaveFileNameW);
 534 end;
 535
 536 {$IFDEF COMPILER_9_UP}
 537 function TTntSaveDialog.Execute(ParentWnd: HWND): Boolean;
 538 begin
 539   if (not Win32PlatformIsUnicode) then
 540     Result := DoExecute(@GetSaveFileNameA, ParentWnd)
 541   else
 542     Result := DoExecuteW(@GetSaveFileNameW, ParentWnd);
 543 end;
 544 {$ENDIF}
 545
 546 { Message dialog }
 547
 548 function GetAveCharSize(Canvas: TCanvas): TPoint;
 549 var
 550   I: Integer;
 551   Buffer: array[0..51] of WideChar;
 552   tm: TTextMetric;
 553 begin
 554   for I := 0 to 25 do Buffer[I] := WideChar(I + Ord('A'));
 555   for I := 0 to 25 do Buffer[I + 26] := WideChar(I + Ord('a'));
 556   GetTextMetrics(Canvas.Handle, tm);
 557   GetTextExtentPointW(Canvas.Handle, Buffer, 52, TSize(Result));
 558   Result.X := (Result.X div 26 + 1) div 2;
 559   Result.Y := tm.tmHeight;
 560 end;
 561
 562 type
 563   TTntMessageForm = class(TTntForm)
 564   private
 565     Message: TTntLabel;
 566     procedure HelpButtonClick(Sender: TObject);
 567   protected
 568     procedure CustomKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
 569     function GetFormText: WideString;
 570   public
 571     constructor CreateNew(AOwner: TComponent); reintroduce;
 572   end;
 573
 574 constructor TTntMessageForm.CreateNew(AOwner: TComponent);
 575 var
 576   NonClientMetrics: TNonClientMetrics;
 577 begin
 578   inherited CreateNew(AOwner);
 579   NonClientMetrics.cbSize := sizeof(NonClientMetrics);
 580   if SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @NonClientMetrics, 0) then
 581     Font.Handle := CreateFontIndirect(NonClientMetrics.lfMessageFont);
 582 end;
 583
 584 procedure TTntMessageForm.HelpButtonClick(Sender: TObject);
 585 begin
 586   Application.HelpContext(HelpContext);
 587 end;
 588
 589 procedure TTntMessageForm.CustomKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
 590 begin
 591   if (Shift = [ssCtrl]) and (Key = Word('C')) then
 592   begin
 593     Beep;
 594     TntClipboard.AsWideText := GetFormText;
 595   end;
 596 end;
 597
 598 function TTntMessageForm.GetFormText: WideString;
 599 var
 600   DividerLine, ButtonCaptions: WideString;
 601   I: integer;
 602 begin
 603   DividerLine := StringOfChar('-', 27) + sLineBreak;
 604   for I := 0 to ComponentCount - 1 do
 605     if Components[I] is TTntButton then
 606       ButtonCaptions := ButtonCaptions + TTntButton(Components[I]).Caption +
 607         StringOfChar(' ', 3);
 608   ButtonCaptions := Tnt_WideStringReplace(ButtonCaptions,'&','', [rfReplaceAll]);
 609   Result := DividerLine + Caption + sLineBreak + DividerLine + Message.Caption + sLineBreak
 610           + DividerLine + ButtonCaptions + sLineBreak + DividerLine;
 611 end;
 612
 613 function GetMessageCaption(MsgType: TMsgDlgType): WideString;
 614 begin
 615   case MsgType of
 616     mtWarning:      Result := SMsgDlgWarning;
 617     mtError:        Result := SMsgDlgError;
 618     mtInformation:  Result := SMsgDlgInformation;
 619     mtConfirmation: Result := SMsgDlgConfirm;
 620     mtCustom:       Result := '';
 621     else
 622       raise ETntInternalError.Create('Unexpected MsgType in GetMessageCaption.');
 623   end;
 624 end;
 625
 626 function GetButtonCaption(MsgDlgBtn: TMsgDlgBtn): WideString;
 627 begin
 628   case MsgDlgBtn of
 629     mbYes:         Result := SMsgDlgYes;
 630     mbNo:          Result := SMsgDlgNo;
 631     mbOK:          Result := SMsgDlgOK;
 632     mbCancel:      Result := SMsgDlgCancel;
 633     mbAbort:       Result := SMsgDlgAbort;
 634     mbRetry:       Result := SMsgDlgRetry;
 635     mbIgnore:      Result := SMsgDlgIgnore;
 636     mbAll:         Result := SMsgDlgAll;
 637     mbNoToAll:     Result := SMsgDlgNoToAll;
 638     mbYesToAll:    Result := SMsgDlgYesToAll;
 639     mbHelp:        Result := SMsgDlgHelp;
 640     else
 641       raise ETntInternalError.Create('Unexpected MsgDlgBtn in GetButtonCaption.');
 642   end;
 643 end;
 644
 645 var
 646   IconIDs: array[TMsgDlgType] of PAnsiChar = (IDI_EXCLAMATION, IDI_HAND,
 647     IDI_ASTERISK, IDI_QUESTION, nil);
 648   ButtonNames: array[TMsgDlgBtn] of WideString = (
 649     'Yes', 'No', 'OK', 'Cancel', 'Abort', 'Retry', 'Ignore', 'All', 'NoToAll',
 650     'YesToAll', 'Help');
 651   ModalResults: array[TMsgDlgBtn] of Integer = (
 652     mrYes, mrNo, mrOk, mrCancel, mrAbort, mrRetry, mrIgnore, mrAll, mrNoToAll,
 653     mrYesToAll, 0);
 654
 655 function WideCreateMessageDialog(const Msg: WideString; DlgType: TMsgDlgType;
 656   Buttons: TMsgDlgButtons; DefaultButton: TMsgDlgBtn): TTntForm;
 657 const
 658   mcHorzMargin = 8;
 659   mcVertMargin = 8;
 660   mcHorzSpacing = 10;
 661   mcVertSpacing = 10;
 662   mcButtonWidth = 50;
 663   mcButtonHeight = 14;
 664   mcButtonSpacing = 4;
 665 var
 666   DialogUnits: TPoint;
 667   HorzMargin, VertMargin, HorzSpacing, VertSpacing, ButtonWidth,
 668   ButtonHeight, ButtonSpacing, ButtonCount, ButtonGroupWidth,
 669   IconTextWidth, IconTextHeight, X, ALeft: Integer;
 670   B, CancelButton: TMsgDlgBtn;
 671   IconID: PAnsiChar;
 672   ATextRect: TRect;
 673   ThisButtonWidth: integer;
 674   LButton: TTntButton;
 675 begin
 676   Result := TTntMessageForm.CreateNew(Application);
 677   with Result do
 678   begin
 679     BorderStyle := bsDialog; // By doing this first, it will work on WINE.
 680     BiDiMode := Application.BiDiMode;
 681     Canvas.Font := Font;
 682     KeyPreview := True;
 683     Position := poDesigned;
 684     OnKeyDown := TTntMessageForm(Result).CustomKeyDown;
 685     DialogUnits := GetAveCharSize(Canvas);
 686     HorzMargin := MulDiv(mcHorzMargin, DialogUnits.X, 4);
 687     VertMargin := MulDiv(mcVertMargin, DialogUnits.Y, 8);
 688     HorzSpacing := MulDiv(mcHorzSpacing, DialogUnits.X, 4);
 689     VertSpacing := MulDiv(mcVertSpacing, DialogUnits.Y, 8);
 690     ButtonWidth := MulDiv(mcButtonWidth, DialogUnits.X, 4);
 691     for B := Low(TMsgDlgBtn) to High(TMsgDlgBtn) do
 692     begin
 693       if B in Buttons then
 694       begin
 695         ATextRect := Rect(0,0,0,0);
 696         Tnt_DrawTextW(Canvas.Handle,
 697           PWideChar(GetButtonCaption(B)), -1,
 698           ATextRect, DT_CALCRECT or DT_LEFT or DT_SINGLELINE or
 699           DrawTextBiDiModeFlagsReadingOnly);
 700         with ATextRect do ThisButtonWidth := Right - Left + 8;
 701         if ThisButtonWidth > ButtonWidth then
 702           ButtonWidth := ThisButtonWidth;
 703       end;
 704     end;
 705     ButtonHeight := MulDiv(mcButtonHeight, DialogUnits.Y, 8);
 706     ButtonSpacing := MulDiv(mcButtonSpacing, DialogUnits.X, 4);
 707     SetRect(ATextRect, 0, 0, Screen.Width div 2, 0);
 708     Tnt_DrawTextW(Canvas.Handle, PWideChar(Msg), Length(Msg) + 1, ATextRect,
 709       DT_EXPANDTABS or DT_CALCRECT or DT_WORDBREAK or
 710       DrawTextBiDiModeFlagsReadingOnly);
 711     IconID := IconIDs[DlgType];
 712     IconTextWidth := ATextRect.Right;
 713     IconTextHeight := ATextRect.Bottom;
 714     if IconID <> nil then
 715     begin
 716       Inc(IconTextWidth, 32 + HorzSpacing);
 717       if IconTextHeight < 32 then IconTextHeight := 32;
 718     end;
 719     ButtonCount := 0;
 720     for B := Low(TMsgDlgBtn) to High(TMsgDlgBtn) do
 721       if B in Buttons then Inc(ButtonCount);
 722     ButtonGroupWidth := 0;
 723     if ButtonCount <> 0 then
 724       ButtonGroupWidth := ButtonWidth * ButtonCount +
 725         ButtonSpacing * (ButtonCount - 1);
 726     ClientWidth := Max(IconTextWidth, ButtonGroupWidth) + HorzMargin * 2;
 727     ClientHeight := IconTextHeight + ButtonHeight + VertSpacing +
 728       VertMargin * 2;
 729     Left := (Screen.Width div 2) - (Width div 2);
 730     Top := (Screen.Height div 2) - (Height div 2);
 731     if DlgType <> mtCustom then
 732       Caption := GetMessageCaption(DlgType)
 733     else
 734       Caption := TntApplication.Title;
 735     if IconID <> nil then
 736       with TTntImage.Create(Result) do
 737       begin
 738         Name := 'Image';
 739         Parent := Result;
 740         Picture.Icon.Handle := LoadIcon(0, IconID);
 741         SetBounds(HorzMargin, VertMargin, 32, 32);
 742       end;
 743     TTntMessageForm(Result).Message := TTntLabel.Create(Result);
 744     with TTntMessageForm(Result).Message do
 745     begin
 746       Name := 'Message';
 747       Parent := Result;
 748       WordWrap := True;
 749       Caption := Msg;
 750       BoundsRect := ATextRect;
 751       BiDiMode := Result.BiDiMode;
 752       ALeft := IconTextWidth - ATextRect.Right + HorzMargin;
 753       if UseRightToLeftAlignment then
 754         ALeft := Result.ClientWidth - ALeft - Width;
 755       SetBounds(ALeft, VertMargin,
 756         ATextRect.Right, ATextRect.Bottom);
 757     end;
 758     if mbCancel in Buttons then CancelButton := mbCancel else
 759       if mbNo in Buttons then CancelButton := mbNo else
 760         CancelButton := mbOk;
 761     X := (ClientWidth - ButtonGroupWidth) div 2;
 762     for B := Low(TMsgDlgBtn) to High(TMsgDlgBtn) do
 763       if B in Buttons then
 764       begin
 765         LButton := TTntButton.Create(Result);
 766         with LButton do
 767         begin
 768           Name := ButtonNames[B];
 769           Parent := Result;
 770           Caption := GetButtonCaption(B);
 771           ModalResult := ModalResults[B];
 772           if B = DefaultButton then
 773           begin
 774             Default := True;
 775             ActiveControl := LButton;
 776           end;
 777           if B = CancelButton then
 778             Cancel := True;
 779           SetBounds(X, IconTextHeight + VertMargin + VertSpacing,
 780             ButtonWidth, ButtonHeight);
 781           Inc(X, ButtonWidth + ButtonSpacing);
 782           if B = mbHelp then
 783             OnClick := TTntMessageForm(Result).HelpButtonClick;
 784         end;
 785       end;
 786   end;
 787 end;
 788
 789 function WideCreateMessageDialog(const Msg: WideString; DlgType: TMsgDlgType;
 790   Buttons: TMsgDlgButtons): TTntForm;
 791 var
 792   DefaultButton: TMsgDlgBtn;
 793 begin
 794   if mbOk in Buttons then DefaultButton := mbOk else
 795     if mbYes in Buttons then DefaultButton := mbYes else
 796       DefaultButton := mbRetry;
 797   Result := WideCreateMessageDialog(Msg, DlgType, Buttons, DefaultButton);
 798 end;
 799
 800 function WideMessageDlg(const Msg: WideString; DlgType: TMsgDlgType;
 801   Buttons: TMsgDlgButtons; HelpCtx: Longint; DefaultButton: TMsgDlgBtn): Integer;
 802 begin
 803   Result := WideMessageDlgPosHelp(Msg, DlgType, Buttons, HelpCtx, -1, -1, '', DefaultButton);
 804 end;
 805
 806 function WideMessageDlg(const Msg: WideString; DlgType: TMsgDlgType;
 807   Buttons: TMsgDlgButtons; HelpCtx: Longint): Integer;
 808 begin
 809   Result := WideMessageDlgPosHelp(Msg, DlgType, Buttons, HelpCtx, -1, -1, '');
 810 end;
 811
 812 function WideMessageDlgPos(const Msg: WideString; DlgType: TMsgDlgType;
 813   Buttons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer; DefaultButton: TMsgDlgBtn): Integer;
 814 begin
 815   Result := WideMessageDlgPosHelp(Msg, DlgType, Buttons, HelpCtx, X, Y, '', DefaultButton);
 816 end;
 817
 818 function WideMessageDlgPos(const Msg: WideString; DlgType: TMsgDlgType;
 819   Buttons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer): Integer;
 820 begin
 821   Result := WideMessageDlgPosHelp(Msg, DlgType, Buttons, HelpCtx, X, Y, '');
 822 end;
 823
 824 function _Internal_WideMessageDlgPosHelp(Dlg: TTntForm; HelpCtx: Longint; X, Y: Integer;
 825   const HelpFileName: WideString): Integer;
 826 begin
 827   with Dlg do
 828     try
 829       HelpContext := HelpCtx;
 830       HelpFile := HelpFileName;
 831       if X >= 0 then Left := X;
 832       if Y >= 0 then Top := Y;
 833       if (Y < 0) and (X < 0) then Position := poScreenCenter;
 834       Result := ShowModal;
 835     finally
 836       Free;
 837     end;
 838 end;
 839
 840 function WideMessageDlgPosHelp(const Msg: WideString; DlgType: TMsgDlgType;
 841   Buttons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer;
 842   const HelpFileName: WideString; DefaultButton: TMsgDlgBtn): Integer;
 843 begin
 844   Result := _Internal_WideMessageDlgPosHelp(
 845     WideCreateMessageDialog(Msg, DlgType, Buttons, DefaultButton), HelpCtx, X, Y, HelpFileName);
 846 end;
 847
 848 function WideMessageDlgPosHelp(const Msg: WideString; DlgType: TMsgDlgType;
 849   Buttons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer;
 850   const HelpFileName: WideString): Integer;
 851 begin
 852   Result := _Internal_WideMessageDlgPosHelp(
 853     WideCreateMessageDialog(Msg, DlgType, Buttons), HelpCtx, X, Y, HelpFileName);
 854 end;
 855
 856 procedure WideShowMessage(const Msg: WideString);
 857 begin
 858   WideShowMessagePos(Msg, -1, -1);
 859 end;
 860
 861 procedure WideShowMessageFmt(const Msg: WideString; Params: array of const);
 862 begin
 863   WideShowMessage(WideFormat(Msg, Params));
 864 end;
 865
 866 procedure WideShowMessagePos(const Msg: WideString; X, Y: Integer);
 867 begin
 868   WideMessageDlgPos(Msg, mtCustom, [mbOK], 0, X, Y);
 869 end;
 870
 871 { Input dialog }
 872
 873 function WideInputQuery(const ACaption, APrompt: WideString; var Value: WideString): Boolean;
 874 var
 875   Form: TTntForm;
 876   Prompt: TTntLabel;
 877   Edit: TTntEdit;
 878   DialogUnits: TPoint;
 879   ButtonTop, ButtonWidth, ButtonHeight: Integer;
 880 begin
 881   Result := False;
 882   Form := TTntForm.Create(Application);
 883   with Form do begin
 884     try
 885       BorderStyle := bsDialog; // By doing this first, it will work on WINE.
 886       Canvas.Font := Font;
 887       DialogUnits := GetAveCharSize(Canvas);
 888       Caption := ACaption;
 889       ClientWidth := MulDiv(180, DialogUnits.X, 4);
 890       Position := poScreenCenter;
 891       Prompt := TTntLabel.Create(Form);
 892       with Prompt do
 893       begin
 894         Parent := Form;
 895         Caption := APrompt;
 896         Left := MulDiv(8, DialogUnits.X, 4);
 897         Top := MulDiv(8, DialogUnits.Y, 8);
 898         Constraints.MaxWidth := MulDiv(164, DialogUnits.X, 4);
 899         WordWrap := True;
 900       end;
 901       Edit := TTntEdit.Create(Form);
 902       with Edit do
 903       begin
 904         Parent := Form;
 905         Left := Prompt.Left;
 906         Top := Prompt.Top + Prompt.Height + 5;
 907         Width := MulDiv(164, DialogUnits.X, 4);
 908         MaxLength := 255;
 909         Text := Value;
 910         SelectAll;
 911       end;
 912       ButtonTop := Edit.Top + Edit.Height + 15;
 913       ButtonWidth := MulDiv(50, DialogUnits.X, 4);
 914       ButtonHeight := MulDiv(14, DialogUnits.Y, 8);
 915       with TTntButton.Create(Form) do
 916       begin
 917         Parent := Form;
 918         Caption := SMsgDlgOK;
 919         ModalResult := mrOk;
 920         Default := True;
 921         SetBounds(MulDiv(38, DialogUnits.X, 4), ButtonTop, ButtonWidth,
 922           ButtonHeight);
 923       end;
 924       with TTntButton.Create(Form) do
 925       begin
 926         Parent := Form;
 927         Caption := SMsgDlgCancel;
 928         ModalResult := mrCancel;
 929         Cancel := True;
 930         SetBounds(MulDiv(92, DialogUnits.X, 4), Edit.Top + Edit.Height + 15, ButtonWidth,
 931           ButtonHeight);
 932         Form.ClientHeight := Top + Height + 13;
 933       end;
 934       if ShowModal = mrOk then
 935       begin
 936         Value := Edit.Text;
 937         Result := True;
 938       end;
 939     finally
 940       Form.Free;
 941     end;
 942   end;
 943 end;
 944
 945 function WideInputBox(const ACaption, APrompt, ADefault: WideString): WideString;
 946 begin
 947   Result := ADefault;
 948   WideInputQuery(ACaption, APrompt, Result);
 949 end;
 950
 951 function WidePromptForFileName(var AFileName: WideString; const AFilter: WideString = '';
 952   const ADefaultExt: WideString = ''; const ATitle: WideString = '';
 953   const AInitialDir: WideString = ''; SaveDialog: Boolean = False): Boolean;
 954 var
 955   Dialog: TTntOpenDialog;
 956 begin
 957   if SaveDialog then
 958   begin
 959     Dialog := TTntSaveDialog.Create(nil);
 960     Dialog.Options := Dialog.Options + [ofOverwritePrompt];
 961   end
 962   else
 963     Dialog := TTntOpenDialog.Create(nil);
 964   with Dialog do
 965   try
 966     Title := ATitle;
 967     DefaultExt := ADefaultExt;
 968     if AFilter = '' then
 969       Filter := SDefaultFilter else
 970       Filter := AFilter;
 971     InitialDir := AInitialDir;
 972     FileName := AFileName;
 973     Result := Execute;
 974     if Result then
 975       AFileName := FileName;
 976   finally
 977     Free;
 978   end;
 979 end;
 980
 981 end.