lcl: redo QuestionDialog buttons usage, move buttons to outer class for use in widgetsets

win32: implement QuestionDialog for Vista+ systems

git-svn-id: trunk@28448 -

lcl/include/intfbaselcl.inc

@@ -49,11 +49,11 @@ begin
   Result := 0;
 end;
 
-function TWidgetSet.AskUser(const aCaption, aMsg: string;
+function TWidgetSet.AskUser(const DialogCaption, DialogMessage: string;
-    DlgType: LongInt; Buttons: array of const; HelpCtx: Longint): LongInt;
+    DialogType: LongInt; Buttons: TDialogButtons; HelpCtx: Longint): LongInt;
 begin
   if QuestionDialogFunction <> nil then
-    Result := QuestionDialogFunction(aCaption, aMsg, DlgType, Buttons, HelpCtx)
+    Result := QuestionDialogFunction(DialogCaption, DialogMessage, DialogType, Buttons, HelpCtx)
   else
     Result := 0;
 end;

lcl/include/lclintf.inc

@@ -1,4 +1,4 @@
-{%MainUnit ../lclintf.pp}
+{%MainUnit ../lclintf.pas}
 { $Id$
 ******************************************************************************
   All interface communication related stuff goes here.
@@ -56,9 +56,9 @@ begin
   Result := WidgetSet.AllocateHWnd(Method);
 end;
 
-function AskUser(const aCaption, aMsg: string; DlgType: LongInt; Buttons: array of const; HelpCtx: Longint): LongInt;
+function AskUser(const DialogCaption, DialogMessage: string; DialogType: LongInt; Buttons: TDialogButtons; HelpCtx: Longint): LongInt;
 begin
-  Result := WidgetSet.AskUser(aCaption, aMsg, DlgType, Buttons, HelpCtx);
+  Result := WidgetSet.AskUser(DialogCaption, DialogMessage, DialogType, Buttons, HelpCtx);
 end;
 
 procedure CallDefaultWndHandler(Sender: TObject; var Message);

lcl/include/lclintfh.inc

@@ -41,7 +41,7 @@ function AddEventHandler(AHandle: THandle; AFlags: dword; AEventHandler: TWaitHa
 function AddProcessEventHandler(AHandle: THandle; AEventHandler: TChildExitEvent; AData: PtrInt): PProcessEventHandler; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
 function AddPipeEventHandler(AHandle: THandle; AEventHandler: TPipeEvent; AData: PtrInt): PPipeEventHandler; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
 function AllocateHWnd(Method: TLCLWndMethod): HWND; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
-function AskUser(const aCaption, aMsg: string; DlgType: LongInt; Buttons: array of const; HelpCtx: Longint): LongInt; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
+function AskUser(const DialogCaption, DialogMessage: string; DialogType: LongInt; Buttons: TDialogButtons; HelpCtx: Longint): LongInt; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
 
 procedure CallDefaultWndHandler(Sender: TObject; var Message); {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
 function ClipboardFormatToMimeType(FormatID: TClipboardFormat): string; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}

lcl/include/promptdialog.inc

@@ -531,12 +531,11 @@ type
     TextStyle : TTextStyle;
     MessageTxt: String;
     constructor CreateQuestionDlg(const aCaption, aMsg: string;
-      DlgType: LongInt; Buttons: array of const; HelpCtx: Longint);
+      DlgType: LongInt; Buttons: TDialogButtons; HelpCtx: Longint);
     destructor Destroy; override;
     procedure Paint; override;
     procedure LayoutDialog;
     function ShowModal: TModalResult; override;
-    function FindButton(Order: array of TModalResult): TBitBtn;
   end;
 
 { TQuestionDlg }
@@ -676,43 +675,14 @@ begin
   Result := inherited ShowModal;
 end;
 
-function TQuestionDlg.FindButton(Order: array of TModalResult): TBitBtn;
-var
-  i: Integer;
-  CurValue: TModalResult;
-  j: Integer;
-begin
-  if FButtons = nil then
-  begin
-    Result := nil;
-    Exit;
-  end;
-  for i := Low(Order) to High(Order) do
-  begin
-    CurValue := Order[i];
-    for j := 0 to FButtons.Count - 1 do
-    begin
-      Result := TBitBtn(FButtons[j]);
-      if Result.ModalResult = CurValue then
-        Exit;
-    end;
-  end;
-  Result := nil;
-end;
-
 constructor TQuestionDlg.CreateQuestionDlg(const aCaption, aMsg: string;
-  DlgType: LongInt; Buttons: array of const; HelpCtx: Longint);
+  DlgType: LongInt; Buttons: TDialogButtons; HelpCtx: Longint);
 var
-  i: Integer;
+  i: integer;
-  CurBtnValue: TModalResult;
+  CurBtn: TDialogButton;
-  CurBtnCaption, CurOptions: String;
   NewButton: TBitBtn;
   NewKind: TBitBtnKind;
   NewCaption: String;
-  ok: Boolean;
-  DefaultBtn: TBitBtn;
-  HasOptions: Boolean;
-  IsDefault: Boolean;
 begin
   inherited Create(nil);
   PopupMode := pmAuto;
@@ -732,135 +702,6 @@ begin
     ShowPrefix := True;
   end;
 
-  ok := false;
-  try
-    DefaultBtn:=nil;
-    i:=Low(Buttons);
-    while i <= High(Buttons) do
-    begin
-      if Buttons[i].VType <> vtInteger then
-        raise Exception.Create('TQuestionDlg.CreateQuestionDlg integer expected at '
-          +IntToStr(i)+' but VType='+IntToStr(ord(Buttons[i].VType))+' found.');
-      if Buttons[i].VType = vtInteger then
-      begin
-        // get TModalResult
-        CurBtnValue := Buttons[i].VInteger;
-        //debugln('TQuestionDlg.CreateQuestionDlg i=',dbgs(i),' CurBtnValue=',dbgs(CurBtnValue));
-        inc(i);
-        
-        // get button caption
-        CurBtnCaption := '';
-        if (i <= High(Buttons)) then
-        begin
-          //debugln('TQuestionDlg.CreateQuestionDlg i=',dbgs(i),' Buttons[i].VType=',dbgs(Buttons[i].VType),' vtString=',dbgs(vtString));
-          case Buttons[i].VType of
-            vtString: CurBtnCaption := Buttons[i].VString^;
-            vtAnsiString: CurBtnCaption := AnsiString(Buttons[i].VAnsiString);
-            vtChar: CurBtnCaption := Buttons[i].VChar;
-            vtPChar: CurBtnCaption := Buttons[i].VPChar;
-            vtPWideChar: CurBtnCaption := Buttons[i].VPWideChar;
-            vtWideChar: CurBtnCaption := Buttons[i].VWideChar;
-            vtWidestring: CurBtnCaption := WideString(Buttons[i].VWideString);
-          else
-            dec(i); // prevent the following inc(i)
-          end;
-          inc(i);
-        end;
-
-        // get options
-        CurOptions := '';
-        IsDefault := False;
-        if (i<=High(Buttons)) then
-        begin
-          //debugln('TQuestionDlg.CreateQuestionDlg i=',dbgs(i),' Buttons[i].VType=',dbgs(Buttons[i].VType),' vtString=',dbgs(vtString));
-          HasOptions := True;
-          case Buttons[i].VType of
-            vtString: CurOptions := Buttons[i].VString^;
-            vtAnsiString: CurOptions := AnsiString(Buttons[i].VAnsiString);
-            vtChar: CurOptions := Buttons[i].VChar;
-            vtPChar: CurOptions := Buttons[i].VPChar;
-            vtPWideChar: CurOptions := Buttons[i].VPWideChar;
-            vtWideChar: CurOptions := Buttons[i].VWideChar;
-            vtWidestring: CurOptions := WideString(Buttons[i].VWideString);
-          else
-            HasOptions := False;
-          end;
-          if HasOptions then
-          begin
-            if SysUtils.CompareText(CurOptions,'isdefault')<>0 then
-              raise Exception.Create('TQuestionDlg.CreateQuestionDlg option expected at '
-                +IntToStr(i)+' but "'+CurOptions+'" found.');
-            if DefaultBtn<>nil then
-              raise Exception.Create('TQuestionDlg.CreateQuestionDlg only one button can be default');
-            IsDefault := True;
-            inc(i);
-          end;
-        end;
-        //DebugLn('TQuestionDlg.CreateQuestionDlg CurBtnCaption=',CurBtnCaption,' CurOptions="',CurOptions,'"');
-
-        if CurBtnCaption = '' then
-        begin
-          // find default caption
-          case CurBtnValue of
-            mrOk       : CurBtnCaption := rsmbOk;
-            mrCancel   : CurBtnCaption := rsmbCancel;
-            mrYes      : CurBtnCaption := rsmbYes;
-            mrNo       : CurBtnCaption := rsmbNo;
-            mrAbort    : CurBtnCaption := rsmbAbort;
-            mrRetry    : CurBtnCaption := rsmbRetry;
-            mrIgnore   : CurBtnCaption := rsmbIgnore;
-            mrAll      : CurBtnCaption := rsmbAll;
-            mrYesToAll : CurBtnCaption := rsmbYesToAll;
-            mrNoToAll  : CurBtnCaption := rsmbNoToAll;
-          end;
-        end;
-        if CurBtnCaption = '' then
-          raise Exception.Create('TQuestionDlg.Create: missing Button caption '+dbgs(i-1));
-
-        // get button kind
-        case curBtnValue of
-          mrOk:       NewKind := bkOK;
-          mrCancel:   NewKind := bkCancel;
-          mrYes:      NewKind := bkYes;
-          mrNo:       NewKind := bkNo;
-          mrAbort:    NewKind := bkAbort;
-          mrRetry:    NewKind := bkRetry;
-          mrIgnore:   NewKind := bkIgnore;
-          mrAll:      NewKind := bkAll;
-          mrNoToAll:  NewKind := bkNoToAll;
-          mrYesToAll: NewKind := bkYesToAll;
-        else
-          NewKind := bkCustom;
-        end;
-
-        // add button
-        if FButtons = nil then
-          FButtons := TList.Create;
-        NewButton := TBitBtn.Create(Self);
-        with NewButton do
-        begin
-          AutoSize := False;
-          Anchors := [akLeft, akBottom];
-          ModalResult := curBtnValue;
-          Layout := blGlyphLeft;
-          Kind := NewKind;
-          Caption := curBtnCaption;
-          Parent := Self;
-          Default := IsDefault;
-        end;
-        if IsDefault then
-          DefaultBtn := NewButton;
-        FButtons.Add(NewButton);
-      end
-      else
-        raise Exception.Create('TQuestionDlg.Create: invalid Buttons parameter '+dbgs(i));
-    end;
-    ok := True;
-  finally
-    if not Ok then
-      FreeAndNil(FButtons);
-  end;
-
   FBitmap := nil;
   NewCaption := ACaption;
   case DlgType of
@@ -876,12 +717,43 @@ begin
   if NewCaption = '' then
     NewCaption := Application.Title;
   Caption := NewCaption;
-  
+
-  // find default and cancel button
+  for i := 0 to Buttons.Count - 1 do
-  if DefaultBtn = nil then
+  begin
-    DefaultBtn := FindButton([mrYes, mrOk, mrYesToAll, mrAll, mrRetry, mrCancel, mrNo, mrNoToAll, mrAbort, mrIgnore]);
+    CurBtn := Buttons[i];
-  DefaultControl := DefaultBtn;
+    // get button kind
-  CancelControl := FindButton([mrAbort, mrCancel, mrNo, mrIgnore, mrNoToAll, mrYes, mrOk, mrRetry, mrAll, mrYesToAll])
+    case CurBtn.ModalResult of
+      mrOk:       NewKind := bkOK;
+      mrCancel:   NewKind := bkCancel;
+      mrYes:      NewKind := bkYes;
+      mrNo:       NewKind := bkNo;
+      mrAbort:    NewKind := bkAbort;
+      mrRetry:    NewKind := bkRetry;
+      mrIgnore:   NewKind := bkIgnore;
+      mrAll:      NewKind := bkAll;
+      mrNoToAll:  NewKind := bkNoToAll;
+      mrYesToAll: NewKind := bkYesToAll;
+    else
+      NewKind := bkCustom;
+    end;
+
+    NewButton := TBitBtn.Create(Self);
+    with NewButton do
+    begin
+      AutoSize := False;
+      Anchors := [akLeft, akBottom];
+      ModalResult := CurBtn.ModalResult;
+      Layout := blGlyphLeft;
+      Kind := NewKind;
+      Caption := CurBtn.Caption;
+      Parent := Self;
+      Default := CurBtn.Default;
+      Cancel := CurBtn.Cancel;
+    end;
+    if FButtons = nil then
+      FButtons := TList.Create;
+    FButtons.Add(NewButton);
+  end;
 end;
 
 destructor TQuestionDlg.Destroy;
@@ -893,7 +765,7 @@ end;
 
 
 function ShowQuestionDialog(const aCaption, aMsg: string; DlgType: LongInt;
-  Buttons: array of const; HelpCtx: Longint): LongInt;
+  Buttons: TDialogButtons; HelpCtx: Longint): LongInt;
 { Show a dialog with aCaption as Title, aMsg as Text, DlgType as Icon,
   HelpCtx as Help context and Buttons to define the shown buttons and their
   TModalResult.
@@ -924,8 +796,113 @@ end;
 
 function QuestionDlg(const aCaption, aMsg: string; DlgType: TMsgDlgType;
             Buttons: array of const; HelpCtx: Longint): TModalResult;
+var
+  DialogButtons: TDialogButtons;
+  i: integer;
+  CurBtnValue: TModalResult;
+  CurBtnCaption, CurOptions: String;
+  HasOptions: Boolean;
+  IsDefault: Boolean;
+  NewButton: TDialogButton;
 begin
-  Result := WidgetSet.AskUser(aCaption, aMsg, DialogIds[DlgType], Buttons, HelpCtx);
+  DialogButtons := TDialogButtons.Create(TDialogButton);
+  try
+    i := Low(Buttons);
+    while i <= High(Buttons) do
+    begin
+      if Buttons[i].VType <> vtInteger then
+        raise Exception.Create('TQuestionDlg.CreateQuestionDlg integer expected at '
+          +IntToStr(i)+' but VType='+IntToStr(ord(Buttons[i].VType))+' found.');
+      if Buttons[i].VType = vtInteger then
+      begin
+        // get TModalResult
+        CurBtnValue := Buttons[i].VInteger;
+        inc(i);
+
+        // get button caption
+        CurBtnCaption := '';
+        if (i <= High(Buttons)) then
+        begin
+          case Buttons[i].VType of
+            vtString: CurBtnCaption := Buttons[i].VString^;
+            vtAnsiString: CurBtnCaption := AnsiString(Buttons[i].VAnsiString);
+            vtChar: CurBtnCaption := Buttons[i].VChar;
+            vtPChar: CurBtnCaption := Buttons[i].VPChar;
+            vtPWideChar: CurBtnCaption := Buttons[i].VPWideChar;
+            vtWideChar: CurBtnCaption := Buttons[i].VWideChar;
+            vtWidestring: CurBtnCaption := WideString(Buttons[i].VWideString);
+          else
+            dec(i); // prevent the following inc(i)
+          end;
+          inc(i);
+        end;
+
+        // get options
+        CurOptions := '';
+        IsDefault := False;
+        if (i <= High(Buttons)) then
+        begin
+          HasOptions := True;
+          case Buttons[i].VType of
+            vtString: CurOptions := Buttons[i].VString^;
+            vtAnsiString: CurOptions := AnsiString(Buttons[i].VAnsiString);
+            vtChar: CurOptions := Buttons[i].VChar;
+            vtPChar: CurOptions := Buttons[i].VPChar;
+            vtPWideChar: CurOptions := Buttons[i].VPWideChar;
+            vtWideChar: CurOptions := Buttons[i].VWideChar;
+            vtWidestring: CurOptions := WideString(Buttons[i].VWideString);
+          else
+            HasOptions := False;
+          end;
+          if HasOptions then
+          begin
+            if SysUtils.CompareText(CurOptions,'isdefault')<>0 then
+              raise Exception.Create('TQuestionDlg.CreateQuestionDlg option expected at '
+                +IntToStr(i)+' but "'+CurOptions+'" found.');
+            if DialogButtons.DefaultButton <> nil then
+              raise Exception.Create('TQuestionDlg.CreateQuestionDlg only one button can be default');
+            IsDefault := True;
+            inc(i);
+          end;
+        end;
+
+        if CurBtnCaption = '' then
+        begin
+          // find default caption
+          case CurBtnValue of
+            mrOk       : CurBtnCaption := rsmbOk;
+            mrCancel   : CurBtnCaption := rsmbCancel;
+            mrYes      : CurBtnCaption := rsmbYes;
+            mrNo       : CurBtnCaption := rsmbNo;
+            mrAbort    : CurBtnCaption := rsmbAbort;
+            mrRetry    : CurBtnCaption := rsmbRetry;
+            mrIgnore   : CurBtnCaption := rsmbIgnore;
+            mrAll      : CurBtnCaption := rsmbAll;
+            mrYesToAll : CurBtnCaption := rsmbYesToAll;
+            mrNoToAll  : CurBtnCaption := rsmbNoToAll;
+          end;
+        end;
+        if CurBtnCaption = '' then
+          raise Exception.Create('TQuestionDlg.Create: missing Button caption '+dbgs(i-1));
+        NewButton := DialogButtons.Add;
+        with NewButton do
+        begin
+          Caption := CurBtnCaption;
+          ModalResult := CurBtnValue;
+        end;
+        if IsDefault then
+          DialogButtons.DefaultButton := NewButton;
+      end
+      else
+        raise Exception.Create('TQuestionDlg.Create: invalid Buttons parameter '+dbgs(i));
+    end;
+    if DialogButtons.DefaultButton = nil then
+      DialogButtons.DefaultButton := DialogButtons.FindButton([mrYes, mrOk, mrYesToAll, mrAll, mrRetry, mrCancel, mrNo, mrNoToAll, mrAbort, mrIgnore]);
+    DialogButtons.CancelButton := DialogButtons.FindButton([mrAbort, mrCancel, mrNo, mrIgnore, mrNoToAll, mrYes, mrOk, mrRetry, mrAll, mrYesToAll]);
+    Result := WidgetSet.AskUser(aCaption, aMsg, DialogIds[DlgType], DialogButtons, HelpCtx);
+  finally
+    DialogButtons.Free;
+  end;
 end;
 
 function QuestionDlg(const aCaption, aMsg: string; DlgType: TMsgDlgType;

lcl/interfacebase.pp

@@ -83,6 +83,47 @@ type
     lcLMHelpSupport             // support for LM_HELP command
   );
 
+  { TDialogButton }
+
+  TDialogButton = class(TCollectionItem)
+  private
+    FCaption: string;
+    FModalResult: LongInt;
+    function GetCancel: Boolean;
+    function GetDefault: Boolean;
+    procedure SetCancel(const AValue: Boolean);
+    procedure SetDefault(const AValue: Boolean);
+  protected
+    function GetDisplayName: string; override;
+    procedure SetCaption(const AValue: string); virtual;
+  public
+    constructor Create(ACollection: TCollection); override;
+    property Caption: string read FCaption write SetCaption;
+    property Cancel: Boolean read GetCancel write SetCancel;
+    property Default: Boolean read GetDefault write SetDefault;
+    property ModalResult: LongInt read FModalResult write FModalResult;
+  end;
+
+  { TDialogButtons }
+
+  TDialogButtons = class(TCollection)
+  protected
+    FCancelButton: TDialogButton;
+    FDefaultButton: TDialogButton;
+    function GetItem(Index: Integer): TDialogButton;
+    procedure SetCancelButton(const AValue: TDialogButton); virtual;
+    procedure SetDefaultButton(const Value: TDialogButton); virtual;
+    procedure SetItem(Index: Integer; const Value: TDialogButton);
+  public
+    destructor Destroy; override;
+    function Add: TDialogButton;
+    function FindButton(AModalResult: LongInt): TDialogButton;
+    function FindButton(Order: array of LongInt): TDialogButton;
+    property DefaultButton: TDialogButton read FDefaultButton write SetDefaultButton;
+    property CancelButton: TDialogButton read FCancelButton write SetCancelButton;
+    property Items[Index: Integer]: TDialogButton read GetItem write SetItem; default;
+  end;
+
 type
   TWSTimerProc = procedure of object;
 
@@ -169,7 +210,7 @@ type
     UseDefaultPos: boolean;
     X, Y : Longint) : Longint;
   TQuestionDialogFunction = function(const aCaption, aMsg: string;
-    DlgType: LongInt; Buttons: array of const; HelpCtx: Longint): LongInt;
+    DlgType: LongInt; Buttons: TDialogButtons; HelpCtx: Longint): LongInt;
 
 var
   InputDialogFunction: TInputDialogFunction = nil;
@@ -185,6 +226,106 @@ const
   UNKNOWN_VK_PREFIX = 'Word(''';
   UNKNOWN_VK_POSTFIX = ''')';
 
+{ TDialogButtons }
+
+procedure TDialogButtons.SetCancelButton(const AValue: TDialogButton);
+begin
+  FCancelButton := AValue;
+end;
+
+function TDialogButtons.GetItem(Index: Integer): TDialogButton;
+begin
+  Result := TDialogButton(inherited GetItem(Index));
+end;
+
+procedure TDialogButtons.SetDefaultButton(const Value: TDialogButton);
+begin
+  FDefaultButton := Value;
+end;
+
+procedure TDialogButtons.SetItem(Index: Integer; const Value: TDialogButton);
+begin
+  inherited SetItem(Index, Value);
+end;
+
+destructor TDialogButtons.Destroy;
+begin
+  inherited Destroy;
+end;
+
+function TDialogButtons.Add: TDialogButton;
+begin
+  Result := TDialogButton(inherited Add);
+end;
+
+function TDialogButtons.FindButton(AModalResult: LongInt): TDialogButton;
+var
+  i: Integer;
+begin
+  for i := 0 to Count - 1 do
+    if Items[i].ModalResult = AModalResult then
+      Exit(Items[i]);
+  Result := nil;
+end;
+
+function TDialogButtons.FindButton(Order: array of LongInt): TDialogButton;
+var
+  i: Integer;
+begin
+  for i := Low(Order) to High(Order) do
+  begin
+    Result := FindButton(Order[i]);
+    if Result <> nil then
+      Exit;
+  end;
+  Result := nil;
+end;
+
+{ TDialogButton }
+
+procedure TDialogButton.SetCaption(const AValue: string);
+begin
+  FCaption := AValue;
+end;
+
+function TDialogButton.GetDefault: Boolean;
+begin
+  Result := TDialogButtons(Collection).DefaultButton = Self;
+end;
+
+function TDialogButton.GetCancel: Boolean;
+begin
+  Result := TDialogButtons(Collection).CancelButton = Self;
+end;
+
+procedure TDialogButton.SetCancel(const AValue: Boolean);
+begin
+  if AValue then
+    TDialogButtons(Collection).CancelButton := Self
+  else
+    TDialogButtons(Collection).CancelButton := nil;
+end;
+
+procedure TDialogButton.SetDefault(const AValue: Boolean);
+begin
+  if AValue then
+    TDialogButtons(Collection).DefaultButton := Self
+  else
+    TDialogButtons(Collection).DefaultButton := nil;
+end;
+
+function TDialogButton.GetDisplayName: string;
+begin
+  Result := FCaption;
+end;
+
+constructor TDialogButton.Create(ACollection: TCollection);
+begin
+  inherited Create(ACollection);
+  FCaption := '';
+  FModalResult := 0;
+end;
+
 {$I interfacebase.inc}
 {$I intfbasewinapi.inc}
 {$I intfbaselcl.inc}

lcl/interfaces/win32/win32lclintf.inc

@@ -328,6 +328,90 @@ begin
   Self.SetWindowLong(Result, GWL_WNDPROC, PtrInt(@CallbackAllocateHWnd))
 end;
 
+function TWin32WidgetSet.AskUser(const DialogCaption, DialogMessage: string;
+  DialogType: LongInt; Buttons: TDialogButtons; HelpCtx: Longint): LongInt;
+var
+  i: Integer;
+  Caption: String;
+  TaskConfig: TTASKDIALOGCONFIG;
+  DialogButtons: PTASKDIALOG_BUTTON;
+  State: TApplicationState;
+begin
+  if (WindowsVersion >= wvVista) and ThemeServices.ThemesEnabled then
+  begin
+    FillChar(TaskConfig, SizeOf(TaskConfig), 0);
+    TaskConfig.cbSize := SizeOf(TaskConfig);
+    // if we skip hwndParent our form will be a root window - with the taskbar item and icon
+    // this is unwanted
+    if Assigned(Screen.ActiveCustomForm) then
+      TaskConfig.hwndParent := Screen.ActiveCustomForm.Handle
+    else
+    if Assigned(Application.MainForm) then
+      TaskConfig.hwndParent := Application.MainForm.Handle
+    else
+      TaskConfig.hwndParent := AppHandle;
+    TaskConfig.hInstance := HInstance;
+    TaskConfig.dwFlags := TDF_ALLOW_DIALOG_CANCELLATION;
+    if DialogCaption <> '' then
+      Caption := DialogCaption
+    else
+    case DialogType of
+      idDialogConfirm,
+      idDialogInfo,
+      idDialogWarning,
+      idDialogError: Caption := GetDialogCaption(DialogType);
+    else
+      Caption := Application.Title;
+    end;
+    TaskConfig.pszWindowTitle := PWideChar(UTF8ToUTF16(Caption));
+
+    case DialogType of
+      idDialogConfirm:
+        begin
+          TaskConfig.hMainIcon := LoadIcon(0, IDI_QUESTION);
+          TaskConfig.dwFlags := TaskConfig.dwFlags or TDF_USE_HICON_MAIN;
+        end;
+      idDialogInfo: TaskConfig.pszMainIcon := TD_INFORMATION_ICON;
+      idDialogWarning: TaskConfig.pszMainIcon := TD_WARNING_ICON;
+      idDialogError: TaskConfig.pszMainIcon := TD_ERROR_ICON;
+      idDialogShield: TaskConfig.pszMainIcon := TD_SHIELD_ICON;
+    else
+      TaskConfig.dwFlags := TaskConfig.dwFlags or TDF_USE_HICON_MAIN;
+    end;
+
+    TaskConfig.pszContent := PWideChar(UTF8ToUTF16(DialogMessage));
+
+    // question dialog button magic :)
+
+    TaskConfig.cButtons := Buttons.Count;
+    GetMem(DialogButtons, SizeOf(TTASKDIALOG_BUTTON) * TaskConfig.cButtons);
+    for i := 0 to TaskConfig.cButtons - 1 do
+    begin
+      DialogButtons[i].nButtonID := Buttons[i].ModalResult;
+      DialogButtons[i].pszButtonText := UTF8StringToPWideChar(Buttons[i].Caption);
+    end;
+    TaskConfig.pButtons := DialogButtons;
+    if Assigned(Buttons.DefaultButton) then
+      TaskConfig.nDefaultButton := Buttons.DefaultButton.Index;
+
+    State := SaveApplicationState;
+    try
+      Result := IDCANCEL;
+      TaskDialogIndirect(@TaskConfig, @Result, nil, nil);
+      if (Result = IDCANCEL) and Assigned(Buttons.CancelButton) then
+        Result := Buttons.CancelButton.ModalResult;
+    finally
+      RestoreApplicationState(State);
+      for i := 0 to TaskConfig.cButtons - 1 do
+        FreeMem(DialogButtons[i].pszButtonText);
+      FreeMem(DialogButtons);
+    end;
+  end
+  else
+    Result := inherited AskUser(DialogCaption, DialogMessage, DialogType,
+      Buttons, HelpCtx);
+end;
+
 {------------------------------------------------------------------------------
   Method: TWin32WidgetSet.DeallocateHWnd
   Params:   Wnd   - A Window handle, that was created with AllocateHWnd
@@ -656,7 +740,9 @@ begin
 
     State := SaveApplicationState;
     try
-      if TaskDialogIndirect(@TaskConfig, @Result, nil, nil) <> S_OK then
+      Result := IDCANCEL;
+      TaskDialogIndirect(@TaskConfig, @Result, nil, nil);
+      if Result = IDCANCEL then
         Result := EscapeResult;
     finally
       RestoreApplicationState(State);

lcl/interfaces/win32/win32lclintfh.inc

@@ -36,6 +36,7 @@ function AddPipeEventHandler(AHandle: THandle;
 function AddProcessEventHandler(AHandle: THandle;
   AEventHandler: TChildExitEvent; AData: PtrInt): PProcessEventHandler; override;
 function AllocateHWnd(Method: TLCLWndMethod): HWND; override;
+function AskUser(const DialogCaption, DialogMessage: string; DialogType: LongInt; Buttons: TDialogButtons; HelpCtx: Longint): LongInt; override;
 
 function CreateStandardCursor(ACursor: SmallInt): hCursor; override;
 function CreateRubberBand(const ARect: TRect; const ABrush: HBrush = 0): HWND; override;
@@ -57,7 +58,7 @@ function GetDesignerDC(WindowHandle: HWND): HDC; override;
 function IntfSendsUTF8KeyPress: boolean; override;
 function IsDesignerDC(WindowHandle: HWND; DC: HDC): Boolean; override;
 
-function PromptUser(const DialogCaption, DialogMessage : String; DialogType : longint; Buttons : PLongint; ButtonCount, DefaultIndex, EscapeResult : Longint) : Longint; override;
+function PromptUser(const DialogCaption, DialogMessage: String; DialogType : longint; Buttons : PLongint; ButtonCount, DefaultIndex, EscapeResult : Longint) : Longint; override;
 
 function RawImage_CreateBitmaps(const ARawImage: TRawImage; out ABitmap, AMask: HBitmap; ASkipMask: Boolean = False): Boolean; override;
 function RawImage_DescriptionFromBitmap(ABitmap: HBITMAP; out ADesc: TRawImageDescription): Boolean; override;