mORMot Open Source

FWIW: I added support for TDN_DIALOG_CONSTRUCTED and disabling buttons to my copy of SynTaskDialog. (Besides my previous changes enabling a TComponent wrapper for it.)

No problem here, too! :-)

I tried it with VCL's TTaskDialog before my first post and it worked as I wanted.

Looking through SynTaskDialog.pas, I see that it would be a bit tough to add it in it's current state - the contents of TTaskDialog.Buttons would have to evolve into a mini-DSL :-)
I had the idea of internally storing an array of TTASKDIALOG_BUTTON instead of a string (for both emulated and native mode) and then make TTaskDialog.Buttons a read/write property. What do you think?

Thanks for clarifying, Arnaud!

Thanks for adding it! I'm already using it. :-)

AFAIK Arnaud prefers using records and old-style objects to classes for saving CPU cycles ;-) So I'm quite sure he didn't try using interfaces with their associated overhead.

Hello Arnauld and reddwarf!

FWIW: I just gave this version of the unit a quick test in my VCL app and had one compiler error, probably because I always compile with TYPEDADDRESS ON. The call to TaskDialogIndirect in line 930 yields an error "E2010 Inkompatible Typen: 'PBOOL' und 'Pointer'". I fixed this by introducing a local variable "bVerifyChecked: BOOL" and call TaskDialogIndirect like this:

    bVerifyChecked := VerifyChecked;
    if TaskDialogIndirect(@Config,@result,@RadioRes,@bVerifyChecked)=S_OK then
    begin
      VerifyChecked := bVerifyChecked;
      exit; // error (mostly invalid argument) -> execute the VCL emulation
    end;

After that, I didn't notice any errors.

Cool. I'm gonna make use of that as soon as time permits. :-)

It's just a habit for me to avoid the usage of global variables as far as possible,
and especially so when dealing with threads.

That's a matter of taste here. The first variant changes only one flag
in the set while the second one initializes the whole set. Which one is "better"
than the other depends on the circumstances.

AFAIK pd^ is zero-filled after executing New(pd), so

pd^ := DefaultTaskDialog

should do the same as

pd^.DialogIcon := tiInformation;
pd^.FooterIcon:= tfiWarning;

(or similar, depending on your DefaultTaskDialog). You could experiment with this by commenting out one line and see when it breaks.

Edit: Just checked it - New does not zero-initialize, so pd^ contains garbage, e.g. stuff like a negative Width which isn't good. You don't have to assign DefaultTaskDialog, but you have to make sure all fields of pd^ have sensible values.

Hi bilm,

I just threw together a mini test program - start a new VCL app, drop a button on Form1 and replace the unit source code with this:

unit MainF;

interface

uses
  Windows,
  Messages,
  SysUtils,
  Variants,
  Classes,
  Graphics,
  Controls,
  Forms,
  Dialogs,
  MyThread,
  StdCtrls;

const
  TH_MESSAGE = WM_USER + 5;

type
  TMyThread = class(TThread)
  private
    FHandle: HWND;
  protected
    procedure Execute; override;
  public
    constructor Create(AHandle: HWND);
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    procedure ThreadMessage(var Message: TMessage); message TH_MESSAGE;
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses
  SynTaskDialog;

{ TMyThread }

constructor TMyThread.Create(AHandle: HWND);
begin
  inherited Create(False);
  FreeOnTerminate := True;
  FHandle := AHandle;
end;

procedure TMyThread.Execute;
var
  pd: ^TTaskDialogEx;
begin
  New(pd);
  try
    pd^ := DefaultTaskDialog;
    pd^.Base.Title := 'Title';
    pd^.Base.Inst := 'Instruction';
    pd^.Base.Buttons := 'AAAAAAAAAA' + sLineBreak + 'BBBBBBBBBBBB';
    pd^.CommonButtons := [cbCancel];
    pd^.ButtonDef := 100;
    pd^.Flags := [tdfUseCommandLinks];
    pd^.DialogIcon := tiQuestion;
    pd^.NonNative := True;
    pd^.EmulateClassicStyle := True;
    PostMessage(FHandle, TH_MESSAGE, 0, LPARAM(pd));
  except
    Dispose(pd);
  end;
end;

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
var
  t: TMyThread;
begin
  t := TMyThread.Create(Handle);
end;

procedure TForm1.ThreadMessage(var Message: TMessage);
var
  pd: ^TTaskDialogEx;
begin
  pd := Pointer(Message.LParam);
  try
    pd^.Execute(Handle);
  finally
    Dispose(pd);
  end;
end;

end.

Clicking the button starts a thread which shows a task dialog. Does this work for you?

Hi Arnaud,

once more about the TBitBtn/TButton issue from long ago. Please have a look at this picture:

and note the different baselines of the "Abbrechen" buttons. The left one is from an app compiled with the latest SynTaskDialog.pas (http://synopse.info/fossil/artifact/d45 … 47564d4bbb), the right one is with my changes - two lines added:

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

  TSynButtonParent = TAdvGlowButton;
  TSynTaskDialogButton = TAdvGlowButton; // <== added
{$else}
  /// a generic VCL popup menu
  TSynPopupMenu = TPopupMenu;

  TSynButtonParent = {$ifdef WITHUXTHEME}TBitBtn{$else}TButton{$endif};
  TSynTaskDialogButton = TButton; // <== added
{$endif USETMSPACK}

and two lines changed:

function AddButton(s: string; ModalResult: integer): TSynTaskDialogButton; // <== changed
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 := TSynTaskDialogButton.Create(Form); // <== changed

I think the changed version looks much better. It also incurs a tiny bit less runtime overhead - just a plain TButton instead of a TBitBtn. ;-) If you agree feel free to adapt my changes.

Best regards,
Uli

One simplification you still could make in your code is to make TDparams a pointer to TTaskDialogEx and drop your own TTaskDlg record. Then the only additional parameter needed for calling Execute would be the ParentHandle. And I guess that's the same handle you're posting your message to, so

procedure TForm1.ThreadMessage(var Message: TMessage);
var
  TDparams: ^TTaskDialogEx;    
  // ...
begin
  case Message.WParam of
    TH_SYNTD:
    begin 
      TDparams := Pointer(Message.LParam); 
      try
       TDparams^.Execute(Handle); // <== Self.Handle, i.e. the message receiver
      finally
       Dispose(TDparams); 
      end;         
    end;

    TH_LABEL: // ...

    TH_PROGBAR: // ...
   
    // ... others
  end;
end;

would probably suffice.

I don't think handling the message passing generically in the SynTaskDialog unit is feasible. Which value to use for the message that doesn't collide with application defined messages? Where shall the message be posted to? How should the message handler be implemented? I don't think that making TTaskDialog a class would change much in this respect. You have to pass around a pointer - it's irrelevant whether this pointer points to a record or is a reference to a class instance.

@ab: How about

[delphi]...[/delphi]

BBCode tags? :-)

No problem. Both pointers point to the same record (as there is only one New). So you need only one Dispose, too. After the call to Dispose both pointers point to garbage and shouldn't be used anymore, of course.

Hello bilm,

I just tend to avoid global variables as much as possible. So I would probably expand the TTDexe record to encompass also Title, Inst, Content, Footer etc. and copy those values to a local TTaskDialog variable inside ThreadMessage:

procedure TMainForm.ThreadMessage(var Message: TMessage);
var
  TDparams: PTTDexe; // pointer for Taskdialog parameters record
  Task: TTaskDialog;
begin
  case Message.WParam of
    TH_WCDTD:
    begin  // In my threads the other params never change.
      TDparams := Pointer(Message.LParam);
      Task.Title := TDparams^.Title;
      // ...
      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;

This seems cleaner to me  - the local variable "lives" only while the dialog is shown, whereas a global variable lingers around unused most of the time. And I think you could omit the critical sections.

Best regards,
Uli

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

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?

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.

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

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?

I guessed so. :-)

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

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.

1. 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.)

2. 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).

3. BitmapOK (and its accompanying res entry) weren't used, so I removed them.

4. Removed the shadow in the arrow bitmap (see http://synopse.info/forum/viewtopic.php?pid=2785#p2785).

5. 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.

6. The DropDown stuff in TSynButton wasn't used, so I commented it out.

7. Fixed the E2201 error by using an array of strings (see http://synopse.info/forum/viewtopic.php?pid=2850#p2850).

8. By overloading TTaskDialogForm.Create (calling CreateNew) some ugly casting could be removed.

9. Used ActiveControl instead of the Tag/FormShow trick.

10. Fixed the TabOrder issue (see http://synopse.info/forum/viewtopic.php?pid=2778#p2778).

Uli

Once more a PITA. :-)

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.

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. )

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

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.