source: cprs/branches/tmg-cprs/TMG_Extra/tntUniCode/Source/TntDialogs.pas

Last change on this file was 672, checked in by Kevin Toppenberg, 9 years ago

Adding source to tntControls for compilation

File size: 31.2 KB
Line 
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
12unit TntDialogs;
13
14{$INCLUDE TntCompilers.inc}
15
16interface
17
18{ TODO: TFindDialog and TReplaceDialog. }
19{ TODO: Property editor for TTntOpenDialog.Filter }
20
21uses
22  Classes, Messages, CommDlg, Windows, Dialogs,
23  TntClasses, TntForms, TntSysUtils;
24
25type
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}
95function WideCreateMessageDialog(const Msg: WideString; DlgType: TMsgDlgType;
96  Buttons: TMsgDlgButtons): TTntForm;overload;
97function WideCreateMessageDialog(const Msg: WideString; DlgType: TMsgDlgType;
98  Buttons: TMsgDlgButtons; DefaultButton: TMsgDlgBtn): TTntForm; overload;
99
100{TNT-WARN MessageDlg}
101function WideMessageDlg(const Msg: WideString; DlgType: TMsgDlgType;
102  Buttons: TMsgDlgButtons; HelpCtx: Longint): Integer; overload;
103function WideMessageDlg(const Msg: WideString; DlgType: TMsgDlgType;
104  Buttons: TMsgDlgButtons; HelpCtx: Longint; DefaultButton: TMsgDlgBtn): Integer; overload;
105
106{TNT-WARN MessageDlgPos}
107function WideMessageDlgPos(const Msg: WideString; DlgType: TMsgDlgType;
108  Buttons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer): Integer; overload;
109function WideMessageDlgPos(const Msg: WideString; DlgType: TMsgDlgType;
110  Buttons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer; DefaultButton: TMsgDlgBtn): Integer; overload;
111
112{TNT-WARN MessageDlgPosHelp}
113function WideMessageDlgPosHelp(const Msg: WideString; DlgType: TMsgDlgType;
114  Buttons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer;
115  const HelpFileName: WideString): Integer; overload;
116function 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}
121procedure WideShowMessage(const Msg: WideString);
122{TNT-WARN ShowMessageFmt}
123procedure WideShowMessageFmt(const Msg: WideString; Params: array of const);
124{TNT-WARN ShowMessagePos}
125procedure WideShowMessagePos(const Msg: WideString; X, Y: Integer);
126
127{ Input dialog }
128
129{TNT-WARN InputQuery}
130function WideInputQuery(const ACaption, APrompt: WideString;
131   var Value: WideString): Boolean;
132{TNT-WARN InputBox}
133function WideInputBox(const ACaption, APrompt, ADefault: WideString): WideString;
134
135{TNT-WARN PromptForFileName}
136function WidePromptForFileName(var AFileName: WideString; const AFilter: WideString = '';
137  const ADefaultExt: WideString = ''; const ATitle: WideString = '';
138  const AInitialDir: WideString = ''; SaveDialog: Boolean = False): Boolean;
139
140function GetModalParentWnd: HWND;
141
142implementation
143
144uses
145  Controls, Forms, Types, SysUtils, Graphics, Consts, Math,
146  TntWindows, TntStdCtrls, TntClipBrd, TntExtCtrls,
147  {$IFDEF COMPILER_9_UP} WideStrUtils, {$ENDIF} TntWideStrUtils;
148
149function GetModalParentWnd: HWND;
150begin
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;
165end;
166
167var
168  ProxyExecuteDialog: TTntOpenDialog;
169
170function ProxyGetOpenFileNameA(var OpenFile: TOpenFilename): Bool; stdcall;
171begin
172  ProxyExecuteDialog.FProxiedOpenFilenameA := OpenFile;
173  Result := False; { as if user hit "Cancel". }
174end;
175
176{ TTntOpenDialog }
177
178constructor TTntOpenDialog.Create(AOwner: TComponent);
179begin
180  inherited;
181  FFiles := TTntStringList.Create;
182end;
183
184destructor TTntOpenDialog.Destroy;
185begin
186  FreeAndNil(FFiles);
187  inherited;
188end;
189
190procedure TTntOpenDialog.DefineProperties(Filer: TFiler);
191begin
192  inherited;
193  TntPersistent_AfterInherited_DefineProperties(Filer, Self);
194end;
195
196function TTntOpenDialog.GetDefaultExt: WideString;
197begin
198  Result := GetSyncedWideString(FDefaultExt, inherited DefaultExt);
199end;
200
201procedure TTntOpenDialog.SetInheritedDefaultExt(const Value: AnsiString);
202begin
203  inherited DefaultExt := Value;
204end;
205
206procedure TTntOpenDialog.SetDefaultExt(const Value: WideString);
207begin
208  SetSyncedWideString(Value, FDefaultExt, inherited DefaultExt, SetInheritedDefaultExt);
209end;
210
211function TTntOpenDialog.GetFileName: TWideFileName;
212var
213  Path: array[0..MAX_PATH] of WideChar;
214begin
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);
221end;
222
223procedure TTntOpenDialog.SetFileName(const Value: TWideFileName);
224begin
225  FFileName := Value;
226  inherited FileName := Value;
227end;
228
229function TTntOpenDialog.GetFilter: WideString;
230begin
231  Result := GetSyncedWideString(FFilter, inherited Filter);
232end;
233
234procedure TTntOpenDialog.SetInheritedFilter(const Value: AnsiString);
235begin
236  inherited Filter := Value;
237end;
238
239procedure TTntOpenDialog.SetFilter(const Value: WideString);
240begin
241  SetSyncedWideString(Value, FFilter, inherited Filter, SetInheritedFilter);
242end;
243
244function TTntOpenDialog.GetInitialDir: WideString;
245begin
246  Result := GetSyncedWideString(FInitialDir, inherited InitialDir);
247end;
248
249procedure TTntOpenDialog.SetInheritedInitialDir(const Value: AnsiString);
250begin
251  inherited InitialDir := Value;
252end;
253
254procedure 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
267begin
268  SetSyncedWideString(RemoveTrailingPathDelimiter(Value), FInitialDir,
269    inherited InitialDir, SetInheritedInitialDir);
270end;
271
272function TTntOpenDialog.GetTitle: WideString;
273begin
274  Result := GetSyncedWideString(FTitle, inherited Title)
275end;
276
277procedure TTntOpenDialog.SetInheritedTitle(const Value: AnsiString);
278begin
279  inherited Title := Value;
280end;
281
282procedure TTntOpenDialog.SetTitle(const Value: WideString);
283begin
284  SetSyncedWideString(Value, FTitle, inherited Title, SetInheritedTitle);
285end;
286
287function TTntOpenDialog.GetFiles: TTntStrings;
288begin
289  if (not Win32PlatformIsUnicode) then
290    FFiles.Assign(inherited Files);
291  Result := FFiles;
292end;
293
294function TTntOpenDialog.DoCanClose: Boolean;
295begin
296  if FAllowDoCanClose then
297    Result := inherited DoCanClose
298  else
299    Result := True;
300end;
301
302function TTntOpenDialog.CanCloseW(var OpenFileName: TOpenFileNameW): Boolean;
303begin
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;
313end;
314
315procedure TTntOpenDialog.DoIncludeItem(const OFN: TOFNotifyEx; var Include: Boolean);
316begin
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)
321end;
322
323procedure TTntOpenDialog.WndProc(var Message: TMessage);
324begin
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);
343end;
344
345function TTntOpenDialog.DoExecuteW(Func: Pointer): Bool;
346begin
347  Result := DoExecuteW(Func, GetModalParentWnd);
348end;
349
350function TTntOpenDialog.DoExecuteW(Func: Pointer; ParentWnd: HWND): Bool;
351var
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
383var
384  TempTemplate, TempFilter, TempFilename, TempExt: WideString;
385begin
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;
445end;
446
447procedure TTntOpenDialog.GetFileNamesW(var OpenFileName: TOpenFileNameW);
448var
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
483var
484  P: PWideChar;
485begin
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);
506end;
507
508function TTntOpenDialog.Execute: Boolean;
509begin
510  if (not Win32PlatformIsUnicode) then
511    Result := DoExecute(@GetOpenFileNameA)
512  else
513    Result := DoExecuteW(@GetOpenFileNameW);
514end;
515
516{$IFDEF COMPILER_9_UP}
517function TTntOpenDialog.Execute(ParentWnd: HWND): Boolean;
518begin
519  if (not Win32PlatformIsUnicode) then
520    Result := DoExecute(@GetOpenFileNameA, ParentWnd)
521  else
522    Result := DoExecuteW(@GetOpenFileNameW, ParentWnd);
523end;
524{$ENDIF}
525
526{ TTntSaveDialog }
527
528function TTntSaveDialog.Execute: Boolean;
529begin
530  if (not Win32PlatformIsUnicode) then
531    Result := DoExecute(@GetSaveFileNameA)
532  else
533    Result := DoExecuteW(@GetSaveFileNameW);
534end;
535
536{$IFDEF COMPILER_9_UP}
537function TTntSaveDialog.Execute(ParentWnd: HWND): Boolean;
538begin
539  if (not Win32PlatformIsUnicode) then
540    Result := DoExecute(@GetSaveFileNameA, ParentWnd)
541  else
542    Result := DoExecuteW(@GetSaveFileNameW, ParentWnd);
543end;
544{$ENDIF}
545
546{ Message dialog }
547
548function GetAveCharSize(Canvas: TCanvas): TPoint;
549var
550  I: Integer;
551  Buffer: array[0..51] of WideChar;
552  tm: TTextMetric;
553begin
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;
560end;
561
562type
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
574constructor TTntMessageForm.CreateNew(AOwner: TComponent);
575var
576  NonClientMetrics: TNonClientMetrics;
577begin
578  inherited CreateNew(AOwner);
579  NonClientMetrics.cbSize := sizeof(NonClientMetrics);
580  if SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @NonClientMetrics, 0) then
581    Font.Handle := CreateFontIndirect(NonClientMetrics.lfMessageFont);
582end;
583
584procedure TTntMessageForm.HelpButtonClick(Sender: TObject);
585begin
586  Application.HelpContext(HelpContext);
587end;
588
589procedure TTntMessageForm.CustomKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
590begin
591  if (Shift = [ssCtrl]) and (Key = Word('C')) then
592  begin
593    Beep;
594    TntClipboard.AsWideText := GetFormText;
595  end;
596end;
597
598function TTntMessageForm.GetFormText: WideString;
599var
600  DividerLine, ButtonCaptions: WideString;
601  I: integer;
602begin
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;
611end;
612
613function GetMessageCaption(MsgType: TMsgDlgType): WideString;
614begin
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;
624end;
625
626function GetButtonCaption(MsgDlgBtn: TMsgDlgBtn): WideString;
627begin
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;
643end;
644
645var
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
655function WideCreateMessageDialog(const Msg: WideString; DlgType: TMsgDlgType;
656  Buttons: TMsgDlgButtons; DefaultButton: TMsgDlgBtn): TTntForm;
657const
658  mcHorzMargin = 8;
659  mcVertMargin = 8;
660  mcHorzSpacing = 10;
661  mcVertSpacing = 10;
662  mcButtonWidth = 50;
663  mcButtonHeight = 14;
664  mcButtonSpacing = 4;
665var
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;
675begin
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;
787end;
788
789function WideCreateMessageDialog(const Msg: WideString; DlgType: TMsgDlgType;
790  Buttons: TMsgDlgButtons): TTntForm;
791var
792  DefaultButton: TMsgDlgBtn;
793begin
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);
798end;
799
800function WideMessageDlg(const Msg: WideString; DlgType: TMsgDlgType;
801  Buttons: TMsgDlgButtons; HelpCtx: Longint; DefaultButton: TMsgDlgBtn): Integer;
802begin
803  Result := WideMessageDlgPosHelp(Msg, DlgType, Buttons, HelpCtx, -1, -1, '', DefaultButton);
804end;
805
806function WideMessageDlg(const Msg: WideString; DlgType: TMsgDlgType;
807  Buttons: TMsgDlgButtons; HelpCtx: Longint): Integer;
808begin
809  Result := WideMessageDlgPosHelp(Msg, DlgType, Buttons, HelpCtx, -1, -1, '');
810end;
811
812function WideMessageDlgPos(const Msg: WideString; DlgType: TMsgDlgType;
813  Buttons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer; DefaultButton: TMsgDlgBtn): Integer;
814begin
815  Result := WideMessageDlgPosHelp(Msg, DlgType, Buttons, HelpCtx, X, Y, '', DefaultButton);
816end;
817
818function WideMessageDlgPos(const Msg: WideString; DlgType: TMsgDlgType;
819  Buttons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer): Integer;
820begin
821  Result := WideMessageDlgPosHelp(Msg, DlgType, Buttons, HelpCtx, X, Y, '');
822end;
823
824function _Internal_WideMessageDlgPosHelp(Dlg: TTntForm; HelpCtx: Longint; X, Y: Integer;
825  const HelpFileName: WideString): Integer;
826begin
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;
838end;
839
840function WideMessageDlgPosHelp(const Msg: WideString; DlgType: TMsgDlgType;
841  Buttons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer;
842  const HelpFileName: WideString; DefaultButton: TMsgDlgBtn): Integer;
843begin
844  Result := _Internal_WideMessageDlgPosHelp(
845    WideCreateMessageDialog(Msg, DlgType, Buttons, DefaultButton), HelpCtx, X, Y, HelpFileName);
846end;
847
848function WideMessageDlgPosHelp(const Msg: WideString; DlgType: TMsgDlgType;
849  Buttons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer;
850  const HelpFileName: WideString): Integer;
851begin
852  Result := _Internal_WideMessageDlgPosHelp(
853    WideCreateMessageDialog(Msg, DlgType, Buttons), HelpCtx, X, Y, HelpFileName);
854end;
855
856procedure WideShowMessage(const Msg: WideString);
857begin
858  WideShowMessagePos(Msg, -1, -1);
859end;
860
861procedure WideShowMessageFmt(const Msg: WideString; Params: array of const);
862begin
863  WideShowMessage(WideFormat(Msg, Params));
864end;
865
866procedure WideShowMessagePos(const Msg: WideString; X, Y: Integer);
867begin
868  WideMessageDlgPos(Msg, mtCustom, [mbOK], 0, X, Y);
869end;
870
871{ Input dialog }
872
873function WideInputQuery(const ACaption, APrompt: WideString; var Value: WideString): Boolean;
874var
875  Form: TTntForm;
876  Prompt: TTntLabel;
877  Edit: TTntEdit;
878  DialogUnits: TPoint;
879  ButtonTop, ButtonWidth, ButtonHeight: Integer;
880begin
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;
943end;
944
945function WideInputBox(const ACaption, APrompt, ADefault: WideString): WideString;
946begin
947  Result := ADefault;
948  WideInputQuery(ACaption, APrompt, Result);
949end;
950
951function WidePromptForFileName(var AFileName: WideString; const AFilter: WideString = '';
952  const ADefaultExt: WideString = ''; const ATitle: WideString = '';
953  const AInitialDir: WideString = ''; SaveDialog: Boolean = False): Boolean;
954var
955  Dialog: TTntOpenDialog;
956begin
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;
979end;
980
981end.
Note: See TracBrowser for help on using the repository browser.