1 {
2 /***************************************************************************
3 LCLTaskDialog.pas
4 -----------------
5
6 Implement TaskDialog window (native on Vista/Seven, emulated on XP).
7 This unit was originally a part of the freeware Synopse mORMot framework,
8 licensed under a MPL/GPL/LGPL tri-license; version 1.19.
9 It has been relicensed with permission from Arnaud Bouchez, the original
10 author, and all contributors.
11
12 The original name is SynTaskDialog.pas
13
14 ***************************************************************************/
15
16 *****************************************************************************
17 This file is part of the Lazarus Component Library (LCL)
18
19 See the file COPYING.modifiedLGPL.txt, included in this distribution,
20 for details about the license.
21 *****************************************************************************
22 }
23
24
25 unit LCLTaskDialog;
26
27 {
28 This file is part of Synopse framework.
29
30 Synopse framework. Copyright (C) 2016 Arnaud Bouchez
31 Synopse Informatique - http://synopse.info
32
33 *** BEGIN LICENSE BLOCK *****
34 Version: MPL 1.1/GPL 2.0/LGPL 2.1
35
36 The contents of this file are subject to the Mozilla Public License Version
37 1.1 (the "License"); you may not use this file except in compliance with
38 the License. You may obtain a copy of the License at
39 http://www.mozilla.org/MPL
40
41 Software distributed under the License is distributed on an "AS IS" basis,
42 WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
43 for the specific language governing rights and limitations under the License.
44
45 The Original Code is Synopse framework.
46
47 The Initial Developer of the Original Code is Arnaud Bouchez.
48
49 Portions created by the Initial Developer are Copyright (C) 2016
50 the Initial Developer. All Rights Reserved.
51
52 Contributor(s):
53 - Ulrich Gerhardt
54 - Ondrej Pokorny (reddwarf)
55
56 Alternatively, the contents of this file may be used under the terms of
57 either the GNU General Public License Version 2 or later (the "GPL"), or
58 the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
59 in which case the provisions of the GPL or the LGPL are applicable instead
60 of those above. If you wish to allow use of your version of this file only
61 under the terms of either the GPL or the LGPL, and not to allow others to
62 use your version of this file under the terms of the MPL, indicate your
63 decision by deleting the provisions above and replace them with the notice
64 and other provisions required by the GPL or the LGPL. If you do not delete
65 the provisions above, a recipient may use your version of this file under
66 the terms of any one of the MPL, the GPL or the LGPL.
67
68 ***** END LICENSE BLOCK *****
69
70 Version 1.13
71 - initial release
72
73 Version 1.15
74 - new tdfQueryMasked function to display * in the tdfQuery editor field
75
76 Version 1.16
77 - fixed issue when changing the current application with Alt+Tab - see
78 http://synopse.info/fossil/tktview?name=01395e5932
79 - fixed compiler error when using the unit with runtime packages enabled
80 (known compiler issue about string resources, referenced as E2201)
81 - default modal dialog parent changed into any current active form
82 - added tdfQueryFieldFocused optional flag to focus the input field component
83 - some aesthetical rendering changes and code clean-up (e.g. no temporary
84 form necessary), thanks to uligerhardt proposals
85
86 Version 1.18
87 - fixed label height display when long text is wrapped on several lines
88 - bottom buttons use better looking TButton component
89 - bottom buttons won't trim expected shortcut definition, in emulated mode
90 - added OnButtonClicked property and associated SetElementText() method
91 - now compiles and run in Win64 platform (Delphi XE2+)
92
93 Version 1.19 (Ondrej Pokorny)
94 - added Lazarus support (native on Windows Vista+, emulated on all other
95 platforms - Windows, Linux and OSX tested)
96 - added external translation function for the emulated dialog
97 (TaskDialog_Translate)
98 - tdfAllowDialogCancellation handled in emulated dialog:
99 - if not set: Alt+F4 is blocked
100 - if set: Esc is allowed
101 - tdfPositionRelativeToWindow handled in emulated dialog
102 - platform-independent icons are from www.iconsdb.com:
103 Icon license:
104 This icon is provided as CC0 1.0 Universal (CC0 1.0) Public Domain
105 Dedication.
106 You can copy, modify, use, distribute this icon, even for commercial
107 purposes, all without asking permission with no attribution required,
108 but always appreciated.
109 - Maybe To-Do: High DPI-aware emulated dialog + icons
110 - Just a remark: native dialogs don't work in non-unicode applications
111 (Delphi 7 etc.) because the TaskDialogIndirect is not available for
112 non-unicode applications (Windows limitation)
113 http://msgroups.net/microsoft.public.vc.mfc/getprocaddress-ansi-unicode/571937
114
115 Version 1.20 (Ondrej Pokorny)
116 - include this unit as LCLTaskDialog.pas into the LCL
117 - remove Delphi specific code
118 - remove CC0 icons, use LCL icons instead
119
120 (The version information shouldn't be continued.)
121
122 }
123
124 interface
125
126 {$MODE DELPHI}
127
128 uses
129 LCLType, LCLStrConsts, LCLIntf,
130 {$IFDEF MSWINDOWS}
131 Windows, CommCtrl, Messages,
132 {$ENDIF}
133 LResources, Classes, SysUtils,
134 Menus, Graphics, Forms, Controls, StdCtrls, ExtCtrls, Buttons;
135
136 {$IFDEF MSWINDOWS}
137 var
138 /// is filled once in the initialization block below
139 // - you can set this reference to nil to force Delphi dialogs even
140 // on Vista/Seven (e.g. make sense if TaskDialogBiggerButtons=true)
Confignull141 TaskDialogIndirect: function(AConfig: pointer; Res: PInteger;
142 ResRadio: PInteger; VerifyFlag: PBOOL): HRESULT; stdcall;
143 {$ENDIF}
144 type
145 /// the standard kind of common buttons handled by the Task Dialog
146 TCommonButton = (
147 cbOK, cbYes, cbNo, cbCancel, cbRetry, cbClose);
148
149 /// set of standard kind of common buttons handled by the Task Dialog
150 TCommonButtons = set of TCommonButton;
151
152 /// the available main icons for the Task Dialog
153 TTaskDialogIcon = (
154 tiBlank, tiWarning, tiQuestion, tiError, tiInformation, tiNotUsed, tiShield);
155
156 /// the available footer icons for the Task Dialog
157 TTaskDialogFooterIcon = (
158 tfiBlank, tfiWarning, tfiQuestion, tfiError, tfiInformation, tfiShield);
159
160 /// the available configuration flags for the Task Dialog
161 // - most are standard TDF_* flags used for Vista/Seven native API
162 // (see http://msdn.microsoft.com/en-us/library/bb787473(v=vs.85).aspx
163 // for TASKDIALOG_FLAGS)
164 // - tdfQuery and tdfQueryMasked are custom flags, implemented in pure Delphi
165 // code to handle input query
166 // - our emulation code will handle only tdfUseCommandLinks,
167 // tdfUseCommandLinksNoIcon, and tdfQuery options
168 TTaskDialogFlag = (
169 tdfEnableHyperLinks, tdfUseHIconMain, tdfUseHIconFooter,
170 tdfAllowDialogCancellation, tdfUseCommandLinks, tdfUseCommandLinksNoIcon,
171 tdfExpandFooterArea, tdfExpandByDefault, tdfVerificationFlagChecked,
172 tdfShowProgressBar, tdfShowMarqueeProgressBar, tdfCallbackTimer,
173 tdfPositionRelativeToWindow, tdfRtlLayout, tdfNoDefaultRadioButton,
174 tdfCanBeMinimized, tdfQuery, tdfQueryMasked, tdfQueryFieldFocused);
175
176 /// set of available configuration flags for the Task Dialog
177 TTaskDialogFlags = set of TTaskDialogFlag;
178
179 PTaskDialog = ^TTaskDialog;
180
181 /// this callback will be triggerred when a task dialog button is clicked
182 // - to prevent the task dialog from closing, the application must set
183 // ACanClose to FALSE, otherwise the task dialog is closed and the button
184 // ID is returned via the original TTaskDialog.Execute() result
185 TTaskDialogButtonClickedEvent = procedure(Sender: PTaskDialog;
186 AButtonID: integer; var ACanClose: Boolean) of object;
187
188 /// the visual components of this Task Dialog
189 // - map low-level TDE_CONTENT...TDE_MAIN_INSTRUCTION constants and
190 // the query editor and checkbox
191 // - tdeEdit is for the query editor
192 // - tdeVerif is for the checkbox
193 TTaskDialogElement = (
194 tdeContent, tdeExpandedInfo, tdeFooter, tdeMainInstruction,
195 tdeEdit, tdeVerif);
196
197 /// the actual form class used for emulation
198 TEmulatedTaskDialog = class(TForm)
199 protected
200 procedure HandleEmulatedButtonClicked(Sender: TObject);
201 public
202 procedure KeyDown(var Key: Word; Shift: TShiftState); override;
203
204 constructor CreateNew(AOwner: TComponent; Num: Integer = 0); override;
205 public
206 /// the Task Dialog structure which created the form
207 Owner: PTaskDialog;
208 /// the labels corresponding to the Task Dialog main elements
209 Element: array[tdeContent..tdeMainInstruction] of TLabel;
210 /// the Task Dialog selection list
211 Combo: TComboBox;
212 /// the Task Dialog optional query editor
213 Edit: TEdit;
214 /// the Task Dialog optional checkbox
215 Verif: TCheckBox;
216 end;
217
218 /// structure for low-level access to the task dialog implementation
219 // - points either to the HWND handle of the new TaskDialog API
220 // or to the emulation dialog
221 TTaskDialogImplementation = record
222 OnButtonClicked: TTaskDialogButtonClickedEvent;
223 case Emulated: Boolean of
224 False: (Wnd: HWND);
225 True: (Form: TEmulatedTaskDialog);
226 end;
227
228 /// implements a TaskDialog
229 // - will use the new TaskDialog API under Vista/Seven, and emulate it with
230 // pure Delphi code and standard themed VCL components under XP or 2K
231 // - create a TTaskDialog object/record on the stack will initialize all
232 // its string parameters to '' (it's a SHAME that since Delphi 2009, objects
233 // are not initialized any more: we have to define this type as object before
234 // Delphi 2009, and as record starting with Delphi 2009)
235 // - set the appropriate string parameters, then call Execute() with all
236 // additional parameters
237 // - RadioRes/SelectionRes/VerifyChecked will be used to reflect the state
238 // after dialog execution
239 // - here is a typical usage:
240 // !var Task: TTaskDialog;
241 // !begin
242 // ! Task.Inst := 'Saving application settings';
243 // ! Task.Content := 'This is the content';
244 // ! Task.Radios := 'Store settings in registry'#10'Store settings in XML file';
245 // ! Task.Verify := 'Do no ask for this setting next time';
246 // ! Task.VerifyChecked := true;
247 // ! Task.Footer := 'XML file is perhaps a better choice';
248 // ! Task.Execute([],0,[],tiQuestion,tfiInformation,200);
249 // ! ShowMessage(IntToStr(Task.RadioRes)); // 200=Registry, 201=XML
250 // ! if Task.VerifyChecked then
251 // ! ShowMessage(Task.Verify);
252 // !end;
253 TTaskDialog = record
254 /// the main title of the dialog window
255 // - if left void, the title of the application main form is used
256 Title: string;
257 /// the main instruction (first line on top of window)
258 // - any '\n' will be converted into a line feed
259 // - if left void, the text is taken from the current dialog icon kind
260 Inst: string;
261 /// the dialog's primary content content text
262 // - any '\n' will be converted into a line feed
263 Content: string;
264 /// a #13#10 or #10 separated list of custom buttons
265 // - they will be identified with an ID number starting at 100
266 // - by default, the buttons will be created at the dialog bottom, just
267 // like the common buttons
268 // - if tdfUseCommandLinks flag is set, the custom buttons will be created
269 // as big button in the middle of the dialog window; in this case, any
270 // '\n' will be converted as note text (shown with smaller text under native
271 // Vista/Seven TaskDialog, or as popup hint within Delphi emulation)
272 Buttons: string;
273 /// a #13#10 or #10 separated list of custom radio buttons
274 // - they will be identified with an ID number starting at 200
275 // - aRadioDef parameter can be set to define the default selected value
276 // - '\n' will be converted as note text (shown with smaller text under
277 // native Vista/Seven TaskDialog, or as popup hint within Delphi emulation)
278 Radios: string;
279 /// the expanded information content text
280 // - any '\n' will be converted into a line feed
281 // - the Delphi emulation will always show the Info content (there is no
282 // collapse/expand button)
283 Info: string;
284 /// the button caption to be displayed when the information is collapsed
285 // - not used under XP: the Delphi emulation will always show the Info content
286 InfoExpanded: string;
287 /// the button caption to be displayed when the information is expanded
288 // - not used under XP: the Delphi emulation will always show the Info content
289 InfoCollapse: string;
290 /// the footer content text
291 // - any '\n' will be converted into a line feed
292 Footer: string;
293 /// the text of the bottom most optional checkbox
294 Verify: string;
295 /// a #13#10 or #10 separated list of items to be selected
296 // - if set, a Combo Box will be displayed to select
297 // - if tdfQuery is in the flags, the combo box will be in edition mode,
298 // and the user will be able to edit the Query text or fill the field
299 // with one item of the selection
300 // - this selection is not handled via the Vista/Seven TaskDialog, but
301 // with our Delphi emulation code (via a TComboBox)
302 Selection: string;
303 /// some text to be edited
304 // - if tdfQuery is in the flags, will contain the default query text
305 // - if Selection is set, the
306 Query: string;
307 /// the selected radio item
308 // - first is numeroted 0
309 RadioRes: integer;
310 /// after execution, contains the selected item from the Selection list
311 SelectionRes: integer;
312 /// reflect the the bottom most optional checkbox state
313 // - if Verify is not '', should be set before execution
314 // - after execution, will contain the final checkbox state
315 VerifyChecked: Boolean;
316 /// low-level access to the task dialog implementation
317 Dialog: TTaskDialogImplementation;
318
319 /// launch the TaskDialog form
320 // - some common buttons can be set via aCommonButtons
321 // - in emulation mode, aFlags will handle only tdfUseCommandLinks,
322 // tdfUseCommandLinksNoIcon, and tdfQuery options
323 // - will return 0 on error, or the Button ID (e.g. mrOk for the OK button
324 // or 100 for the first custom button defined in Buttons string)
325 // - if Buttons was defined, aButtonDef can set the selected Button ID
326 // - if Radios was defined, aRadioDef can set the selected Radio ID
327 // - aDialogIcon and aFooterIcon are used to specify the displayed icons
328 // - aWidth can be used to force a custom form width (in pixels)
329 // - aParent can be set to any HWND - by default, Application.DialogHandle
330 // - if aNonNative is TRUE, the Delphi emulation code will always be used
331 // - aEmulateClassicStyle can be set to enforce conformity with the non themed
332 // user interface - see @http://synopse.info/forum/viewtopic.php?pid=2867#p2867
333 // - aOnButtonClicked can be set to a callback triggerred when a button is
334 // clicked
Executenull335 function Execute(aCommonButtons: TCommonButtons=[];
336 aButtonDef: integer=0; aFlags: TTaskDialogFlags=[];
337 aDialogIcon: TTaskDialogIcon=tiInformation;
338 {%H-}aFooterIcon: TTaskDialogFooterIcon=tfiWarning;
339 aRadioDef: integer=0; aWidth: integer=0; aParent: HWND=0;
340 {%H-}aNonNative: boolean=false; aEmulateClassicStyle: boolean = false;
341 aOnButtonClicked: TTaskDialogButtonClickedEvent=nil): integer;
342
343 /// allow a OnButtonClicked callback to change the Task Dialog main elements
344 // - note that tdeVerif could be modified only in emulation mode, since
345 // the API does not give any runtime access to the checkbox caption
346 // - other elements will work in both emulated and native modes
347 procedure SetElementText(element: TTaskDialogElement; const Text: string);
348 end;
349
350 /// a wrapper around the TTaskDialog.Execute method
351 // - used to provide a "flat" access to task dialog parameters
352 TTaskDialogEx = record
353 /// the associated main TTaskDialog instance
354 Base: TTaskDialog;
355 /// some common buttons to be displayed
356 CommonButtons: TCommonButtons;
357 /// the default button ID
358 ButtonDef: integer;
359 /// the associated configuration flags for this Task Dialog
360 // - in emulation mode, aFlags will handle only tdfUseCommandLinks,
361 // tdfUseCommandLinksNoIcon, and tdfQuery options
362 Flags: TTaskDialogFlags;
363 /// used to specify the dialog icon
364 DialogIcon: TTaskDialogIcon;
365 /// used to specify the footer icon
366 FooterIcon: TTaskDialogFooterIcon;
367 /// the default radio button ID
368 RadioDef: integer;
369 /// can be used to force a custom form width (in pixels)
370 Width: integer;
371 /// if TRUE, the Delphi emulation code will always be used
372 NonNative: boolean;
373 /// can be used to enforce conformity with the non themed user interface
374 EmulateClassicStyle: boolean;
375 /// this event handler will be fired on a button dialog click
376 OnButtonClicked: TTaskDialogButtonClickedEvent;
377 /// will initialize the dialog parameters
378 // - can be used to display some information with less parameters:
379 // !var TaskEx: TTaskDialogEx;
380 // ! ...
381 // ! TaskEx.Init;
382 // ! TaskEx.Base.Title := 'Task Dialog Test';
383 // ! TaskEx.Base.Inst := 'Callback Test';
384 // ! TaskEx.Execute;
385 procedure Init;
386 /// main (and unique) method showing the dialog itself
387 // - is in fact a wrapper around the TTaskDialog.Execute method
Executenull388 function Execute(aParent: HWND=0): integer;
389 end;
390
391 /// return the text without the '&' characters within
UnAmpnull392 function UnAmp(const s: string): string;
393
394 var
395 /// a default Task Dialog wrapper instance
396 // - can be used to display some information with less parameters, just
397 // like the TTaskDialogEx.Init method:
398 // !var TaskEx: TTaskDialogEx;
399 // ! ...
400 // ! TaskEx := DefaultTaskDialog;
401 // ! TaskEx.Base.Title := 'Task Dialog Test';
402 // ! TaskEx.Base.Inst := 'Callback Test';
403 // ! TaskEx.Execute;
404 DefaultTaskDialog: TTaskDialogEx = (
405 DialogIcon: {%H-}tiInformation;
406 FooterIcon: tfiWarning{%H-});
407
fornull408 //function for translating the captions
409 type
410 TTaskDialogTranslate = function(const aString: string): string;
411 var
412 TaskDialog_Translate: TTaskDialogTranslate;
413
414 /// will map a default font, according to the available
415 // - if Calibri is installed, will use it
416 // - will fall back to Tahoma otherwise
DefaultFontnull417 function DefaultFont: TFont;
418
419 implementation
420
421 var
422 LDefaultFont: TFont;
423
DefaultFontnull424 function DefaultFont: TFont;
425 begin
426 if LDefaultFont<>nil then
427 Exit(LDefaultFont);
428 LDefaultFont := TFont.Create;
429 LDefaultFont.Name := 'default';
430 LDefaultFont.Style := [];
431 LDefaultFont.Size := 10;
432 Result := LDefaultFont;
433
434 {$IFDEF WINDOWS}
435 if Screen.Fonts.IndexOf('Calibri')>=0 then begin
436 LDefaultFont.Size := 11;
437 LDefaultFont.Name := 'Calibri';
438 end else begin
439 if Screen.Fonts.IndexOf('Tahoma')>=0 then
440 LDefaultFont.Name := 'Tahoma'
441 else
442 LDefaultFont.Name := 'Arial';
443 end;
444 {$ENDIF}
445 end;
446
447 const
448 TD_BTNMOD: array[TCommonButton] of Integer = (
449 mrOk, mrYes, mrNo, mrCancel, mrRetry, mrClose);
450
TD_BTNSnull451 function TD_BTNS(button: TCommonButton): pointer;
452 begin
453 case button of
454 cbOK: result := @rsMbOK;
455 cbYes: result := @rsMbYes;
456 cbNo: result := @rsMbNo;
457 cbCancel: result := @rsMbCancel;
458 cbRetry: result := @rsMbRetry;
459 cbClose: result := @rsMbClose;
460 else result := nil;
461 end;
462 end;
463
TD_Transnull464 function TD_Trans(const aString: string): string;
465 begin
466 if Assigned(TaskDialog_Translate) then
467 Result := TaskDialog_Translate(aString)
468 else
469 Result := aString;
470 end;
471
UnAmpnull472 function UnAmp(const s: string): string;
StripHotkeynull473 function StripHotkey(const Text: string): string;
474 var
475 I: Integer;
476 begin
477 Result := Text;
478 I := 1;
479 while I <= Length(Result) do
480 begin
481 if Result[I] = cHotkeyPrefix then
482 if SysLocale.FarEast and
483 ((I > 1) and (Length(Result)-I >= 2) and
484 (Result[I-1] = '(') and (Result[I+2] = ')')) then
485 Delete(Result, I-1, 4)
486 else
487 Delete(Result, I, 1);
488 Inc(I);
489 end;
490 end;
491 begin
492 Result := StripHotkey(s);
493 end;
494
495
496 const
497 LAZ_ICONS: array[TTaskDialogIcon] of string = (
498 '', 'dialog_warning', 'dialog_confirmation', 'dialog_error', 'dialog_information', '', 'dialog_shield');
499 LAZ_FOOTERICONS: array[TTaskDialogFooterIcon] of string = (
500 '', 'dialog_warning', 'dialog_confirmation', 'dialog_error', 'dialog_information', 'dialog_shield');
501 {$IFDEF MSWINDOWS}
502 const
503 {$EXTERNALSYM IDI_HAND}
504 IDI_HAND = MakeIntResource(32513);
505 {$EXTERNALSYM IDI_QUESTION}
506 IDI_QUESTION = MakeIntResource(32514);
507 {$EXTERNALSYM IDI_EXCLAMATION}
508 IDI_EXCLAMATION = MakeIntResource(32515);
509 {$EXTERNALSYM IDI_ASTERISK}
510 IDI_ASTERISK = MakeIntResource(32516);
511 {$EXTERNALSYM IDI_WINLOGO}
512 IDI_WINLOGO = MakeIntResource(32517);
513 {$EXTERNALSYM IDI_WARNING}
514 IDI_WARNING = IDI_EXCLAMATION;
515 {$EXTERNALSYM IDI_ERROR}
516 IDI_ERROR = IDI_HAND;
517 {$EXTERNALSYM IDI_INFORMATION}
518 IDI_INFORMATION = IDI_ASTERISK;
519
520 TD_ICONS: array[TTaskDialogIcon] of integer = (
521 17, 84, 99, 98, 81, 0, 78);
522 TD_FOOTERICONS: array[TTaskDialogFooterIcon] of integer = (
523 17, 84, 99, 98, 65533, 65532);
524 WIN_ICONS: array[TTaskDialogIcon] of PChar = (
525 nil, IDI_WARNING, IDI_QUESTION, IDI_ERROR, IDI_INFORMATION, nil, nil);
526 WIN_FOOTERICONS: array[TTaskDialogFooterIcon] of PChar = (
527 nil, IDI_WARNING, IDI_QUESTION, IDI_ERROR, IDI_INFORMATION, nil);
528 {$ENDIF MSWINDOWS}
529
IconMessagenull530 function IconMessage(Icon: TTaskDialogIcon): string;
531 begin
532 case Icon of
533 tiWarning: result := rsMtWarning;
534 tiQuestion: result := rsMtConfirmation;
535 tiError: result := rsMtError;
536 tiInformation, tiShield: result := rsMtInformation;
537 else result := '';
538 end;
539 result := TD_Trans(result);
540 end;
541
542 {$IFDEF MSWINDOWS}
543 procedure InitComCtl6;
544 var OSVersionInfo: TOSVersionInfo;
545 begin
546 OSVersionInfo.dwOSVersionInfoSize := sizeof(OSVersionInfo);
547 GetVersionEx(OSVersionInfo);
548 if OSVersionInfo.dwMajorVersion<6 then
549 @TaskDialogIndirect := nil else
550 @TaskDialogIndirect := GetProcAddress(GetModuleHandle(comctl32),'TaskDialogIndirect');
551 end;
552 {$ENDIF}
553
554 type
555 /// internal type used for Unicode string storage
556 WS = WideString;
557
_WSnull558 function _WS(const aString: string): WS;
559 begin
560 Result := UTF8Decode(aString);
561 end;
562
CRnull563 function CR(const aText: string): string;
564 begin
565 if pos('\n', aText) = 0 then
566 result := aText else
567 result := StringReplace(aText, '\n', #10, [rfReplaceAll]);
568 end;
569
570
571 { TTaskDialog }
572
573 {$IFDEF MSWINDOWS}
574 type
575 // see http://msdn.microsoft.com/en-us/library/bb787473
576 PTASKDIALOG_BUTTON = ^TTASKDIALOG_BUTTON;
577 TTASKDIALOG_BUTTON = packed record
578 nButtonID: integer;
579 pszButtonText: PWideChar;
580 end;
581
582 TTASKDIALOGCONFIG = packed record
583 cbSize: integer;
584 hwndParent: HWND;
585 hInstance: THandle;
586 dwFlags: cardinal;
587 dwCommonButtons: cardinal;
588 pszWindowTitle: PWideChar;
589 hMainIcon: HICON;
590 pszMainInstruction: PWideChar;
591 pszContent: PWideChar;
592 cButtons: integer;
593 pButtons: PTASKDIALOG_BUTTON;
594 nDefaultButton: integer;
595 cRadioButtons: integer;
596 pRadioButtons: PTASKDIALOG_BUTTON;
597 nDefaultRadioButton: integer;
598 pszVerificationText: PWideChar;
599 pszExpandedInformation: PWideChar;
600 pszExpandedControlText: PWideChar;
601 pszCollapsedControlText: PWideChar;
602 hFooterIcon: HICON;
603 pszFooter: PWideChar;
604 pfCallback: pointer;
605 lpCallbackData: pointer;
606 cxWidth: integer;
607 end;
608
609 const
610 TDN_BUTTON_CLICKED = 2; // wParam = Button ID
611
612
TaskDialogCallbackProcnull613 function TaskDialogCallbackProc(hwnd: HWND; uNotification: UINT;
614 wParam: WPARAM; {%H-}lParam: LPARAM; dwRefData: pointer): HRESULT; stdcall;
615 var ptd: PTaskDialog absolute dwRefData;
616 CanClose: Boolean;
617 begin
618 ptd^.Dialog.Wnd := hwnd;
619 Result := S_OK;
620 case uNotification of
621 TDN_BUTTON_CLICKED:
622 if Assigned(ptd^.Dialog.OnButtonClicked) then begin
623 CanClose := True;
624 ptd^.Dialog.OnButtonClicked(ptd,wParam,CanClose);
625 if not CanClose then
626 Result := S_FALSE;
627 end;
628 end;
629 end;
630 {$ENDIF}
631
TTaskDialog.Executenull632 function TTaskDialog.Execute(aCommonButtons: TCommonButtons;
633 aButtonDef: integer; aFlags: TTaskDialogFlags;
634 aDialogIcon: TTaskDialogIcon; aFooterIcon: TTaskDialogFooterIcon;
635 aRadioDef, aWidth: integer; aParent: HWND; aNonNative: boolean;
636 aEmulateClassicStyle: boolean; aOnButtonClicked: TTaskDialogButtonClickedEvent): integer;
GetNextStringLineToWSnull637 function GetNextStringLineToWS(var P: PChar): WS;
638 var S: PChar;
639 tmp: string;
640 begin
641 if P=nil then
642 result := '' else begin
643 S := P;
644 while S[0]>=' ' do
645 inc(S);
646 SetString(tmp,P,S-P);
647 result := _WS(CR(tmp));
648 while (S^<>#0) and (S^<' ') do inc(S); // ignore e.g. #13 or #10
649 if S^<>#0 then
650 P := S else
651 P := nil;
652 end;
653 end;
654 var aHint: string;
NoCRnull655 function NoCR(const aText: string): string;
656 var i: integer;
657 begin
658 result := aText;
659 aHint := '';
660 i := pos('\n',result);
661 if i>0 then begin
662 aHint := CR(copy(result,i+2,maxInt));
663 SetLength(result,i-1);
664 end;
665 end;
Nnull666 function N(const aText: string): WS;
667 begin
668 if aText='' then
669 result := '' else
670 result := _WS(CR(aText));
671 end;
672 {$IFDEF MSWINDOWS}
673 var RU: array of Ws;
674 RUCount: integer;
675 But: array of TTASKDIALOG_BUTTON;
676 procedure AddRU(Text: string; var n: integer; firstID: integer);
677 var P: PChar;
678 begin
679 if Text='' then
680 exit;
681 Text := SysUtils.trim(Text);
682 P := @Text[1]; // '\n' handling in GetNextStringLineToWS(P) will change P^
683 while P<>nil do begin
684 if length(RU)<=RUCount then begin
685 SetLength(RU,RUCount+16);
686 SetLength(But,RUCount+16);
687 end;
688 RU[RUCount] := GetNextStringLineToWS(P);
689 with But[RUCount] do begin
690 nButtonID := n+firstID;
691 pszButtonText := PWideChar(RU[RUCount]);
692 end;
693 inc(n);
694 inc(RUCount);
695 end;
696 end;
697 {$ENDIF}
698 var
699 {$IFDEF MSWINDOWS}
700 Config: TTASKDIALOGCONFIG;
701 {$ENDIF}
702 Pic: TPortableNetworkGraphic;
703 Ico: TIcon;
704 Bmp: TBitmap;
705 i, X, Y, XB, IconBorder, FontHeight: integer;
706 Par: TWinControl;
707 Panel: TPanel;
708 CurrTabOrder: TTabOrder;
709 Image: TImage;
710 List: TStrings;
711 B: TCommonButton;
712 CommandLink: TBitBtn;
713 Rad: array of TRadioButton;
AddLabelnull714 function AddLabel(Text: string; BigFont: boolean): TLabel;
715 var R: TRect;
716 W: integer;
717 begin
718 result := TLabel.Create(Dialog.Form);
719 result.Parent := Par;
720 result.WordWrap := true;
721 if BigFont then begin
722 if aEmulateClassicStyle then begin
723 result.Font.Height := FontHeight-2;
724 result.Font.Style := [fsBold]
725 end else begin
726 result.Font.Height := FontHeight-4;
727 result.Font.Color := $B00000;
728 end;
729 end else
730 result.Font.Height := FontHeight;
731 Text := CR(Text);
732 result.AutoSize := false;
733 R.Left := 0;
734 R.Top := 0;
735 W := aWidth-X-8;
736 R.Right := W;
737 R.Bottom := result.Height;
738 DrawText(result.Canvas.Handle,PChar(Text),Length(Text),R,DT_CALCRECT or DT_WORDBREAK);//lazarus does not return box height on OSX (Lazarus bug), the height is stored in the rect in all cases, so we don't need to use the result
739
740 result.SetBounds(X,Y,W,R.Bottom);
741 result.Caption := Text;
742 inc(Y,R.Bottom+16);
743 end;
744 procedure AddBevel;
745 var BX: integer;
746 begin
747 with TBevel.Create(Dialog.Form) do begin
748 Parent := Par;
749 if (Image<>nil) and (Y<Image.Top+Image.Height) then
750 BX := X else
751 BX := 2;
752 SetBounds(BX,Y,aWidth-BX-2,2);
753 end;
754 inc(Y,16);
755 end;
756 function AddButton(const s: string; ModalResult: integer): TButton;
757 var WB: integer;
758 begin
759 WB := Dialog.Form.Canvas.TextWidth(s)+52;
760 dec(XB,WB);
761 if XB<X shr 1 then begin
762 XB := aWidth-WB;
763 inc(Y,32);
764 end;
765 result := TButton.Create(Dialog.Form);
766 result.Parent := Par;
767 if aEmulateClassicStyle then
768 result.SetBounds(XB,Y,WB-10,22) else
769 result.SetBounds(XB,Y,WB-12,28);
770 result.Caption := s;
771 result.ModalResult := ModalResult;
772 result.TabOrder := CurrTabOrder;
773 result.OnClick := Dialog.Form.HandleEmulatedButtonClicked;
774 case ModalResult of
775 mrOk: begin
776 result.Default := true;
777 if aCommonButtons=[cbOk] then
778 result.Cancel := true;
779 end;
780 mrCancel: result.Cancel := true;
781 end;
782 if ModalResult=aButtonDef then
783 Dialog.Form.ActiveControl := result;
784 end;
785 var
786 PngImg: TPortableNetworkGraphic;
787 IconHandle: HICON;
788 begin
789 if (byte(aCommonButtons)=0) and (Buttons='') then begin
790 aCommonButtons := [cbOk];
791 if aButtonDef=0 then
792 aButtonDef := mrOk;
793 end;
794 if Title='' then
795 if Application.MainForm=nil then
796 Title := Application.Title else
797 Title := Application.MainForm.Caption;
798 if Inst='' then
799 Inst := IconMessage(aDialogIcon);
800 if aParent=0 then
801 if Screen.ActiveCustomForm<>nil then
802 aParent := Screen.ActiveCustomForm.Handle else
803 aParent := 0;
804 Dialog.OnButtonClicked := aOnButtonClicked;
805 {$ifdef MSWINDOWS}
806 if Assigned(TaskDialogIndirect) and not aNonNative and
807 not (tdfQuery in aFlags) and (Selection='') then begin
808 Dialog.Emulated := False;
809 // use Vista/Seven TaskDialog implementation (not tdfQuery nor Selection)
810 FillChar(Config{%H-},sizeof(Config),0);
811 Config.cbSize := sizeof(Config);
812 Config.hwndParent := aParent;
813 Config.pszWindowTitle := PWideChar(N(Title));
814 Config.pszMainInstruction := PWideChar(N(Inst));
815 Config.pszContent := PWideChar(N(Content));
816 RUCount := 0;
817 AddRU(Buttons,Config.cButtons,100);
818 AddRU(Radios,Config.cRadioButtons,200);
819 if Config.cButtons>0 then
820 Config.pButtons := @But[0];
821 if Config.cRadioButtons>0 then
822 Config.pRadioButtons := @But[Config.cButtons];
823 Config.pszVerificationText := PWideChar(N(Verify));
824 Config.pszExpandedInformation := PWideChar(N(Info));
825 Config.pszExpandedControlText := PWideChar(N(InfoExpanded));
826 Config.pszCollapsedControlText := PWideChar(N(InfoCollapse));
827 Config.pszFooter := PWideChar(N(Footer));
828 Config.dwCommonButtons := byte(aCommonButtons);
829 if (Verify<>'') and VerifyChecked then
830 include(aFlags,tdfVerificationFlagChecked);
831 if (Config.cButtons=0) and (aCommonButtons=[cbOk]) then
832 Include(aFlags,tdfAllowDialogCancellation); // just OK -> Esc/Alt+F4 close
833 Config.dwFlags := integer(aFlags);
834 Config.hMainIcon := TD_ICONS[aDialogIcon];
835 Config.hFooterIcon := TD_FOOTERICONS[aFooterIcon];
836 Config.nDefaultButton := aButtonDef;
837 Config.nDefaultRadioButton := aRadioDef;
838 Config.cxWidth := aWidth;
839 Config.pfCallback := @TaskDialogCallbackProc;
840 Config.lpCallbackData := @self;
841 if TaskDialogIndirect(@Config,@result,@RadioRes,@VerifyChecked)=S_OK then
842 exit; // error (mostly invalid argument) -> execute the VCL emulation
843 end;
844 {$endif MSWINDOWS}
845 // use our native (naive?) Delphi implementation
846 Dialog.Emulated := true;
847 Dialog.Form := TEmulatedTaskDialog.CreateNew(Application);
848 try
849 Dialog.Form.Owner := @Self;
850 // initialize form properties
851 Dialog.Form.BorderStyle := bsDialog;
852 if tdfAllowDialogCancellation in aFlags then
853 Dialog.Form.BorderIcons := [biSystemMenu]
854 else
855 Dialog.Form.BorderIcons := [];
856 if tdfPositionRelativeToWindow in aFlags then
857 Dialog.Form.Position := poOwnerFormCenter
858 else
859 Dialog.Form.Position := poScreenCenter;
860 if not aEmulateClassicStyle then
861 Dialog.Form.Font := DefaultFont;
862 FontHeight := Dialog.Form.Font.Height;
863 if FontHeight = 0 then
864 FontHeight := Screen.SystemFont.Height;
865 if aWidth=0 then begin
866 aWidth := Dialog.Form.Canvas.TextWidth(Inst);
867 if (aWidth>300) or (Dialog.Form.Canvas.TextWidth(Content)>300) or
868 (length(Buttons)>40) then
869 aWidth := 480 else
870 aWidth := 420;
871 end;
872 Dialog.Form.ClientWidth := aWidth;
873 Dialog.Form.Height := 200;
874 Dialog.Form.Caption := Title;
875 // create a white panel for the main dialog part
876 Panel := TPanel.Create(Dialog.Form);
877 Panel.Parent := Dialog.Form;
878 Panel.Align := alTop;
879 Panel.BorderStyle := bsNone;
880 Panel.BevelOuter := bvNone;
881 if not aEmulateClassicStyle then begin
882 Panel.Color := clWhite;
883 end;
884 Par := Panel;
885 // handle main dialog icon
886 if aEmulateClassicStyle then
887 IconBorder := 10 else
888 IconBorder := 24;
889
890 if (LAZ_ICONS[aDialogIcon]<>'') {$IFDEF MSWINDOWS}or (WIN_ICONS[aDialogIcon]<>nil){$ENDIF} then
891 begin
892 Image := TImage.Create(Dialog.Form);
893 Image.Parent := Par;
894 {$IFDEF MSWINDOWS}
895 if WIN_ICONS[aDialogIcon]<>nil then
896 IconHandle := LoadIcon(0,WIN_ICONS[aDialogIcon])
897 else
898 IconHandle := 0;
899 {$ELSE}
900 IconHandle := 0;
901 {$ENDIF}
902 if IconHandle<>0 then
903 Image.Picture.Icon.Handle := IconHandle
904 else if LAZ_ICONS[aDialogIcon]<>'' then
905 begin
906 Pic := TPortableNetworkGraphic.Create;
907 try
908 Pic.LoadFromResourceName(HINSTANCE, LAZ_ICONS[aDialogIcon]);
909 Image.Picture.Assign(Pic);
910 finally
911 Pic.Free;
912 end;
913 end;
914 Image.SetBounds(IconBorder,IconBorder,Image.Picture.Icon.Width,Image.Picture.Icon.Height);
915 X := Image.Width+IconBorder*2;
916 Y := Image.Top;
917 if aEmulateClassicStyle then
918 inc(Y, 8);
919 end else
920 begin
921 Image := nil;
922 if not aEmulateClassicStyle then
923 IconBorder := IconBorder*2;
924 X := IconBorder;
925 Y := IconBorder;
926 end;
927 // add main texts (Instruction, Content, Information)
928 Dialog.Form.Element[tdeMainInstruction] := AddLabel(Inst,true);
929 Dialog.Form.Element[tdeContent] := AddLabel(Content, false);
930 if Info<>'' then
931 // no information collapse/expand yet: it's always expanded
932 Dialog.Form.Element[tdeExpandedInfo] := AddLabel(Info,false);
933 // add command links buttons
934 if (tdfUseCommandLinks in aFlags) and (Buttons<>'') then
935 with TStringList.Create do
936 try
937 inc(Y,8);
938 Text := SysUtils.trim(Buttons);
939 for i := 0 to Count-1 do begin
940 CommandLink := TBitBtn.Create(Dialog.Form);
941 with CommandLink do begin
942 Parent := Par;
943 Font.Height := FontHeight-3;
944 if aEmulateClassicStyle then
945 SetBounds(X,Y,aWidth-10-X,40) else
946 SetBounds(X,Y,aWidth-16-X,40);
947 Caption := NoCR(Strings[i]);
948 if aHint<>'' then begin
949 ShowHint := true;
950 Hint := aHint; // note shown as Hint
951 end;
952 inc(Y,Height+2);
953 ModalResult := i+100;
954 OnClick := Dialog.Form.HandleEmulatedButtonClicked;
955 if ModalResult=aButtonDef then
956 Dialog.Form.ActiveControl := CommandLink;
957 if aEmulateClassicStyle then begin
958 Font.Height := FontHeight - 2;
959 Font.Style := [fsBold]
960 end;
961 if aEmulateClassicStyle then begin
962 Margin := 7;
963 Spacing := 7;
964 end else begin
965 Margin := 24;
966 Spacing := 10;
967 end;
968 if not (tdfUseCommandLinksNoIcon in aFlags) then
969 begin
970 PngImg := TPortableNetworkGraphic.Create;
971 try
972 PngImg.LoadFromResourceName(HINSTANCE, 'btn_arrowright');
973 Glyph.Assign(PngImg);
974 finally
975 PngImg.Free;
976 end;
977 end;
978 end;
979 end;
980 inc(Y,24);
981 finally
982 Free;
983 end;
984 // add radio buttons
985 if Radios<>'' then
986 with TStringList.Create do
987 try
988 Text := SysUtils.trim(Radios);
989 SetLength(Rad,Count);
990 for i := 0 to Count-1 do begin
991 Rad[i] := TRadioButton.Create(Dialog.Form);
992 with Rad[i] do begin
993 Parent := Par;
994 SetBounds(X+16,Y,aWidth-32-X,6-FontHeight);
995 Caption := NoCR(Strings[i]);
996 if aHint<>'' then begin
997 ShowHint := true;
998 Hint := aHint; // note shown as Hint
999 end;
1000 inc(Y,Height);
1001 if (i=0) or (i+200=aRadioDef) then
1002 Checked := true;
1003 end;
1004 end;
1005 inc(Y,24);
1006 finally
1007 Free;
1008 end;
1009 // add selection list or query editor
1010 if Selection<>'' then begin
1011 List := TStringList.Create;
1012 try
1013 Dialog.Form.Combo := TComboBox.Create(Dialog.Form);
1014 with Dialog.Form.Combo do begin
1015 Parent := Par;
1016 SetBounds(X,Y,aWidth-32-X,22);
1017 if tdfQuery in aFlags then
1018 Style := csDropDown else
1019 Style := csDropDownList;
1020 List.Text := trim(Selection);
1021 Items.Assign(List);
1022 ItemIndex := List.IndexOf(Query);
1023 if (ItemIndex=-1) and (Style=csDropDown) then
1024 Text := Query;
1025 if tdfQueryFieldFocused in aFlags then
1026 Dialog.Form.ActiveControl := Dialog.Form.Combo;
1027 end;
1028 inc(Y,42);
1029 finally
1030 List.Free;
1031 end;
1032 end else
1033 if tdfQuery in aFlags then begin
1034 Dialog.Form.Edit := TEdit.Create(Dialog.Form);
1035 with Dialog.Form.Edit do begin
1036 Parent := Par;
1037 SetBounds(X,Y,aWidth-16-X,22);
1038 Text := Query;
1039 if tdfQueryMasked in aFlags then
1040 PasswordChar := '*';
1041 end;
1042 if tdfQueryFieldFocused in aFlags then
1043 Dialog.Form.ActiveControl := Dialog.Form.Edit;
1044 inc(Y,42);
1045 end;
1046 // from now we won't add components to the white panel, but to the form
1047 Panel.Height := Y;
1048 Par := Dialog.Form;
1049 // add buttons and verification checkbox
1050 if (byte(aCommonButtons)<>0) or (Verify<>'') or
1051 ((Buttons<>'') and not (tdfUseCommandLinks in aFlags)) then begin
1052 CurrTabOrder := Panel.TabOrder;
1053 inc(Y, 16);
1054 XB := aWidth;
1055 if not (tdfUseCommandLinks in aFlags) then
1056 with TStringList.Create do
1057 try
1058 Text := SysUtils.trim(Buttons);
1059 for i := Count-1 downto 0 do
1060 AddButton(Strings[i],i+100);
1061 finally
1062 Free;
1063 end;
1064 for B := high(B) downto low(B) do
1065 if B in aCommonButtons then
1066 AddButton(TD_Trans(LoadResString(TD_BTNS(B))), TD_BTNMOD[B]);
1067 if Verify<>'' then begin
1068 Dialog.Form.Verif := TCheckBox.Create(Dialog.Form);
1069 with Dialog.Form.Verif do begin
1070 Parent := Par;
1071 if X+16+Dialog.Form.Canvas.TextWidth(Verify)>XB then begin
1072 inc(Y,32);
1073 XB := aWidth;
1074 end;
1075 SetBounds(X,Y,XB-X,24);
1076 Caption := Verify;
1077 Checked := VerifyChecked;
1078 end;
1079 end;
1080 inc(Y,36);
1081 end else
1082 XB := 0;
1083 // add footer text with optional icon
1084 if Footer<>'' then begin
1085 if XB<>0 then
1086 AddBevel else
1087 inc(Y,16);
1088 if (LAZ_FOOTERICONS[aFooterIcon]<>'') {$IFDEF MSWINDOWS}or (WIN_FOOTERICONS[aFooterIcon]<>nil){$ENDIF} then
1089 begin
1090 Image := TImage.Create(Dialog.Form);
1091 Image.Parent := Par;
1092 Pic := nil;
1093 Ico := nil;
1094 Bmp := TBitmap.Create;
1095 try
1096 Bmp.Transparent := true;
1097 {$IFDEF MSWINDOWS}
1098 if WIN_FOOTERICONS[aFooterIcon]<>nil then
1099 begin
1100 IconHandle := LoadIcon(0,WIN_FOOTERICONS[aFooterIcon]);
1101 if IconHandle<>0 then
1102 begin
1103 Ico := TIcon.Create;
1104 Ico.Handle := IconHandle;
1105 Bmp.Width := Ico.Width shr 1;
1106 Bmp.Height := Ico.Height shr 1;
1107 end;
1108 end;
1109 {$ENDIF}
1110 if (Ico=nil) and (LAZ_FOOTERICONS[aFooterIcon]<>'') then
1111 begin
1112 Pic := TPortableNetworkGraphic.Create;
1113 Pic.LoadFromResourceName(HINSTANCE, LAZ_FOOTERICONS[aFooterIcon]);
1114 Bmp.Width := Pic.Width shr 1;
1115 Bmp.Height := Pic.Height shr 1;
1116 end;
1117 if (Ico<>nil) or (Pic<>nil) then
1118 begin
1119 Bmp.Canvas.Brush.Color := Dialog.Form.Color;
1120 if Bmp.Canvas.Brush.Color = clDefault then
1121 Bmp.Canvas.Brush.Color := clBtnFace;
1122 Bmp.Canvas.FillRect(Rect(0, 0, Bmp.Width, Bmp.Height));
1123 if Pic<>nil then
1124 Bmp.Canvas.StretchDraw(Rect(0, 0, Bmp.Width, Bmp.Height), Pic)
1125 else
1126 begin
1127 {$IFDEF MSWINDOWS}
1128 DrawIconEx(Bmp.Canvas.Handle,0,0,Ico.Handle,Bmp.Width,Bmp.Height,0,
1129 Bmp.Canvas.Brush.{%H-}Handle,DI_NORMAL);
1130 {$ENDIF}
1131 end;
1132 Image.Picture.Bitmap := Bmp;
1133 Image.SetBounds(24,Y,Bmp.Width,Bmp.Height);
1134 X := 40+Bmp.Width;
1135 end;
1136 finally
1137 Bmp.Free;
1138 Pic.Free;
1139 Ico.Free;
1140 end;
1141 end else
1142 begin
1143 X := 24;
1144 end;
1145 Dialog.Form.Element[tdeFooter] := AddLabel(Footer,false);
1146 end;
1147 // display the form
1148 Dialog.Form.ClientHeight := Y;
1149
1150 //set form parent
1151 if aParent <> 0 then
1152 for I := 0 to Screen.CustomFormCount-1 do
1153 if Screen.CustomForms[I].Handle = aParent then
1154 begin
1155 Dialog.Form.PopupParent := Screen.CustomForms[I];
1156 Break;
1157 end;
1158 if not Assigned(Dialog.Form.PopupParent) then
1159 Dialog.Form.PopupParent := Screen.ActiveCustomForm;
1160 if Assigned(Dialog.Form.PopupParent) then
1161 Dialog.Form.PopupMode := pmExplicit;
1162
1163 // retrieve the results
1164 result := Dialog.Form.ShowModal;
1165 if Dialog.Form.Combo<>nil then begin
1166 SelectionRes := Dialog.Form.Combo.ItemIndex;
1167 Query := Dialog.Form.Combo.Text;
1168 end else
1169 if Dialog.Form.Edit<>nil then
1170 Query := Dialog.Form.Edit.Text;
1171 if Dialog.Form.Verif<>nil then
1172 VerifyChecked := Dialog.Form.Verif.Checked;
1173 RadioRes := 0;
1174 for i := 0 to high(Rad) do
1175 if Rad[i].Checked then
1176 RadioRes := i+200;
1177 finally
1178 FreeAndNil(Dialog.Form);
1179 end;
1180 end;
1181
1182 procedure TTaskDialog.SetElementText(element: TTaskDialogElement; const Text: string);
1183 {$IFDEF MSWINDOWS}
1184 const // wParam = element (TASKDIALOG_ELEMENTS), lParam = new element text (LPCWSTR)
1185 TDM_UPDATE_ELEMENT_TEXT = WM_USER+114;
1186 {$ENDIF}
1187 begin
1188 case element of
1189 tdeContent..tdeMainInstruction:
1190 if Dialog.Emulated then
1191 Dialog.Form.Element[element].Caption := CR(Text)
1192 {$IFDEF MSWINDOWS}
1193 else
1194 SendMessageW(Dialog.Wnd,TDM_UPDATE_ELEMENT_TEXT,ord(element),
1195 {%H-}NativeInt(PWideChar(_WS(Text))))
1196 {$ENDIF};
1197 tdeEdit:
1198 if Dialog.Emulated then
1199 Dialog.Form.Edit.Text := Text; // only in emulation
1200 tdeVerif:
1201 if Dialog.Emulated then
1202 Dialog.Form.Verif.Caption := Text
1203 end;
1204 end;
1205
1206
1207 { TEmulatedTaskDialog }
1208
1209 constructor TEmulatedTaskDialog.CreateNew(AOwner: TComponent; Num: Integer);
1210 begin
1211 inherited CreateNew(AOwner, Num);
1212
1213 KeyPreview := True;
1214 end;
1215
1216 procedure TEmulatedTaskDialog.HandleEmulatedButtonClicked(Sender: TObject);
1217 var btn: TButton absolute Sender;
1218 CanClose: Boolean;
1219 begin
1220 if Assigned(Owner) and Assigned(Owner.Dialog.OnButtonClicked) then begin
1221 CanClose := true;
1222 Owner.Dialog.OnButtonClicked(Owner,btn.ModalResult,CanClose);
1223 if not CanClose then
1224 ModalResult := mrNone;
1225 end;
1226 end;
1227
1228 procedure TEmulatedTaskDialog.KeyDown(var Key: Word; Shift: TShiftState);
1229 begin
1230 if (biSystemMenu in BorderIcons) then//is Alt+F4/Esc cancellation allowed?
1231 begin//yes -> cancel on ESC
1232 if Key = VK_ESCAPE then
1233 Close;
1234 end else
1235 begin//no -> block Alt+F4
1236 if (Key = VK_F4) and (ssAlt in Shift) then//IMPORTANT: native task dialog blocks Alt+F4 to close the dialog -> we have to block it as well
1237 Key := 0;
1238 end;
1239
1240 inherited KeyDown(Key, Shift);
1241 end;
1242
1243
1244 { TTaskDialogEx }
1245
1246 procedure TTaskDialogEx.Init;
1247 begin
1248 self := DefaultTaskDialog;
1249 end;
1250
Executenull1251 function TTaskDialogEx.Execute(aParent: HWND): integer;
1252 begin
1253 Result := Base.Execute(CommonButtons, ButtonDef, Flags, DialogIcon, FooterIcon,
1254 RadioDef, Width, aParent, NonNative, EmulateClassicStyle, OnButtonClicked);
1255 end;
1256
1257 initialization
1258 {$IFDEF MSWINDOWS}
1259 InitComCtl6;
1260 {$ENDIF}
1261 assert(ord(tdfCanBeMinimized)=15);
1262
1263 finalization
1264 LDefaultFont.Free;
1265
1266 end.
1267