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

Last change on this file since 1103 was 672, checked in by Kevin Toppenberg, 15 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.