Open Source SynTaskDialog unit for XP,Vista,Seven

ab · 2011-03-05 08:31:54

Welcome to the SynTaskDialog unit!
Implements TaskDialog window (native on Vista/Seven, emulated on XP).

This unit is a part of the freeware Synopse framework,
licensed under a MPL/GPL/LGPL tri-license.

Presentation

A task dialog is a dialog box that can be used to display information
and receive simple input from the user. Like a message box, it is
formatted by the operating system according to parameters you set.
However, a task dialog has many more features than a message box.

Windows provides a generic task dialog available since Vista/Seven.
But there is none available with previous versions of Windows, i.e.
Windows XP or 2K.

Our implementation

This unit will use the new TaskDialog API under Vista/Seven, and emulate
it with pure Delphi code and standard themed VCL components under XP or 2K.

Our task dialog is mainly implemented in the TTaskDialog record/object
type and methods.

It will compile from Delphi 6 up to XE, and is Unicode ready.

The emulation code is very simple, and only use standard VCL components.
With the theming enabled (don't forget to add XPMan as one of your units,
or set our {$R Vista.res} resource), it renders very nicely under XP.

Our task dialog has some additional features, which are not available by
default in the Vista/Seven TaskDialog: we have direct field edition or
selection (using a TEdit or a TComboBox), without any difficult callback
system to implement. Just fill the Selection property, or set the new
tdfQuery flag to enable those features (see sample code below).

Hello world

In order to use it, create a TTaskDialog object/record on the stack.
The Delphi compiler will initialize all its string parameters to ''
(it's a SHAME that since Delphi 2009, objects are not initialized any more:
we have to define this type as object before Delphi 2009, and as record
starting with Delphi 2009).

Then set the appropriate string parameters, and call Execute() with all
additional parameters.

After execution, RadioRes/SelectionRes/VerifyChecked can be used to
reflect the diverse results states.

See the comments in the unit souce code about all available properties
and parameters.

Here is a typical usage:

var Task: TTaskDialog;
begin
  Task.Inst := 'Saving application settings';
  Task.Content := 'This is the content';
  Task.Radios := 'Store settings in registry'#10'Store settings in XML file';
  Task.Verify := 'Do no ask for this setting next time';
  Task.VerifyChecked := true;
  Task.Footer := 'XML file is perhaps a better choice';
  Task.Execute([],0,[],tiQuestion,tfiInformation,200);
  ShowMessage(IntToStr(Task.RadioRes)); // 200=Registry, 201=XML
  if Task.VerifyChecked then
    ShowMessage(Task.Verify);
end;

Note that you don't need to put a Create/Free and a try..finally block to
protect the TTaskDialog instance. The Delphi compiler will do all the work
for us.

How to replace the VCL Dialogs unit functions

Here is some source code which may help you use the new task dialog
instead of the VCL Dialogs unit:

procedure ShowMessage(const Msg, Inst: string; Error: boolean=false);
const
  IconError: array[boolean] of TTaskDialogIcon = (tiInformation, tiError);
var Task: TTaskDialog;
begin
  Task.Inst := Inst;
  Task.Content := Msg;
  Task.Execute([cbOK],mrOk,[],IconError[Error]);
end;

function InputQuery(const ACaption, APrompt: string; var Value: string): Boolean;
var Task: TTaskDialog;
begin
  Task.Inst := ACaption;
  Task.Content := APrompt;
  Task.Query := Value;
  result := Task.Execute([cbOk,cbCancel],0,[tdfQuery],tiQuestion)=mrOk;
  if result then
    Value := Task.Query;
end;

function InputSelect(const ACaption, APrompt, AItemsText, ASelectedText: string): integer;
var Task: TTaskDialog;
begin
  result := -1;
  if AItemsText='' then
    exit;
  Task.Inst := ACaption;
  Task.Content := APrompt;
  Task.Selection := AItemsText;
  Task.Query := ASelectedText;
  if Task.Execute([cbOk,cbCancel],0,[],tiQuestion)=mrOk then
    result := Task.SelectionRes;
end;

I think we have here the simpliest Task Dialog unit available for Delphi,
all for free!

Reference material

For a general presentation about the TaskDialog, from the Microsoft POV,
see http://msdn.microsoft.com/en-us/library … S.85).aspx

For details about the Microsoft implementation API used in this unit, see
http://msdn.microsoft.com/en-us/library … S.85).aspx

One step further

This unit was developped for the User Interface, our SQlite3 Framework,
which is an Open Source ORM framework, based on a multi-tier architecture
and a RESTful approach.

E.g. in the SQLite3UILogin unit, you'll find additional functions and
usage of this unit. See also the sample application available in the
"Samples\08 - TaskDialog" folder.

If you find any bug, or need some enhancements, feel free to contribute
to this project. Enter the Open Source zone!

edwinsn · 2011-03-06 01:59:37

great! Thanks!

uligerhardt · 2011-03-08 09:36:38

Thanks for this unit. I have been considering writing a simple wrapper like yours for quite a while.

Some quick observations:

The command link emulation could perhaps achieve a more compatible look with the TBitBtn.Margin and Spacing properties.
Some ownerdrawing to draw the command link hints in emulation mode would be nice. But I guess that this would start to make this unit "heavy".
aButtonDef doesn't seem to workwith emulated command links.

Best regards,
Uli.

ab · 2011-03-08 16:52:18

There was an issue with aButtonDef and emulated command links.

About TBitBtn look, I've updated it using Margin and Spacing.
Thanks for the tip.

Ownerdrawing won't be feasible with Delphi 6 and raw TButton type...
If you find out a simple way to do it with other versions....

Here are the modifications:
http://synopse.info/fossil/info/12f5b0d9ee

Thanks for the feedback!

uligerhardt · 2011-03-08 19:50:36

Thanks for the update!

Thanks to Borland ownerdrawing won't be easy because the TBitBtn code is totally un-reusable. One would have to copy half of the Buttons unit to do any ownerdrawing.

Last edited by uligerhardt (2011-03-08 20:08:14)

ab · 2011-03-08 19:55:20

That was my personal guess too.... un-reusable is the word!!!!

IMHO the current implementation is just fine for most apps.
If you need a better looking button, you can use your own preferred button, since you've got the source code of the unit!
That's the beauty of Open Source.
But in its current state, this little unit is doing its purpose well enough.

christian · 2011-03-25 09:09:42

Using your approach (at least with the examples given) gives some different results compared to the native Vista/7 TaskDialog:

- It doesn't produce a modal dialog !!
- The ShowMessage example cannot be closed by pressing the ESC key (only the return key is assigned to the btOK)

Is there some missed setting needed?

Regards,
Christian

ab · 2011-03-25 10:49:12

With the emulated code:

christian wrote:

- It doesn't produce a modal dialog !!

It's modal to the current application only.
Is this a problem?

christian wrote:

- The ShowMessage example cannot be closed by pressing the ESC key (only the return key is assigned to the btOK)

On my computer, ESC does close the window.

christian · 2011-03-26 06:49:03

Well yes and no

It gives a different behaviour with the native (Win7) and the emulated (WinXP) version.

With Win7 the ShowMessage Example produces no modal dialog windows and they cannot be closed with ESC!
With WinXP the behaviour is as expected (modal and can be closed with ESC).

Example with a Form with one Button:

procedure MyShowMessage(const Msg, Inst: string; Error: boolean=false);
const
  IconError: array[boolean] of TTaskDialogIcon = (tiInformation, tiError);
var Task: TTaskDialog;
begin
  Task.Inst := Inst;
  Task.Content := Msg;
  Task.Execute([cbOK],mrOk,[],IconError[Error]);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  MyShowMessage('MyMsg', 'MyInst');
end;

ab · 2011-03-26 08:46:36

So under Win7, the standard task dialog API is called directly.
That is, the code from Microsoft is executed.
I'm not able to change it.

Perhaps some hidden flag?

ab · 2011-03-26 11:47:19

OK. I found the possible issue.

Fixed issue: "no modal dialog windows and they cannot be closed with ESC"
See http://synopse.info/fossil/info/478dbb2449

Thanks for the report!

uligerhardt · 2011-10-12 12:18:02

Hello ab!

Some more nitpicking about the look of your emulation. :-)
I'd like to look the emulated dialogs more like the real Windows 7 task dialog under Windows Classic (i.e. unthemed), that is similar to this:
.

no white panel
different fonts
narrower borders
etc.

I have played a bit with SynTaskDialog.pas and got a look that I like better (even if I'm not done yet). Would you be interested in integrating this in the official unit as an compile time or runtime option?

Another thing: I'd suggest you remove the shadow from the arrow bitmap because it looks ugly when you have configured your system to a non-gray clBtnFace. (PNG probably isn't an option.)

Best regards,
Uli.

Last edited by uligerhardt (2011-10-12 12:41:13)

uligerhardt · 2011-10-12 13:14:03

One other question: Is there a reason that there are so many arguments to TTaskDialog.Execute? I think SynTaskDialog would be easier to use if most of these parameters were fields of the TTaskDialog record instead.

And it might be good to replace TTaskDialogForm.FormShow with an override of DoShow.

Last edited by uligerhardt (2011-10-12 13:17:04)

uligerhardt · 2011-10-12 14:41:10

If I have more suggestions, would http://synopse.info/fossil/rptview?rn=1 / http://synopse.info/fossil/tktnew be the place to report them?

ab · 2011-10-12 15:36:44

Welcome uligerhardt!

Any suggestion is always welcome.

The look depends on the Windows theming - using plain Windows controls has its pros and cons.
I wanted the unit to stay "plain" VCL ready, and the resulting layout is expected to use Windows theming.

The fact that there are some many arguments in Execute() is, as far as I remember, that... there is no obvious reason unless that they will provide default parameters.
We may pass all arguments as TTaskDialog fields, but since it is an object/record, there is no default values to them (when allocated on the stack, it is not filled with zero).

You can use the fossil tickets, but for issues.
For suggestions and enhancements, you can better use this forum, and we will discuss here.

Thanks for your interest.

uligerhardt · 2011-10-12 16:44:07

ab wrote:

The look depends on the Windows theming - using plain Windows controls has its pros and cons.
I wanted the unit to stay "plain" VCL ready, and the resulting layout is expected to use Windows theming.

The fact that your unit uses standard VCL controls and respects theming is one of the things I like about it.

What I mean is that the emulated task dialogs look like the MS dialogs from a standard Windows Vista/7 Aero. Because of this they look a bit out of place on on XP with Luna and on every classic/unthemed Windows (even on unthemed Vista/7). If the emulation looked more like a Windows Classic task dialog it would blend in better on those platforms.

ab wrote:

The fact that there are some many arguments in Execute() is, as far as I remember, that... there is no obvious reason unless that they will provide default parameters.
We may pass all arguments as TTaskDialog fields, but since it is an object/record, there is no default values to them (when allocated on the stack, it is not filled with zero).

OK, I see.

ab wrote:

You can use the fossil tickets, but for issues.
For suggestions and enhancements, you can better use this forum, and we will discuss here.

OK.

ab wrote:

Thanks for your interest.

Thanks for your component. :-)

uligerhardt · 2011-10-12 20:40:21

Regarding the border width of the emulation: Just compare the border around the icon of an emulated dialog

with a Windows task dialog, either themed

or unthemed

(Replacing the 24's after WIN_ICONS[aDialogIcon] with 10's (and 48 with 20) should work. )

ab · 2011-10-13 12:00:12

As a matter of fact, for personal taste, I made the button layout a bit larger.

I'll stick to your values.
See http://synopse.info/fossil/info/0da563d560

uligerhardt · 2011-10-13 13:43:12

Thank you, Arnaud,

this almost looks like the original!
Maybe you could insert

Panel.BevelOuter := bvNone;
Panel.BevelEdges := [beBottom];
Panel.BevelKind := bkFlat;

after the

Panel.BorderStyle := bsNone;

line to make the border around the white panel more authentic.

Two more things: If I show a task dialog like this:

var
  Task: TTaskDialog;
  Res: Integer;
begin
  Task.Inst := 'Saving application settings';
  Task.Content := 'This is the content';
  Task.Buttons := 'Registry\nStore settings in registry' + sLineBreak + 'XML\nStore settings in XML file';
  Res := Task.Execute([cbOK, cbCancel], 101, [tdfUseCommandLinks], tiQuestion, tfiInformation, 0, 0, Handle, CheckBoxUseEmulation.Checked);
end;

the "real" dialog has a close button in the upper right corner, while the emulated one hasn't. Is there a way to have the button in the emulation, too?

With the same code, the tab order of the OK and Cancel buttons is reversed. This could fixed like this:

Declare
```
CurrTabOrder: TTabOrder;
```
next to Par and Panel.

Put the line

CurrTabOrder := Panel.TabOrder;

at the beginning of the

if (byte(aCommonButtons) <> 0)...

branch.

Set
```
    result.TabOrder := CurrTabOrder;
```
in AddButton.

BTW: I hate to be a PITA, but I like my GUI to be "right". :-)

uligerhardt · 2011-10-14 11:51:00

Once more a PITA. :-)

uligerhardt wrote:

Another thing: I'd suggest you remove the shadow from the arrow bitmap because it looks ugly when you have configured your system to a non-gray clBtnFace. (PNG probably isn't an option.)

Do see what I mean compare these pictures:
Original Windows dialog:

Emulation, arrow with shadow:

Emulation, arrow without shadow:

The last screenshot was produced with this BTNARROW (can't append the real bmp, unfortunately):

Looks better, doesn't it?

Best regards,
Uli.

Last edited by uligerhardt (2011-10-14 11:51:15)

uligerhardt · 2011-10-20 08:36:05

Hello Arnaud,

if you have an app that uses SynTaskDialog and has runtime packages enabled you get compiler errors

E2201: Need imported data reference ($G) to access 'SMsgDlgOK' from unit 'SynTaskDialog'

for TD_BTNS and TD_ICONS_IDENT. I don't know where this comes from - probably vcl.dpk is compiled with the "wrong {$IMPORTEDDATA ...} directive. There is a (German) post that seems to deal with this problem: http://www.delphipraxis.net/72509-resou … ckage.html and this post: https://forums.embarcadero.com/message. … ageID=6844.

I've found two workarounds: Either

replace the pointer arrays with string arrays like

TD_ICONS_IDENT: array[TTaskDialogIcon] of string =(
    '', SMsgDlgWarning, SMsgDlgConfirm, SMsgDlgError, SMsgDlgInformation,
    '', SMsgDlgInformation);

and remove some LoadResString calls or

replace the pointer arrays with functions like
```
GetIconIdent(TTaskDialogIcon): Pointer
```
.

Best regards,
Uli.

Last edited by uligerhardt (2011-10-20 08:40:14)

uligerhardt · 2011-10-21 19:02:53

Hello Arnaud,

I have made some modifications to SynTaskDialog.pas and will send them to you per mail as I can't attach it here. You probably won't like all of the changes but feel free to take what you like.

I wrote a little wrapper TTaskDialogEx to make the usage of TTaskDialog.Execute a bit easier if you want to change just one or two of the default arguments. There is a global variable DefaultTaskDialogEx: TTaskDialogEx which is initialized to the default values from TTaskDialog.Execute.
You could use it like this:

Customize DefaultTaskDialogEx in some initialization section, FormCreate or similar, maybe
```
DefaultTaskDialogEx.EmulateClassicStyle := True;
```
or
```
DefaultTaskDialogEx.AlwaysEmulate := True;
```

Use it like

procedure TForm1.Button3Click(Sender: TObject);
const
  Icons: array[TMsgDlgType] of SynTaskDialog.TTaskDialogIcon = (
    tiWarning, tiError, tiInformation, tiQuestion, tiNotUsed);
var
  Task: SynTaskDialog.TTaskDialogEx;
  Res: Integer;
begin
  Task := DefaultTaskDialogEx;
  
  // Base is a TTaskDialog
  Task.Base.Title := 'My Test App';
  Task.Base.Inst := 'Saving application settings';
  // more Base settings...

  Task.CommonButtons := [cbOK, cbCancel];
  Task.ButtonDef := 101;
  Task.Flags := [tdfUseCommandLinks];
  // Notice: no mentioning of DialogIcon, FooterIcon, RadioDef, Width, ...

  Res := Task.Execute(Handle);
end;

All other changes only apply if emulation is active.

New parameter EmulateClassicStyle in TTaskDialog.Execute. If True then the emulation is drawn more like the original Microsoft dialog under Windows Classic. (This is not finished yet - the verification checkbox and footer text aren't handled correctly yet.)
If EmulateClassicStyle = False I've reverted the icon border to your taste (24 instead of 10, see post http://synopse.info/forum/viewtopic.php?pid=2777#p2777).
BitmapOK (and its accompanying res entry) weren't used, so I removed them.
Removed the shadow in the arrow bitmap (see http://synopse.info/forum/viewtopic.php?pid=2785#p2785).
I split TSynButton in two: TSynCommandLink for the command links and TSynButton for the other buttons. The latter ones are now never TBitBtns because this looks ugly for OK buttons etc (wrong text base line) and the Glyph isn't used anyway.
The DropDown stuff in TSynButton wasn't used, so I commented it out.
Fixed the E2201 error by using an array of strings (see http://synopse.info/forum/viewtopic.php?pid=2850#p2850).
By overloading TTaskDialogForm.Create (calling CreateNew) some ugly casting could be removed.
Used ActiveControl instead of the Tag/FormShow trick.
Fixed the TabOrder issue (see http://synopse.info/forum/viewtopic.php?pid=2778#p2778).

Uli

uligerhardt · 2011-10-24 19:08:26

uligerhardt wrote:

3. BitmapOK (and its accompanying res entry) weren't used, so I removed them.
5. I split TSynButton in two: TSynCommandLink for the command links and TSynButton for the other buttons. ...
6. The DropDown stuff in TSynButton wasn't used, so I commented it out.

That move wasn't too smart, as all of these are used elsewhere in your framework. I've reinstated them and will send you an update later.

Last edited by uligerhardt (2011-10-24 19:12:14)

ab · 2011-10-25 12:29:22

uligerhardt wrote:

That move wasn't too smart, as all of these are used elsewhere in your framework. I've reinstated them and will send you an update later.

I would not have deleted those lines either.

I'm waiting for your update.

uligerhardt · 2011-10-25 13:48:17

ab wrote:

uligerhardt wrote:
That move wasn't too smart, as all of these are used elsewhere in your framework. I've reinstated them and will send you an update later.
I would not have deleted those lines either.

I guessed so. :-)

ab wrote:

I'm waiting for your update.

I sent it this morning to your bouchez-info address. Slow electrons today...

ab · 2011-10-25 13:51:53

I've received the updated version.

Some questions:
- What may be the specifications for "EmulateClassicStyle" new parameter?
- What is the purpose of those TSynCommandLinkParent and such types (sounds like redundant code)?
- May I receive the refreshed "arrow" icon?
- Why did you overwrite the TForm constructor?

Using ActiveControl instead of my tricky Form.Tag use is well done.

ab · 2011-10-25 14:18:43

FYI the RecreateAsPopup method is not available in Delphi 5-6-7 (at least).

So I would rather use the previous implementation, using the CreateParented() constructor.

uligerhardt · 2011-10-25 14:52:07

ab wrote:

- What may be the specifications for "EmulateClassicStyle" new parameter?

I'd like a task dialog under Windows XP without themes to look similar to a task dialog under Vista/7 without themes. EmulateClassicStyle tries to achieve that by making the emulation look more like Windows Classic.

For example, this is a task dialog under Windows 7 with Contrast #1 theme:

These are emulated dialogs with EmulateClassicStyle = True:

and EmulateClassicStyle = False:

There are quite a few differences: fonts, background color, border sizes etc. And there are still a lot of details missing.

ab wrote:

- What is the purpose of those TSynCommandLinkParent and such types (sounds like redundant code)?

I introduced TSynTaskDialogButton because the OK, Cancel and similar buttons shouldn't be TBitBtns. They don't ever show bitmaps (on a task dialog) and look slightly wrong if one uses TBitBtns (the text is one or two pixels to low, which stands out if the button is only 22 pixels tall).

At the moment TSynCommandLinkParent and TSynCommand are just relicts of my "not so smart move" and could be replaced by TSynButton. One could probably use them to integrate a button class that looks more like a "real" command link.

ab wrote:

- May I receive the refreshed "arrow" icon?

Done.

ab wrote:

- Why did you overwrite the TForm constructor?

In the original code you created a TForm instance and casted it to TTaskDialogForm which it wasn't. In the modified code a real TTaskDialogForm is created and no cast is needed.

If you decide to go with the RecreateAsPopup way and skip the CreateParented, you could also directly call TTaskDialogForm.CreateNew and remove the overridden constructor.

ab wrote:

Using ActiveControl instead of my tricky Form.Tag use is well done.

Thanks. I wasn't sure if it's compatible with D<2006 and TMS.

uligerhardt · 2011-10-25 14:58:43

ab wrote:

FYI the RecreateAsPopup method is not available in Delphi 5-6-7 (at least).
So I would rather use the previous implementation, using the CreateParented() constructor.

I see. But CreateParented seems to exist for embedding controls in other controls and not for establishing a hierarchy between top-level windows/forms. This is probably the cause for http://synopse.info/fossil/tktview?name=01395e5932. Can you reproduce that?

ab · 2011-10-25 16:04:43

About RecreateAsPopup, as far as I understood the VCL implementation of this method (from a quick overview), it is similar to CreateParented...
Perhaps you can confirm it.

But it may definitively be the reason of RecreateAsPopup.
As you stated in this ticket (I did not notice its existence!), we may safely use a plain Create instead. Is it right?
AFAIK it works as expected, and fix the issue.
RecreateAsPopup just does not make any difference with a plain Create + ShowModal.

ab · 2011-10-26 06:54:30

I've committed some changes, including most of your enhancements.

See http://synopse.info/fossil/info/7fff1f171e

I've also closed the ticked (obfuscating your email address - just to not let too much spam ride in your mail box).

Thanks a lot for your support.
Feel free to comment!

uligerhardt · 2011-10-27 08:54:45

ab wrote:

About RecreateAsPopup, as far as I understood the VCL implementation of this method (from a quick overview), it is similar to CreateParented...
Perhaps you can confirm it.
But it may definitively be the reason of RecreateAsPopup.
As you stated in this ticket (I did not notice its existence!), we may safely use a plain Create instead. Is it right?
AFAIK it works as expected, and fix the issue.
RecreateAsPopup just does not make any difference with a plain Create + ShowModal.

I can't test right now (I'm on vacation for Hof film festival :-)) but AFAIR CreateParented showed the problematic behaviour under Windows 7 + D2007 and XP + D2006 whereas plain Create (or CreateNew) worked in both cases. RecreateAsPopup probably only makes a difference if the owner/parent form is non-VCL.

ab · 2011-10-27 09:26:53

Thanks!
As far as I tested it, my commit did work as expected under Windows 7 and XP.

Enjoy your holidays!

uligerhardt · 2011-10-29 15:41:54

ab wrote:

As far as I tested it, my commit did work as expected under Windows 7 and XP.

Some comments:

SynTaskDialog doesn't compile for me - in line 791 EmulateClassicStyle is used instead of aEmulateClassicStyle.
Line 726 (the first "Panel.Color := clWhite;") should be deleted, otherwise EmulateClassicStyle also shows a white background.

At the moment, with EmulateClassicStyle = True there is a line below the white panel where there should be none IMHO.
With EmulateClassicStyle = False there are even two lines next to each other. Something like

Panel := TPanel.Create(Form);
Panel.Parent := Form;
Panel.Align := alTop;
Panel.BorderStyle := bsNone;
Panel.BevelOuter := bvNone;
if not aEmulateClassicStyle then begin
  Panel.BevelEdges := [beBottom];
  Panel.BevelKind := bkFlat;
  Panel.Color := clWhite;
  {$ifdef WITHUXTHEME}
  Panel.ParentBackground := false; // clWhite not used otherwise
  {$endif}
end;
Par := Panel;

might be better.

Regarding the OK/Cancel/... buttons: Compare this (current version)

and this, where I changed AddButton to create and return a plain TButton:

. Notice the ugly text placement in the OK and Abbrechen (= Cancel) buttons of the first image?
(NB: Just replacing "TSynButton" with "TButton" in AddButton wouldn't be enough because ButtonClick specifically checks for TSynButton.)
Somewhat related: I guess
```
Sender is TSynButton
```
is more idiomatic in Delphi than
```
Sender.InheritsFrom(TSynButton)
```

Thanks for taking care of my ideas. I threaten to bring some more ideas if I've got some time again.

ab wrote:

Enjoy your holidays!

Thanks, I did up to now. Even watched some French movies although I know next to no French. Luckily there are subtitles :-)

ab · 2011-10-29 18:14:57

I've made today a new commit to fix the compile issues.

ab · 2011-10-31 10:32:13

See also http://synopse.info/fossil/info/dd525a9d49 with your latest proposals.

Thanks!

reddwarf · 2012-02-26 12:42:45

Hello!

I decided to use your SynTaskDialog in my projects now and I faced the problem of unicode support lack for non-unicode Delphi versions. I updated your code - tested under D2007 and XE2. Now nice unicode dialogs can be shown in D2007 and WinXP.

I use TntUnicodeControls for D2007 and emulation on XP. It can be switched off with the USETNTPACK directive (then, of course, D2007 unicode support for emulated dialog is lost, but the Win7 dialog under D2007 is still shown fine).

Honestly, I nearly haven't changed your code, only the type definitions and voila, everything works fine Good job from you!

Best

SynTaskDialog.pas:

/// implement TaskDialog window (native on Vista/Seven, emulated on XP)
// - this unit is a part of the freeware Synopse framework,
// licensed under a MPL/GPL/LGPL tri-license; version 1.16
unit SynTaskDialog;

{
    This file is part of Synopse framework.

    Synopse framework. Copyright (C) 2012 Arnaud Bouchez
      Synopse Informatique - http://synopse.info

  *** BEGIN LICENSE BLOCK *****
  Version: MPL 1.1/GPL 2.0/LGPL 2.1

  The contents of this file are subject to the Mozilla Public License Version
  1.1 (the "License"); you may not use this file except in compliance with
  the License. You may obtain a copy of the License at
  http://www.mozilla.org/MPL

  Software distributed under the License is distributed on an "AS IS" basis,
  WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
  for the specific language governing rights and limitations under the License.

  The Original Code is Synopse framework.

  The Initial Developer of the Original Code is Arnaud Bouchez.

  Portions created by the Initial Developer are Copyright (C) 2012
  the Initial Developer. All Rights Reserved.

  Contributor(s):
  Alternatively, the contents of this file may be used under the terms of
  either the GNU General Public License Version 2 or later (the "GPL"), or
  the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
  in which case the provisions of the GPL or the LGPL are applicable instead
  of those above. If you wish to allow use of your version of this file only
  under the terms of either the GPL or the LGPL, and not to allow others to
  use your version of this file under the terms of the MPL, indicate your
  decision by deleting the provisions above and replace them with the notice
  and other provisions required by the GPL or the LGPL. If you do not delete
  the provisions above, a recipient may use your version of this file under
  the terms of any one of the MPL, the GPL or the LGPL.

  ***** END LICENSE BLOCK *****

  Version 1.13
  - initial release

  Version 1.15
  - new tdfQueryMasked function to display * in the tdfQuery editor field

  Version 1.16
  - fixed issue when changing the current application with Alt+Tab - see
    http://synopse.info/fossil/tktview?name=01395e5932
  - fixed compiler error when using the unit with runtime packages enabled
    (known compiler issue about string resources, referenced as E2201)
  - some aesthetical rendering changes and code clean-up (e.g. no temporary
    form necessary), thanks to uligerhardt proposals

  Ondrej 2012-02-26
  - added WideString Support even for Delphi<=D2007 + Win 7
  - added TntControls for true unicode support even for Delphi<=D2007 + Win XP
}

interface

{$IFDEF CONDITIONALEXPRESSIONS}  // Delphi 6 or newer
  {$ifndef VER140} // Delphi 6
    {$define WITHUXTHEME} // Themes unit exists till Delphi 7
  {$endif}
{$ENDIF}

{$DEFINE USETNTPACK}//TRUE UNICODE SUPPORT FOR <Delphi2007 and WinXP
uses
  Windows, Classes, SysUtils, Consts, SynWideSupp,
  {$ifdef USETMSPACK}
  AdvGlowButton, AdvMenus, TaskDialog, TaskDialogEx,
  {$else}
    {$ifdef USETNTPACK}
    TntClasses, TntMenus, TntStdCtrls, TntButtons, TntExtCtrls, TntForms,
    {$else}
    Menus,
    {$endif USETNTPACK}
  {$endif USETMSPACK}
  {$ifndef UNICODE}WideStrUtils, {$endif}
  Graphics, Forms, Controls, StdCtrls, ExtCtrls, Buttons;

var
  /// will map a generic OK picture from SynTaskDialog.res
  BitmapOK: TBitmap;
  /// will map a generic Arrow picture from SynTaskDialog.res
  BitmapArrow: TBitmap;

  /// will map a default font, according to the available
  // - if Calibri is installed, will use it
  // - will fall back to Tahoma otherwise
  DefaultFont: TFont;

{$ifndef USETMSPACK}
  /// is filled once in the initialization block below
  // - you can set this reference to nil to force Delphi dialogs even
  // on Vista/Seven (e.g. make sense if TaskDialogBiggerButtons=true)
  TaskDialogIndirect: function(AConfig: pointer; Res: PInteger;
    ResRadio: PInteger; VerifyFlag: PBOOL): HRESULT; stdcall;

type

  /// the standard kind of common buttons handled by the Task Dialog
  TCommonButton = (
    cbOK, cbYes, cbNo, cbCancel, cbRetry, cbClose);

  /// set of standard kind of common buttons handled by the Task Dialog
  TCommonButtons = set of TCommonButton;

  /// the available main icons for the Task Dialog
  TTaskDialogIcon = (
    tiBlank, tiWarning, tiQuestion, tiError, tiInformation, tiNotUsed, tiShield);

  /// the available footer icons for the Task Dialog
  TTaskDialogFooterIcon = (
    tfiBlank, tfiWarning, tfiQuestion, tfiError, tfiInformation, tfiShield);

  /// the available configuration flags for the Task Dialog
  // - most are standard TDF_* flags used for Vista/Seven native API
  // (see http://msdn.microsoft.com/en-us/library/bb787473(v=vs.85).aspx
  // for TASKDIALOG_FLAGS)
  // - tdfQuery and tdfQueryMasked are custom flags, implemented in pure Delphi
  // code to handle input query
  // - our emulation code will handle only tdfUseCommandLinks,
  // tdfUseCommandLinksNoIcon, and tdfQuery options
  TTaskDialogFlag = (
    tdfEnableHyperLinks, tdfUseHIconMain, tdfUseHIconFooter,
    tdfAllowDialogCancellation, tdfUseCommandLinks, tdfUseCommandLinksNoIcon,
    tdfExpandFooterArea, tdfExpandByDefault, tdfVerificationFlagChecked,
    tdfShowProgressBar, tdfShowMarqueeProgressBar, tdfCallbackTimer,
    tdfPositionRelativeToWindow, tdfRtlLayout, tdfNoDefaultRadioButton,
    tdfCanBeMinimized, tdfQuery, tdfQueryMasked);

  /// set of available configuration flags for the Task Dialog
  TTaskDialogFlags = set of TTaskDialogFlag;

  /// implements a TaskDialog
  // - will use the new TaskDialog API under Vista/Seven, and emulate it with
  // pure Delphi code and standard themed VCL components under XP or 2K
  // - create a TTaskDialog object/record on the stack will initialize all
  // its string parameters to '' (it's a SHAME that since Delphi 2009, objects
  // are not initialized any more: we have to define this type as object before
  // Delphi 2009, and as record starting with Delphi 2009)
  // - set the appropriate string parameters, then call Execute() with all
  // additional parameters
  // - RadioRes/SelectionRes/VerifyChecked will be used to reflect the state
  // after dialog execution
  // - here is a typical usage:
  // !var Task: TTaskDialog;
  // !begin
  // !  Task.Inst := 'Saving application settings';
  // !  Task.Content := 'This is the content';
  // !  Task.Radios := 'Store settings in registry'#10'Store settings in XML file';
  // !  Task.Verify := 'Do no ask for this setting next time';
  // !  Task.VerifyChecked := true;
  // !  Task.Footer := 'XML file is perhaps a better choice';
  // !  Task.Execute([],0,[],tiQuestion,tfiInformation,200);
  // !  ShowMessage(IntToStr(Task.RadioRes)); // 200=Registry, 201=XML
  // !  if Task.VerifyChecked then
  // !    ShowMessage(Task.Verify);
  // !end;
  TTaskDialog = {$ifdef UNICODE}record{$else}object{$endif}
    /// the main title of the dialog window
    // - if left void, the title of the application main form is used
    Title: SynWideString;
    /// the main instruction (first line on top of window)
    // - any '\n' will be converted into a line feed
    // - if left void, the text is taken from the current dialog icon kind
    Inst: SynWideString;
    /// the dialog's primary content content text
    // - any '\n' will be converted into a line feed
    Content: SynWideString;
    /// a #13#10 or #10 separated list of custom buttons
    // - they will be identified with an ID number starting at 100
    // - by default, the buttons will be created at the dialog bottom, just
    // like the common buttons
    // - if tdfUseCommandLinks flag is set, the custom buttons will be created
    // as big button in the middle of the dialog window; in this case, any
    // '\n' will be converted as note text (shown with smaller text under native
    // Vista/Seven TaskDialog, or as popup hint within Delphi emulation)
    Buttons: SynWideString;
    /// a #13#10 or #10 separated list of custom radio buttons
    // - they will be identified with an ID number starting at 200
    // - aRadioDef parameter can be set to define the default selected value
    // - '\n' will be converted as note text (shown with smaller text under
    // native Vista/Seven TaskDialog, or as popup hint within Delphi emulation)
    Radios: SynWideString;
    /// the expanded information content text
    // - any '\n' will be converted into a line feed
    // - the Delphi emulation will always show the Info content (there is no
    // collapse/expand button)
    Info: SynWideString;
    /// the button caption to be displayed when the information is collapsed
    // - not used under XP: the Delphi emulation will always show the Info content
    InfoExpanded: SynWideString;
    /// the button caption to be displayed when the information is expanded
    // - not used under XP: the Delphi emulation will always show the Info content
    InfoCollapse: SynWideString;
    /// the footer content text
    // - any '\n' will be converted into a line feed
    Footer: SynWideString;
    /// the text of the bottom most optional checkbox
    Verify: SynWideString;
    /// a #13#10 or #10 separated list of items to be selected
    // - if set, a Combo Box will be displayed to select
    // - if tdfQuery is in the flags, the combo box will be in edition mode,
    // and the user will be able to edit the Query text or fill the field
    // with one item of the selection
    // - this selection is not handled via the Vista/Seven TaskDialog, but
    // with our Delphi emulation code (via a TComboBox)
    Selection: SynWideString;
    /// some text to be edited
    // - if tdfQuery is in the flags, will contain the default query text
    // - if Selection is set, the
    Query: SynWideString;
    /// the selected radio item
    // - first is numeroted 0
    RadioRes: integer;
    /// after execution, contains the selected item from the Selection list
    SelectionRes: integer;
    /// reflect the the bottom most optional checkbox state
    // - if Verify is not '', should be set before execution
    // - after execution, will contain the final checkbox state
    VerifyChecked: BOOL;
    /// launch the TaskDialog form
    // - some common buttons can be set via aCommonButtons
    // - in emulation mode, aFlags will handle only tdfUseCommandLinks,
    // tdfUseCommandLinksNoIcon, and tdfQuery options
    // - will return 0 on error, or the Button ID (e.g. mrOk for the OK button
    // or 100 for the first custom button defined in Buttons string)
    // - if Buttons was defined, aButtonDef can set the selected Button ID 
    // - if Radios was defined, aRadioDef can set the selected Radio ID
    // - aDialogIcon and aFooterIcon are used to specify the displayed icons
    // - aWidth can be used to force a custom form width (in pixels)
    // - aParent can be set to any HWND - by default, Application.DialogHandle
    // - if aNonNative is TRUE, the Delphi emulation code will always be used
    // - aEmulateClassicStyle can be set to enforce conformity with the non themed
    // user interface - see @http://synopse.info/forum/viewtopic.php?pid=2867#p2867
    function Execute(aCommonButtons: TCommonButtons=[];
      aButtonDef: integer=0; aFlags: TTaskDialogFlags=[];
      aDialogIcon: TTaskDialogIcon=tiInformation;
      aFooterIcon: TTaskDialogFooterIcon=tfiWarning;
      aRadioDef: integer=0; aWidth: integer=0; aParent: HWND=0;
      aNonNative: boolean=false; aEmulateClassicStyle: boolean = false): integer;
  end;

  /// a wrapper around the TTaskDialog.Execute method
  // - used to provide a "flat" access to task dialog parameters
  TTaskDialogEx = {$ifdef UNICODE}record{$else}object{$endif}
    /// the associated main TTaskDialog instance
    Base: TTaskDialog;
    /// some common buttons to be displayed
    CommonButtons: TCommonButtons;
    /// the default button ID
    ButtonDef: integer;
    /// the associated configuration flags for this Task Dialog
    // - in emulation mode, aFlags will handle only tdfUseCommandLinks,
    // tdfUseCommandLinksNoIcon, and tdfQuery options
    Flags: TTaskDialogFlags;
    /// used to specify the dialog icon
    DialogIcon: TTaskDialogIcon;
    /// used to specify the footer icon
    FooterIcon: TTaskDialogFooterIcon;
    /// the default radio button ID
    RadioDef: integer;
    /// can be used to force a custom form width (in pixels)
    Width: integer;
    /// if TRUE, the Delphi emulation code will always be used
    NonNative: boolean;
    /// can be used to enforce conformity with the non themed user interface
    EmulateClassicStyle: boolean;
    /// main (and unique) method showing the dialog itself
    // - is in fact a wrapper around the TTaskDialog.Execute method
    function Execute(aParent: HWND=0): integer;
  end;
{$endif USETMSPACK}

type
{$ifdef USETMSPACK}
  /// a TMS PopupMenu
  TSynPopupMenu = TAdvPopupMenu;

  TSynButtonParent = TAdvGlowButton;
{$else}
{$ifdef USETNTPACK}
  TSynPopupMenu = TTntPopupMenu;

  TSynButtonParent = {$ifdef WITHUXTHEME}TTntBitBtn{$else}TTntButton{$endif};
{$else}
  /// a generic VCL popup menu
  TSynPopupMenu = TPopupMenu;

  TSynButtonParent = {$ifdef WITHUXTHEME}TBitBtn{$else}TButton{$endif};
{$endif USETNTPACK}
{$endif USETMSPACK}

{$ifdef USETNTPACK}
  TSynEdit = TTntEdit;
  TSynPanel = TTntPanel;
  TSynCheckBox = TTntCheckBox;
  TSynComboBox = TTntComboBox;
  TSynRadioButton = TTntRadioButton;
  TSynLabel = TTntLabel;
  TSynForm = TTntForm;

  TSynWideStrings = TTntStrings;
  TSynWideStringList = TTntStringList;
{$else}
  TSynEdit = TEdit;
  TSynPanel = TPanel;
  TSynCheckBox = TCheckBox;
  TSynComboBox = TComboBox;
  TSynRadioButton = TRadioButton;
  TSynLabel = TLabel;
  TSynForm = TForm;

  TSynWideStrings = TStrings;
  TSynWideStringList = TStringList;
{$endif USETNTPACK}

  /// a generic Button to be used in the User Interface
  // - is always a Themed button: under Delphi 6, since TBitBtn is not themed,
  // it will be a row TButton with no glyph... never mind...
  TSynButton = class(TSynButtonParent)
  protected
{$ifndef USETMSPACK}
    fDropDownMenu: TSynPopupMenu;
{$endif}
  public
    /// create a standard button instance
    // - ModalResult/Default/Cancel properties will be set as exepcted for this
    // kind of button
    constructor CreateKind(Owner: TWinControl; Btn: TCommonButton;
      Left, Right, Width, Height: integer);
    /// set the glyph of the button
    // - set nothing under Delphi 6
    procedure SetBitmap(Bmp: TBitmap);
{$ifndef USETMSPACK}
    /// drop down the associated Popup Menu
    procedure DoDropDown;
    /// the associated Popup Menu to drop down
    property DropDownMenu: TSynPopupMenu read fDropDownMenu write fDropDownMenu;
{$endif}
  end;

/// return the text without the '&' characters within
function UnAmp(const s: SynWideString): SynWideString;

{$ifndef USETMSPACK}
var
{
  /// if set to TRUE, buttons will be bigger than default
  // - can be useful e.g. for touch screens
  // - will work only for the Delphi emulated version (aNonNative=true) of
  // TSynTask - could be combined with @TaskDialogIndirect := nil;
  TaskDialogBiggerButtons: boolean = false;
}
  /// a default Task Dialog wrapper instance
  // - can be used to display some information with less parameters
  DefaultTaskDialog: TTaskDialogEx = (
    (*
    CommonButtons: [];
    ButtonDef: 0;
    Flags: [];
    *)
    DialogIcon: tiInformation;
    FooterIcon: tfiWarning;
    (*
    RadioDef: 0;
    Width: 0;
    NonNative: false;
    EmulateClassicStyle: false;
    *)
    );
{$endif}

implementation

{$R SynTaskDialog.res}


const
  TD_BTNS: array[TCommonButton] of string = (
    SMsgDlgOK, SMsgDlgYes, SMsgDlgNo, SMsgDlgCancel, SMsgDlgRetry,
    SCloseButton);
  TD_BTNMOD: array[TCommonButton] of Integer = (
    mrOk, mrYes, mrNo, mrCancel, mrRetry, mrAbort);

{ TSynButton }

constructor TSynButton.CreateKind(Owner: TWinControl; Btn: TCommonButton;
  Left, Right, Width, Height: integer);
begin
  Create(Owner);
  Parent := Owner;
  SetBounds(Left,Right,Width,Height);
  Caption := TD_BTNS[Btn];
  ModalResult := TD_BTNMOD[Btn];
  case Btn of
    cbOK:     Default := true;
    cbCancel: Cancel := true;
  end;
  case Btn of
    cbOK: SetBitmap(BitmapOK);
  end;
end;

{$ifndef USETMSPACK}
procedure TSynButton.DoDropDown;
begin
  if DropDownMenu<>nil then
    with ClientToScreen(BoundsRect.TopLeft) do
      DropDownMenu.Popup(X,Y+Height);
end;
{$endif}

procedure TSynButton.SetBitmap(Bmp: TBitmap);
begin
  if Bmp<>nil then
    {$ifdef USETMSPACK}
    Picture.Assign(Bmp);
    {$else}
      {$ifdef WITHUXTHEME}
      Glyph := Bmp;
      {$else}
      // Delphi 6 TBitBtn has no theming -> use generic TButton without glyph
      {$endif}
    {$endif}
end;

function UnAmp(const s: SynWideString): SynWideString;
var i: integer;
begin
  result := s;
  repeat
    i := pos('&',result);
    if i=0 then
      exit;
    delete(result,i,1);
  until false;
end;


{$ifndef USETMSPACK}

const
  TD_ICONS: array[TTaskDialogIcon] of integer = (
    17, 84, 99, 98, 81, 0, 78);
  TD_ICONS_IDENT: array[TTaskDialogIcon] of string = (
    '', SMsgDlgWarning, SMsgDlgConfirm, SMsgDlgError, SMsgDlgInformation,
    '', SMsgDlgInformation);
  TD_FOOTERICONS: array[TTaskDialogFooterIcon] of integer = (
    17, 84, 99, 98, 65533, 65532);
  WIN_ICONS: array[TTaskDialogIcon] of PChar = (
    nil, IDI_WARNING, IDI_QUESTION, IDI_ERROR, IDI_INFORMATION, nil, IDI_WINLOGO);
  WIN_FOOTERICONS: array[TTaskDialogFooterIcon] of PChar = (
    nil, IDI_WARNING, IDI_QUESTION, IDI_ERROR, IDI_INFORMATION, IDI_WINLOGO);

procedure InitComCtl6;
var OSVersionInfo: TOSVersionInfo;
begin
  OSVersionInfo.dwOSVersionInfoSize := sizeof(OSVersionInfo);
  GetVersionEx(OSVersionInfo);
  if OSVersionInfo.dwMajorVersion<6 then
    @TaskDialogIndirect := nil else
    @TaskDialogIndirect := GetProcAddress(GetModuleHandle(comctl32),'TaskDialogIndirect');
end;

{ TTaskDialog }

type
  // see http://msdn.microsoft.com/en-us/library/bb787473(v=VS.85).aspx
  PTASKDIALOG_BUTTON = ^TTASKDIALOG_BUTTON;
  TTASKDIALOG_BUTTON = packed record
    nButtonID: integer;
    pszButtonText: PWideChar;
  end;

  TTASKDIALOGCONFIG = packed record
    cbSize: integer;
    hwndParent: HWND;
    hInstance: THandle;
    dwFlags: integer;
    dwCommonButtons: integer;
    pszWindowTitle: PWideChar;
    hMainIcon: integer;
    pszMainInstruction: PWideChar;
    pszContent: PWideChar;
    cButtons: integer;
    pButtons: PTASKDIALOG_BUTTON;
    nDefaultButton: integer;
    cRadioButtons: integer;
    pRadioButtons: PTASKDIALOG_BUTTON;
    nDefaultRadioButton: integer;
    pszVerificationText: PWideChar;
    pszExpandedInformation: PWideChar;
    pszExpandedControlText: PWideChar;
    pszCollapsedControlText: PWideChar;
    hFooterIcon: HICON;
    pszFooter: PWideChar;
    pfCallback: pointer;
    lpCallbackData: pointer;
    cxWidth: integer;
  end;


function TTaskDialog.Execute(aCommonButtons: TCommonButtons;
  aButtonDef: integer; aFlags: TTaskDialogFlags;
  aDialogIcon: TTaskDialogIcon; aFooterIcon: TTaskDialogFooterIcon;
  aRadioDef, aWidth: integer; aParent: HWND; aNonNative: boolean;
  aEmulateClassicStyle: boolean): integer;

function CR(const aText: SynWideString): SynWideString;
begin
  if pos('\n',aText)=0 then
    result := aText else
    result := SynWideStringReplace(aText,'\n',#10,[rfReplaceAll]);
end;
function GetNextStringLineToWS(var P: PSynWideChar): SynWideString;
var S: PSynWideChar;
begin
  if P=nil then
    result := '' else begin
    S := P;
    while S[0]>=' ' do
      inc(S);
    SetString(result,P,S-P);
    result := CR(result);
    while (S^<>#0) and (S^<' ') do inc(S); // ignore e.g. #13 or #10
    if S^<>#0 then
      P := S else
      P := nil;
  end;
end;
var aHint: SynWideString;
function NoCR(const aText: SynWideString): SynWideString;
var i: integer;
begin
  result := aText;
  aHint := '';
  i := pos('\n',result);
  if i>0 then begin
    aHint := CR(copy(result,i+2,maxInt));
    SetLength(result,i-1);
  end;
end;
function N(const aText: SynWideString): SynWideString;
begin
  if aText='' then
    result := '' else
    result := CR(aText);
end;
var RU: array of SynWideString;
    RUCount: integer;
    But: array of TTASKDIALOG_BUTTON;
procedure AddRU(Text: SynWideString; var n: integer; firstID: integer);
var P: PSynWideChar;
begin
  if Text='' then
    exit;
  Text := SysUtils.trim(Text);
  P := @Text[1]; // '\n' handling in GetNextStringLineToWS(P) will change P^
  while P<>nil do begin
    if length(RU)<=RUCount then begin
      SetLength(RU,RUCount+16);
      SetLength(But,RUCount+16);
    end;
    RU[RUCount] := GetNextStringLineToWS(P);
    with But[RUCount] do begin
      nButtonID := n+firstID;
      pszButtonText := pointer(RU[RUCount]);
    end;
    inc(n);
    inc(RUCount);
  end;
end;
var Config: TTASKDIALOGCONFIG;
    i, X, Y, XB, IconBorder, FontHeight: integer;
    Par: TWinControl;
    Panel: TSynPanel;
    CurrTabOrder: TTabOrder;
    Form: TSynForm;
    Image: TImage;
    Pic: TIcon;
    Bmp: TBitmap;
    Edit: TSynEdit;
    Combo: TSynComboBox;
    List: TSynWideStrings;
    B: TCommonButton;
    CommandLink: TSynButton;
    Rad: array of TSynRadioButton;
    Verif: TSynCheckBox;
function AddLabel(const Text: SynWideString; BigFont: boolean): TSynLabel;
begin
  result := TSynLabel.Create(Form);
  result.Parent := Par;
  result.WordWrap := true;
  if BigFont then begin
    if aEmulateClassicStyle then begin
      result.Font.Height := FontHeight-2;
      result.Font.Style := [fsBold]
    end else begin
      result.Font.Height := FontHeight-4;
      result.Font.Color := $B00000;
    end;
  end else
    result.Font.Height := FontHeight;
  result.Left := X;
  result.Top := Y;
  result.Width := aWidth-X-8;
  result.Caption := CR(Text);
  inc(Y,result.Height+16);
end;
procedure AddBevel;
var BX: integer;
begin
  with TBevel.Create(Form) do begin
    Parent := Par;
    if (Image<>nil) and (Y<Image.Top+Image.Height) then
      BX := X else
      BX := 2;
    SetBounds(BX,Y,aWidth-BX-2,2);
  end;
  inc(Y,16);
end;
function AddButton(s: SynWideString; ModalResult: integer): TSynButton;
var WB: integer;
begin
  s := UnAmp(s);
  WB := Form.Canvas.TextWidth(s)+52;
  dec(XB,WB);
  if XB<X shr 1 then begin
    XB := aWidth-WB;
    inc(Y,32);
  end;
  result := TSynButton.Create(Form);
  result.Parent := Par;
    if aEmulateClassicStyle then
      result.SetBounds(XB,Y,WB-10,22) else
      result.SetBounds(XB,Y,WB-12,28);
  result.Caption := s;
  result.ModalResult := ModalResult;
  result.TabOrder := CurrTabOrder;
  case ModalResult of
    mrOk: begin
      result.Default := true;
      if aCommonButtons=[cbOk] then
        result.Cancel := true;
    end;
    mrCancel: result.Cancel := true;
  end;
  if ModalResult=aButtonDef then
    Form.ActiveControl := result;
end;

begin
  if (byte(aCommonButtons)=0) and (Buttons='') then begin
    aCommonButtons := [cbOk];
    if aButtonDef=0 then
      aButtonDef := mrOk;
  end;
  if Title='' then
    if Application.MainForm=nil then
      Title := Application.Title else
      Title := Application.MainForm.Caption;
  if (Inst='') and (TD_ICONS_IDENT[aDialogIcon]<>'') then
    Inst := TD_ICONS_IDENT[aDialogIcon];
  if aParent=0 then
    aParent := Application.Handle;
  if Assigned(TaskDialogIndirect) and not aNonNative and
     not (tdfQuery in aFlags) and (Selection='') then begin
    // use Vista/Seven TaskDialog implementation (not tdfQuery nor Selection)
    FillChar(Config,sizeof(Config),0);
    Config.cbSize := sizeof(Config);
    Config.hwndParent := aParent;
    Config.pszWindowTitle := pointer(N(Title));
    Config.pszMainInstruction := pointer(N(Inst));
    Config.pszContent := pointer(N(Content));
    RUCount := 0;
    AddRU(Buttons,Config.cButtons,100);
    AddRU(Radios,Config.cRadioButtons,200);
    if Config.cButtons>0 then
      Config.pButtons := @But[0];
    if Config.cRadioButtons>0 then
      Config.pRadioButtons := @But[Config.cButtons];
    Config.pszVerificationText := pointer(N(Verify));
    Config.pszExpandedInformation := pointer(N(Info));
    Config.pszExpandedControlText := pointer(N(InfoExpanded));
    Config.pszCollapsedControlText := pointer(N(InfoCollapse));
    Config.pszFooter := pointer(N(Footer));
    Config.dwCommonButtons := byte(aCommonButtons);
    if (Verify<>'') and VerifyChecked then
      include(aFlags,tdfVerificationFlagChecked);
    if (Config.cButtons=0) and (aCommonButtons=[cbOk]) then
      Include(aFlags,tdfAllowDialogCancellation); // just OK -> Esc/Alt+F4 close
    Config.dwFlags := integer(aFlags);
    Config.hMainIcon := TD_ICONS[aDialogIcon];
    Config.hFooterIcon := TD_FOOTERICONS[aFooterIcon];
    Config.nDefaultButton := aButtonDef;
    Config.nDefaultRadioButton := aRadioDef;
    Config.cxWidth := aWidth;
    if TaskDialogIndirect(@Config,@result,@RadioRes,@VerifyChecked)<>S_OK then
      result := 0; // error (mostly invalid argument)
  end else begin
    // use our native (naive?) Delphi implementation
    Verif := nil;
    Combo := nil;
    Edit := nil;
    Form := TSynForm.Create(Application);
    try
      // initialize form properties
      Form.BorderStyle := bsDialog;
      Form.BorderIcons := [];
      Form.Position := poScreenCenter;
      if not aEmulateClassicStyle then
        Form.Font := DefaultFont;
      FontHeight := Form.Font.Height;
      if aWidth=0 then begin
        aWidth := Form.Canvas.TextWidth(Inst);
        if (aWidth>300) or (Form.Canvas.TextWidth(Content)>300) or
           (length(Buttons)>40) then
          aWidth := 480 else
          aWidth := 420;
      end;
      Form.ClientWidth := aWidth;
      Form.Height := 200;
      Form.Caption := Title;
      // create a white panel for the main dialog part
      Panel := TSynPanel.Create(Form);
      Panel.Parent := Form;
      Panel.Align := alTop;
      Panel.BorderStyle := bsNone;
      Panel.BevelOuter := bvNone;
      if not aEmulateClassicStyle then begin
        {$ifdef HASINLINE}
        Panel.BevelEdges := [beBottom];
        Panel.BevelKind := bkFlat;
        {$endif}
        Panel.Color := clWhite;
        {$ifdef WITHUXTHEME}
        Panel.ParentBackground := false; // clWhite not used otherwise
        {$endif}
      end;
      Par := Panel;
      // handle main dialog icon
      if aEmulateClassicStyle then
        IconBorder := 10 else
        IconBorder := 24;
       if WIN_ICONS[aDialogIcon]<>nil then begin
        Image := TImage.Create(Form);
        Image.Parent := Par;
        Image.Picture.Icon.Handle := LoadIcon(0,WIN_ICONS[aDialogIcon]);
        Image.SetBounds(IconBorder,IconBorder,Image.Picture.Icon.Width,Image.Picture.Icon.Height);
        X := Image.Width+IconBorder*2;
        Y := Image.Top;
        if aEmulateClassicStyle then
          inc(Y, 8);
      end else begin
        Image := nil;
        if not aEmulateClassicStyle then
          IconBorder := IconBorder*2;
        X := IconBorder;
        Y := IconBorder;
      end;
      // add main texts (Instruction, Content, Information)
      AddLabel(Inst,true);
      AddLabel(Content,false);
      if Info<>'' then
        // no information collapse/expand yet: it's always expanded
        AddLabel(Info,false);
      // add command links buttons
      if (tdfUseCommandLinks in aFlags) and (Buttons<>'') then
        with TSynWideStringList.Create do
        try
          inc(Y,8);
          Text := SysUtils.trim(Buttons);
          for i := 0 to Count-1 do begin
            CommandLink := TSynButton.Create(Form);
            with CommandLink do begin
              Parent := Par;
              Font.Height := FontHeight-3;
              if aEmulateClassicStyle then
                SetBounds(X,Y,aWidth-10-X,40) else
                SetBounds(X,Y,aWidth-16-X,40);
              Caption := NoCR(Strings[i]);
              if aHint<>'' then begin
                ShowHint := true;
                Hint := aHint; // note shown as Hint
              end;
              inc(Y,Height+2);
              ModalResult := i+100;
              if ModalResult=aButtonDef then
                Form.ActiveControl := CommandLink;
              if aEmulateClassicStyle then begin
                Font.Height := FontHeight - 2;
                Font.Style := [fsBold]
              end;
              {$ifdef WITHUXTHEME}
              if aEmulateClassicStyle then begin
                Margin := 7;
                Spacing := 7;
              end else begin
                Margin := 24;
                Spacing := 10;
              end;
              if not (tdfUseCommandLinksNoIcon in aFlags) then
                SetBitmap(BitmapArrow);
              {$endif}
            end;
          end;
          inc(Y,24);
        finally
          Free;
        end;
      // add radio buttons
      if Radios<>'' then
        with TSynWideStringList.Create do
        try
          Text := SysUtils.trim(Radios);
          SetLength(Rad,Count);
          for i := 0 to Count-1 do begin
            Rad[i] := TSynRadioButton.Create(Form);
            with Rad[i] do begin
              Parent := Par;
              SetBounds(X+16,Y,aWidth-32-X,6-FontHeight);
              Caption := NoCR(Strings[i]);
              if aHint<>'' then begin
                ShowHint := true;
                Hint := aHint; // note shown as Hint
              end;
              inc(Y,Height);
              if (i=0) or (i+200=aRadioDef) then
                Checked := true;
            end;
          end;
          inc(Y,24);
        finally
          Free;
        end;
      // add selection list or query editor
      if Selection<>'' then begin
        List := TSynWideStringList.Create;
        try
          Combo := TSynComboBox.Create(Form);
          Combo.Parent := Par;
          Combo.SetBounds(X,Y,aWidth-32-X,22);
          if tdfQuery in aFlags then
            Combo.Style := csDropDown else
            Combo.Style := csDropDownList;
          List.Text := trim(Selection);
          Combo.Items.Assign(List);
          Combo.ItemIndex := List.IndexOf(Query);
          inc(Y,42);
        finally
          List.Free;
        end;
      end else
        if tdfQuery in aFlags then begin
          Edit := TSynEdit.Create(Form);
          Edit.Parent := Par;
          Edit.SetBounds(X,Y,aWidth-16-X,22);
          Edit.Text := Query;
          if tdfQueryMasked in aFlags then
            Edit.PasswordChar := '*';
          inc(Y,42);
        end;
      // from now we won't add components to the white panel, but to the form
      Panel.Height := Y;
      Par := Form;
      // add buttons and verification checkbox
      if (byte(aCommonButtons)<>0) or (Verify<>'') or
         ((Buttons<>'') and not (tdfUseCommandLinks in aFlags)) then begin
        CurrTabOrder := Panel.TabOrder;
        inc(Y, 16);
        XB := aWidth;
        if not (tdfUseCommandLinks in aFlags) then
          with TSynWideStringList.Create do
          try
            Text := SysUtils.trim(Buttons);
            for i := Count-1 downto 0 do
              AddButton(Strings[i],i+100);
          finally
            Free;
          end;
        for B := high(B) downto low(B) do
          if B in aCommonButtons then
            AddButton(TD_BTNS[b], TD_BTNMOD[b]);
        if Verify<>'' then begin
          Verif := TSynCheckBox.Create(Form);
          with Verif do begin
            Parent := Par;
            if X+16+Form.Canvas.TextWidth(Verify)>XB then begin
              inc(Y,32);
              XB := aWidth;
            end;
            SetBounds(X,Y,XB-X,24);
            Caption := Verify;
            Checked := VerifyChecked;
          end;
        end;
        inc(Y,36);
      end else
        XB := 0;
      // add footer text with optional icon
      if Footer<>'' then begin
        if XB<>0 then
          AddBevel else
          inc(Y,16);
        if WIN_FOOTERICONS[aFooterIcon]<>nil then begin
          Image := TImage.Create(Form);
          Image.Parent := Par;
          Pic := TIcon.Create;
          Bmp := TBitmap.Create;
          try
            Pic.Handle := LoadIcon(0,WIN_FOOTERICONS[aFooterIcon]);
            Bmp.Transparent := true;
            Bmp.Canvas.Brush.Color := Form.Color;
            Bmp.Width := Pic.Width shr 1;
            Bmp.Height := Pic.Height shr 1;
            DrawIconEx(Bmp.Canvas.Handle,0,0,Pic.Handle,Bmp.Width,Bmp.Height,0,
              Bmp.Canvas.Brush.Handle,DI_NORMAL);
            Image.Picture.Bitmap := Bmp;
            Image.SetBounds(24,Y,Bmp.Width,Bmp.Height);
            X := 40+Bmp.Width;
          finally
            Bmp.Free;
            Pic.Free;
          end;
        end else
          X := 24;
        AddLabel(Footer,false);
      end;
      // display the form
      Form.ClientHeight := Y;
      // retrieve the results
      result := Form.ShowModal;
      if Combo<>nil then begin
        SelectionRes := Combo.ItemIndex;
        Query := Combo.Text;
      end else
      if Edit<>nil then
        Query := Edit.Text;
      if Verif<>nil then
        VerifyChecked := Verif.Checked;
      RadioRes := 0;
      for i := 0 to high(Rad) do
        if Rad[i].Checked then
          RadioRes := i+200;
    finally
      Form.Free;
    end;
  end;
end;


{ TTaskDialogEx }

function TTaskDialogEx.Execute(aParent: HWND): integer;
begin
  Result := Base.Execute(CommonButtons, ButtonDef, Flags, DialogIcon, FooterIcon,
    RadioDef, Width, aParent, NonNative, EmulateClassicStyle);
end;

{$endif USETMSPACK}


initialization
  DefaultFont := TFont.Create;
  DefaultFont.Style := [];
  if Screen.Fonts.IndexOf('Calibri')>=0 then begin
    DefaultFont.Height := -14;
    DefaultFont.Name := 'Calibri';
  end else begin
    if Screen.Fonts.IndexOf('Tahoma')>=0 then
      DefaultFont.Name := 'Tahoma' else
      DefaultFont.Name := 'Arial';
    DefaultFont.Height := -13;
  end;
  {$ifndef USETMSPACK}
  InitComCtl6;
  assert(ord(tdfCanBeMinimized)=15);
  {$endif USETMSPACK}
  BitmapOK := TBitmap.Create;
  BitmapOK.LoadFromResourceName(HInstance,'btnOk'); // SQLite3btnok.bmp
  BitmapOK.Transparent := true;
  BitmapArrow := TBitmap.Create;
  BitmapArrow.LoadFromResourceName(HInstance,'btnArrow'); // SQLite3btnArrow.bmp
  BitmapArrow.Transparent := true;

finalization
  DefaultFont.Free;
  BitmapArrow.Free;
  BitmapOK.Free;

end.

SynWideSupp.pas:

unit SynWideSupp;

interface

uses SysUtils
  {$IFNDEF UNICODE}, WideStrUtils{$ENDIF}
;

type
  {$IFDEF UNICODE}
    SynWideString = String;
    PSynWideChar = PChar;
  {$ELSE}
    SynWideString = WideString;
    PSynWideChar = PWideChar;
  {$ENDIF}

function SynWideStringReplace(const S, OldPattern, NewPattern: SynWideString;
  Flags: TReplaceFlags): SynWideString; inline;

implementation

function SynWideStringReplace(const S, OldPattern, NewPattern: SynWideString;
  Flags: TReplaceFlags): SynWideString;
begin
  {$IFDEF UNICODE}
  Result := StringReplace(S, OldPattern, NewPattern, Flags);
  {$ELSE}
  Result := WideStringReplace(S, OldPattern, NewPattern, Flags);
  {$ENDIF}
end;

end.

ab · 2012-02-26 19:51:36

I'll take a look, and include the modifications to the trunk.
Since TNT components are very commonly used, optionaly supporting them is a good idea.

Thanks a lot for the feedback!

reddwarf · 2012-03-26 22:14:39

I'd have another suggestion according to SynTaskDialog. Your solution is not very good if task dialog is shown in modal windows - it can be hidden behind the modal window, unless you use aParent and run Win7. I'd change the aParent parameter in Execute() to TControl (aParent: TControl=nil;) and then change this code

  if aParent=0 then
    aParent := Application.Handle;

to

var xParentForm: TCustomForm;
begin

[ ... ]

  if not Assigned(aParent) then
    xParentForm := Screen.ActiveCustomForm
  else if (aParent is TCustomForm) then
    xParentForm := TCustomForm(aParent)
  else
    xParentForm := GetParentForm(aParent);

I use TControl because then aParent can easily be used as Self even from TFrame or custom components etc. GetParentForm() does the job automatically.

Then you change

Config.hwndParent := aParent;

to

Config.hwndParent := xParentForm.Handle;

and

result := Form.ShowModal;

to

Form.PopupParent := xParentForm;
Form.PopupMode := pmExplicit;
result := Form.ShowModal;

These changes become obvious if you run this code - your task dialog will hide behind a modal window and you can click the button even twice:

procedure TForm1.ShowTaskDialog(Sender: TObject);
var Task: SynTaskDialog.TTaskDialog;
begin
  Task.Inst := 'Saving application settings';
  Task.Content := 'This is the content';
  Task.Radios := 'Store settings in registry'#10'Store settings in XML file';
  Task.Verify := 'Do no ask for this setting next time';
  Task.VerifyChecked := true;
  Task.Footer := 'XML file is perhaps a better choice';
  Task.Execute([],0,[],tiQuestion,tfiInformation,200);
end;

procedure TForm1.BtnShowParentModalClick(Sender: TObject);
var xMF: TForm;
  xBtn: TButton;
begin
  xMF := TForm.CreateNew(TControl(Sender));
  try
    xMF.Left := Self.Left;
    xMF.Top := Self.Top;
    xMF.Width := 1000;
    xMF.Height := 500;
    //xMF.WindowState := wsMaximized;

    xBtn := TButton.Create(xMF);
    xBtn.Parent := xMF;
    xBtn.Caption := 'Show Task Dialog';
    xBtn.Width := 200;
    xBtn.OnClick := ShowTaskDialog;

    xMF.PopupParent := Self;
    xMF.PopupMode := pmExplicit;
    xMF.ShowModal;

  finally
    xMF.Free;
  end;
end;

Some parts of code (PopupParent := ...; PopupMode := ...;) may have to be excluded with conditions for older delphi versions.

Of course you can use the old aParent parameter, but if the dialog must be emulated, setting the PopupParent and PopupMode is very useful. The TControl parameter is also much more comfortable in my opinion.

+ btw I started using your logging system. It's great code and great help for me! Thanks!

ab · 2012-03-27 11:56:40

Thanks for the ideas.

I'm trying this less complete but more compatible approach:
http://synopse.info/fossil/info/afea7fd1d6

Your code may definitively be preferred.

ab · 2012-05-09 06:35:13

Seems to be still an issue with packages and Delphi 2006.

See http://stackoverflow.com/questions/10510428

I've made another fix about compiler error when using the unit with runtime packages enabled (known compiler issue about string resources, referenced as E2201).
See http://synopse.info/fossil/info/90b1a2a4b3

Astaroth · 2012-11-03 16:21:51

Hi Bouchez and other Synopse developers.

As the documentation of TTaskDialog.Execute() method said,

"It returns 0 on error, or the Button ID, or 100 for the first custom button defined in Buttons string."

My problem is that when TTaskDialog.Execute() returns 0, it seems there is no way to know what is the OS error code for the error because the the error code returned by TaskDialogIndirect() has been eaten by this code:

if TaskDialogIndirect(@Config,@result,@RadioRes,@VerifyChecked)<>S_OK then
      result := 0;

Since the return value of TaskDialogIndirect() is already an error code of type HRESULT, I guess I cannot use GetLastError() to get extended error information. Am I right? If yes, would you change a bit the implementation of TTaskDialog.Execute() somehow to make getting the last OS error code becomes possible? For example:

hResult_ := TaskDialogIndirect(@Config,@result,@RadioRes,@VerifyChecked);
if hResult_<>S_OK then begin
  result := 0;
  SetLastError(hResult);
end;

Thanks in advance.

bilm · 2013-01-24 21:58:58

The Synopse TaskDialog works great in the main thread but
when I call it in a secondary thread I get an invalid operation error:
"Canvas does not allow drawing."
The Consts unit shows this as "SNoCanvasHandle".

I declare
Task: TTaskDialog;
as a var in the interface of the main thread/main form then
in the secondary thread I have:
Task.Title := 'My title';
Task.Inst := 'Main Subject';
Task.Content := 'Detailed information.';
Task.Execute([cbOK], mrOk, [], tiInformation, tfiInformation, 0, 0, Handle, False, False);

The handle parameter should be the thread handle, right?

I have also tried declaring ThTask: TTaskDialog; as a var in the
secondary thread with but with the same result.

Strangley it works fine when executed inside the Delph IDE (D7).

Do I need to make a thread message handler and use Send/Postmessage?
How would I use their params to call it that way?

I hope there is a solution to this because I want to use
SynTaskDialog compared to the others available but
I need one that can run from a thread.

Thanks for any help.

bilm

uligerhardt · 2013-01-28 09:23:47

bilm wrote:

The Synopse TaskDialog works great in the main thread but
when I call it in a secondary thread I get an invalid operation error:
"Canvas does not allow drawing."

I guess that's when you show an emulated task dialog? E.g on a XP system?
That probably won't work because the emulation is a VCL dialog and the VCL is not threadsafe.

bilm wrote:

The handle parameter should be the thread handle, right?

No. Have a look at the declaration - its type is HWND. It specifies the parent window of the task dialog.

bilm · 2013-01-29 22:43:24

Yes I should have said. The error only occurs in Win XP emulation mode.
I understand now emulation mode is not thread safe. Thanks.

I've implemented a thread message handler. I also made a record with a
pointer for all the params of the Task.Execute function and then a
var for the record pointer.

For each occurance in the thread I fill in the Task fields and also the
Task.Execute params using the record pointer var which I send via the PostMessage()
Lparam and dereference in the message handler for the Task.Execute call.

It all works great but I'm just an amateur hobbyist, maybe intermediate level at best.
If you or another more expert programmer has a better way to do this I'd appreciate you sharing it.

>> It specifies the parent window of the task dialog.
I'm still curious about the handle thing. Could you assign
it the handle of the invisible window of a thread?

bilm

uligerhardt · 2013-01-30 07:09:00

bilm wrote:

I've implemented a thread message handler. I also made a record with a
pointer for all the params of the Task.Execute function and then a
var for the record pointer.
For each occurance in the thread I fill in the Task fields and also the
Task.Execute params using the record pointer var which I send via the PostMessage()
Lparam and dereference in the message handler for the Task.Execute call.
It all works great but I'm just an amateur hobbyist, maybe intermediate level at best.
If you or another more expert programmer has a better way to do this I'd appreciate you sharing it.

I'm no experts in threads, too, but this sounds good to me.

bilm wrote:

>> It specifies the parent window of the task dialog.
I'm still curious about the handle thing. Could you assign
it the handle of the invisible window of a thread?

IIUC you show the task dialog in the context of the main thread, so the parent window probably should be from the main thread too.
Isn't there some kind of "active" window - maybe the one the user used to start the thread?

ab · 2013-01-30 10:10:41

AFAIK there is no such "invisible window of a thread".
What you get is a thread ID and a thread handle, which has nothing in common with HWND GDI handle, as expected by the Handle parameter.

For multithreading, in your case, I guess:
- just use a pointer to the global Task instance;
- you should better protect the access to this pointer with a critical section, from all threads;
- the main thread should better make a copy to the modified shared Task instance, before calling the execute method.

Perhaps, I would rather use a dedicated GDI message instead of such a global structure.
Search WM_USER message process in Delphi, in the Internet.

bilm · 2013-01-31 20:18:30

uligerhardt and Administrator thanks for your replies.

This is some sample code of the implementation I made and tried
to describe (not very well) in my last post.

interface

uses ..., SynTaskDialog;
 
const 
  TH_MESSAGE = WM_USER + 10; 
  // for wparams in thread message handler
  TH_WCDTD = 1;
  TH_PROGBAR = 2;
  TH_LABEL1 = 3;
  TH_LABEL2 = 4;
  // etc.
  
type
  PTTDexe = ^TTDexe;
  TTDexe = record
    CommonButtons: TCommonButton;
    ButtonDef: Integer;
    Flags: TTaskDialogFlag;
    DialogIcon: TTaskDialogIcon;
    FooterIcon: TTaskDialogFooterIcon;
    RadioDef,
    Width: Integer;
    ParentHandle: HWND;
    NonNative,
    EmulateClassicStyle: Boolean;
  end;

TMainForm = class(TForm)
// ...
private
  procedure ThreadMessage(var Message: TMessage); message TH_MESSAGE;

var
  Form1: TForm1;
  // more vars ...
  TDparams: PTTDexe; // pointer for Taskdialog parameters record 

implementation

procedure TForm1.ThreadMessage(var Message: TMessage);
begin
  case Message.WParam of
    TH_WCDTD:    
    begin  // In my threads the other params never change.
      Task.Execute([TDparams^.CommonButtons], TDparams^.ButtonDef, [], TDparams^.DialogIcon, TDparams^.FooterIcon, 0, 0, 0, False, False);
      Dispose(TDparams); // release allocated memory
    end; 
    // other WParam constants for progressbar.stepit/.update, label.update, etc.
    // instead of using Synchronize(). 
  end;
end;

//=== within a thread ===//
// I do the following for each instance of SynTaskDialog:
// initialize fields
 Task.Title := 'Title';
 Task.Inst := 'General Topic';
 Task.Content := 'Details';
 Task.Footer := 'Additional Info';

// initialize taskdialog.execute() params
// allocate memory, reference TDparams & assign values
 New(TDparams); 
 TDparams^.CommonButtons := cbOK; 
 TDparams^.ButtonDef := mrOk; 
 TDparams^.DialogIcon := tiWarning;
 TDparams^.FooterIcon := tfiWarning;

// call taskdialog.execute() based on OS version
if IsWinXP then
   PostMessage(Form1.Handle, TH_MESSAGE, TH_WCDTD, Integer(TDparams)) 
else if IsVistaOrHigher then
   Task.Execute([cbOK], mrOk, [], tiWarning, tfiWarning, 0, 0, 0, False, False);
//=======================//

I don't like threads. I only use them when absolutely necessary.
I use several secondary threads but only one runs at a time.

Re: "invisible window"
Sorry about using that term to describe what I meant.
What I mean is adding a handle of type HWND to the thread declaration
then assigning it using AllocateHWnd() in thread execute. I was wondering
if the the HWND could then be used as the handle parameter in task.execute().

ab · 2013-02-01 08:54:03

Your code is not threadsafe, since TDparams is global.
Use a parameter within the message.

And "if IsVistaOrHigher then" will leak memory, since TDParams won't be released, I suppose.

I would not use perhaps a pointer to a record, but a shared record, with a "Pending: boolean" flag, protected by a critical section.
Then use postmessage, just as you did.

bilm · 2013-02-02 19:09:20

-------- revised code ------
ab, thanks for your advice & instruction

I no longer declare TDparams: PTTDexe as a global var in mainform/interface.

// it is declared in the thread ... 
procedure thread.execute;
var TDparams: PTTDexe;
    // ...
begin
  // ...
  
  Task.Title := 'Title';
  Task.Inst := 'General Topic';
  Task.Content := 'Details';
  Task.Footer := 'Additional Info';

  if IsWinXP then
  begin   
    New(TDparams);
    try 
      TDparams^.CommonButtons := cbOK;
      TDparams^.ButtonDef := mrOk;
      TDparams^.DialogIcon := tiInformation;
      TDparams^.FooterIcon := tfiInformation;
      PostMessage(Form1.Handle, WCDMESSAGE, TH_WCDTD, Integer(TDparams));
    except
      Dispose(TDparams);
    end;
  end // end emulation mode for XP
  else if IsVistaOrHigher then
    Task.Execute([cbOK], mrOk, [], tiInformation, tfiInformation, 0, 0, 0, False, False);

  // ...

end; // end thread

// ... and is declared in the message handler (mainform)
procedure TForm1.ThreadMessage(var Message: TMessage);
var TDparams: PTTDexe;
begin
  case Message.WParam of
    TH_WCDTD:    
    begin 
      if Message.LParam > 0 then
      begin 
        TDparams := PTTDexe(Message.LParam);
        Task.Execute([TDparams^.CommonButtons], TDparams^.ButtonDef, [], TDparams^.DialogIcon,      
                     TDparams^.FooterIcon, 0, 0, 0, False, False);
        Dispose(TDparams);
      end;    
    end; 

    // ... more WParams  
  
  end; // end case
end; // end message handler
------------------------------------

I don't understand what a "shared record" is. Could you give an example or
reference a synpose project unit where it occurs?

mORMot Open Source

#1 2011-03-05 08:31:54

Open Source SynTaskDialog unit for XP,Vista,Seven

#2 2011-03-06 01:59:37

Re: Open Source SynTaskDialog unit for XP,Vista,Seven

#3 2011-03-08 09:36:38

Re: Open Source SynTaskDialog unit for XP,Vista,Seven

#4 2011-03-08 16:52:18

Re: Open Source SynTaskDialog unit for XP,Vista,Seven

#5 2011-03-08 19:50:36

Re: Open Source SynTaskDialog unit for XP,Vista,Seven

#6 2011-03-08 19:55:20

Re: Open Source SynTaskDialog unit for XP,Vista,Seven

#7 2011-03-25 09:09:42

Re: Open Source SynTaskDialog unit for XP,Vista,Seven

#8 2011-03-25 10:49:12

Re: Open Source SynTaskDialog unit for XP,Vista,Seven

#9 2011-03-26 06:49:03

Re: Open Source SynTaskDialog unit for XP,Vista,Seven

#10 2011-03-26 08:46:36

Re: Open Source SynTaskDialog unit for XP,Vista,Seven

#11 2011-03-26 11:47:19

Re: Open Source SynTaskDialog unit for XP,Vista,Seven

#12 2011-10-12 12:18:02

Re: Open Source SynTaskDialog unit for XP,Vista,Seven

#13 2011-10-12 13:14:03

Re: Open Source SynTaskDialog unit for XP,Vista,Seven

#14 2011-10-12 14:41:10

Re: Open Source SynTaskDialog unit for XP,Vista,Seven

#15 2011-10-12 15:36:44

Re: Open Source SynTaskDialog unit for XP,Vista,Seven

#16 2011-10-12 16:44:07

Re: Open Source SynTaskDialog unit for XP,Vista,Seven

#17 2011-10-12 20:40:21

Re: Open Source SynTaskDialog unit for XP,Vista,Seven

#18 2011-10-13 12:00:12

Re: Open Source SynTaskDialog unit for XP,Vista,Seven

#19 2011-10-13 13:43:12

Re: Open Source SynTaskDialog unit for XP,Vista,Seven

#20 2011-10-14 11:51:00

Re: Open Source SynTaskDialog unit for XP,Vista,Seven

#21 2011-10-20 08:36:05

Re: Open Source SynTaskDialog unit for XP,Vista,Seven

#22 2011-10-21 19:02:53

Re: Open Source SynTaskDialog unit for XP,Vista,Seven

#23 2011-10-24 19:08:26

Re: Open Source SynTaskDialog unit for XP,Vista,Seven

#24 2011-10-25 12:29:22

Re: Open Source SynTaskDialog unit for XP,Vista,Seven

#25 2011-10-25 13:48:17

Re: Open Source SynTaskDialog unit for XP,Vista,Seven

#26 2011-10-25 13:51:53

Re: Open Source SynTaskDialog unit for XP,Vista,Seven

#27 2011-10-25 14:18:43

Re: Open Source SynTaskDialog unit for XP,Vista,Seven

#28 2011-10-25 14:52:07

Re: Open Source SynTaskDialog unit for XP,Vista,Seven

#29 2011-10-25 14:58:43

Re: Open Source SynTaskDialog unit for XP,Vista,Seven

#30 2011-10-25 16:04:43

Re: Open Source SynTaskDialog unit for XP,Vista,Seven

#31 2011-10-26 06:54:30

Re: Open Source SynTaskDialog unit for XP,Vista,Seven

#32 2011-10-27 08:54:45

Re: Open Source SynTaskDialog unit for XP,Vista,Seven

#33 2011-10-27 09:26:53

Re: Open Source SynTaskDialog unit for XP,Vista,Seven

#34 2011-10-29 15:41:54

Re: Open Source SynTaskDialog unit for XP,Vista,Seven

#35 2011-10-29 18:14:57

Re: Open Source SynTaskDialog unit for XP,Vista,Seven

#36 2011-10-31 10:32:13

Re: Open Source SynTaskDialog unit for XP,Vista,Seven

#37 2012-02-26 12:42:45

Re: Open Source SynTaskDialog unit for XP,Vista,Seven

#38 2012-02-26 19:51:36

Re: Open Source SynTaskDialog unit for XP,Vista,Seven

#39 2012-03-26 22:14:39

Re: Open Source SynTaskDialog unit for XP,Vista,Seven

#40 2012-03-27 11:56:40