Refactoring TTaskDialog:

- first attempt to get Win32 WS code working (currently littered with writeln() statements, so crashes if no console!)
- fix ModalResult in OnButtonClicked for emulated dialog.

lcl/dialogs.pp

@@ -639,7 +639,6 @@ type
       var ACanClose: Boolean);
     procedure SetButtons(const Value: TTaskDialogButtons);
     procedure SetRadioButtons(const Value: TTaskDialogButtons);
-    function ButtonIDToModalResult(const AButtonID: Integer): TModalResult;
   protected
     class procedure WSRegisterClass; override;
     function DoExecute(ParentWnd: HWND): Boolean; dynamic;
@@ -649,6 +648,7 @@ type
 
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
+    function ButtonIDToModalResult(const AButtonID: Integer): TModalResult;
     function Execute: Boolean; overload; dynamic;
     function Execute(ParentWnd: HWND): Boolean; overload; dynamic;
     property Button: TTaskDialogButtonItem read FButton write FButton;

lcl/include/taskdialog.inc

@@ -242,6 +242,11 @@ begin
   debugln(['New: FModalResult=',FModalResult]);
   debugln(['New: VerifyChecked=',tfVerificationFlagChecked in FFlags]);
   debugln(['New: ARadioRes=',ARadioRes]);
+
+
+
+
+
   FillChar(TaskDlg, SizeOf(LCLTaskDialog.TTaskDialog), 0);
 
   if RadioButtons.DefaultButton<> nil then

lcl/interfaces/win32/win32wsdialogs.pp

@@ -180,6 +180,9 @@ var
 
 implementation
 
+uses
+  TaskDlgEmulation;
+
 function SaveApplicationState: TApplicationState;
 begin
   Result.ActiveWindow := Windows.GetActiveWindow;
@@ -1615,15 +1618,262 @@ var
 begin
   Result := 0;
   for aFlag := Low(TTaskDialogFlags) to High(TTaskDialogFlags) do
-    if (aFlag in aFlags) then Result := Result or FlagValues[aFlag];
+    if (aFlag in aFlags) then
+      Result := Result or FlagValues[aFlag];
+end;
+
+function TaskDialogCommonButtonsToInteger(const Buttons: TTaskDialogCommonButtons): Integer;
+const
+  CommonButtonValues: Array[TTaskDialogCommonButton] of Integer = (
+    TDCBF_OK_BUTTON,// tcbOk
+    TDCBF_YES_BUTTON, //tcbYes
+    TDCBF_NO_BUTTON, //tcbNo
+    TDCBF_CANCEL_BUTTON, //tcbCancel
+    TDCBF_RETRY_BUTTON, //tcbRetry
+    TDCBF_CLOSE_BUTTON //tcbClose
+  );
+var
+  B: TTaskDialogCommonButton;
+begin
+  Result := 0;
+  for B in TTaskDialogCommonButton do
+  begin
+    if B in Buttons then
+      Result := Result or CommonButtonValues[B];
+  end;
+end;
+
+function TaskDialogCallbackProc(hwnd: HWND; uNotification: UINT;
+  wParam: WPARAM; {%H-}lParam: LPARAM; dwRefData: Long_Ptr): HRESULT; stdcall;
+var Dlg: TTaskDialog absolute dwRefData;
+    CanClose: Boolean;
+begin
+  writeln('TaskDialogCallbackProc: uNotification=',uNotification);
+  //ptd^.Dialog.Wnd := hwnd;
+  Result := S_OK;
+
+  if not (Dlg is TCustomTaskDialog) then
+  begin
+    writeln('TaskDialogCallbackProc: Dlg is NOT a TCustomTaskDialog');
+    Exit;
+  end;
+
+  case uNotification of
+    TDN_BUTTON_CLICKED:
+    //if Assigned(ptd^.Dialog.OnButtonClicked) then
+    if Assigned(Dlg.OnButtonClicked) then
+    begin
+      CanClose := True;
+      //ptd^.Dialog.OnButtonClicked(ptd,wParam,CanClose);
+      Dlg.OnButtonClicked(Dlg, Dlg.ButtonIDToModalResult(wParam), CanClose);
+      if not CanClose then
+        Result := S_FALSE;
+    end;
+  end;
+end;
+
+
+type
+  TWideStringArray = array of WideString;
+  TButtonArray = array of TTASKDIALOG_BUTTON;
+
+procedure PrepareTaskDialogConfig(const ADlg: TTaskDialog; AParent: HWND; out Config: TTaskDialogConfig;
+  out RU: TWideStringArray; out But: TButtonArray);
+var
+  WindowTitle, MainInstruction, Content, VerificationText,
+  ExpandedInformation, ExpandedControlText, CollapsedControlText,
+  Footer: WideString;
+  DefRB, DefBtn, RUCount: Integer;
+  CommonButtons: TTaskDialogCommonButtons;
+  B: TTaskDialogBaseButtonItem;
+  List: TStringList;
+  //RU: Array of WideString;
+  //But: array of TTASKDIALOG_BUTTON;
+  Flags: TTaskDialogFlags;
+const
+  TD_BTNMOD: array[TTaskDialogCommonButton] of Integer = (
+    mrOk, mrYes, mrNo, mrCancel, mrRetry, mrAbort);
+  TD_ICONS: array[TLCLTaskDialogIcon] of integer = (
+    0, 84, 99, 98, 81, 0, 78);
+  TD_FOOTERICONS: array[TLCLTaskDialogFooterIcon] of integer = (
+    0, 84, 99, 98, 65533, 65532);
+
+  procedure AddRU(List: TStringList; var n: longword{integer}; firstID: integer);
+  var
+    P: PChar;
+    i: Integer;
+  begin
+    if (List.Count = 0) then
+      Exit;
+    //P := @Text[1]; // '\n' handling in GetNextStringLineToWS(P) will change P^
+    //while P<>nil do
+    for i := 0 to List.Count - 1 do
+    begin
+      if length(RU)<=RUCount then
+      begin
+        SetLength(RU,RUCount+16);
+        SetLength(But,RUCount+16);
+      end;
+      RU[RUCount] := Utf8ToUtf16(List[i]);//GetNextStringLineToWS(P);
+      But[RUCount].nButtonID := n+firstID;
+      But[RUCount].pszButtonText := PWideChar(RU[RUCount]);
+      inc(n);
+      inc(RUCount);
+    end;
+  end;
+
+  function DialogBaseUnits: Integer;
+  //https://learn.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-getdialogbaseunits
+  type
+    TLongRec = record L, H: Word; end;
+  begin
+    Result := TLongRec(GetDialogBaseUnits).L;
+  end;
+
+
+begin
+  WindowTitle := Utf8ToUtf16(ADlg.Caption);
+  if (WindowTitle = '') then
+  begin
+    if (Application.MainForm = nil) then
+      WindowTitle := Utf8ToUtf16(Application.Title)
+    else
+      WindowTitle := Utf8ToUtf16(Application.MainForm.Caption);
+  end;
+  MainInstruction := Utf8ToUtf16(ADlg.Title);
+  if (MainInstruction = '') then
+    MainInstruction := Utf8ToUtf16(IconMessage(TF_DIALOGICON(ADlg.MainIcon)));
+  Content := Utf8ToUtf16(ADlg.Text);
+  CollapsedControlText := Utf8ToUtf16(ADlg.ExpandButtonCaption);
+  VerificationText := Utf8ToUtf16(ADlg.VerificationText);
+  if (aParent = 0) then
+  begin
+    if Assigned(Screen.ActiveCustomForm) then
+      aParent := Screen.ActiveCustomForm.Handle
+    else
+      aParent := 0;
+  end;
+  ExpandedInformation := Utf8ToUtf16(ADlg.ExpandedText);
+  ExpandedControlText := ''; //currently no matching field in TTaskDialog??
+  CollapsedControlText := Utf8ToUtf16(ADlg.ExpandButtonCaption);
+  Footer := Utf8ToUtf16(ADlg.FooterText);
+
+  if ADlg.RadioButtons.DefaultButton<> nil then
+    DefRB := ADlg.RadioButtons.DefaultButton.Index
+  else
+    DefRB := 0;
+  if ADlg.Buttons.DefaultButton<>nil then
+    DefBtn := ADlg.Buttons.DefaultButton.ModalResult
+  else
+    DefBtn := TD_BTNMOD[ADlg.DefaultButton];
+
+
+  if (ADlg.CommonButtons = []) and (ADlg.Buttons.Count = 0) then
+  begin
+    CommonButtons := [tcbOk];
+    if (DefBtn = 0) then
+      DefBtn := mrOK;
+  end;
+
+  writeln('PrepareTaskDialogConfig A');
+
+  Config := Default(TTaskDialogConfig);
+  Config.cbSize := SizeOf(TTaskDialogConfig);
+  Config.hwndParent := aParent;
+  Config.pszWindowTitle := PWideChar(WindowTitle);
+  Config.pszMainInstruction := PWideChar(MainInstruction);
+  Config.pszContent := PWideChar(Content);
+  Config.pszVerificationText := PWideChar(VerificationText);
+  Config.pszExpandedInformation := PWideChar(ExpandedInformation);
+  Config.pszCollapsedControlText := PWideChar(CollapsedControlText);
+  Config.pszExpandedControlText := PWideChar(ExpandedControlText);
+  Config.pszFooter := PWideChar(Footer);
+  Config.nDefaultButton := DefBtn;
+
+  writeln('PrepareTaskDialogConfig B');
+
+
+  RUCount := 0;
+  List := TStringList.Create;
+  try
+    for B in ADlg.Buttons do
+      List.Add(B.Caption);
+    AddRU(List,Config.cButtons,TaskDialogFirstButtonIndex);
+    writeln('PrepareTaskDialogConfig C');
+
+    List.Clear;
+    for B in ADlg.RadioButtons do
+      List.Add(B.Caption);
+    AddRU(List,Config.cRadioButtons,TaskDialogFirstRadioButtonIndex);
+    writeln('PrepareTaskDialogConfig D');
+
+  finally
+    List.Free;
+  end;
+
+  writeln('PrepareTaskDialogConfig E');
+
+  if (Config.cButtons > 0) then
+    Config.pButtons := @But[0];
+  writeln('PrepareTaskDialogConfig F: Config.cButtons=',Config.cButtons,', Config.pButtons=',PtrInt(Config.pButtons));
+
+  if (Config.cRadioButtons > 0) then
+    Config.pRadioButtons := @But[Config.cButtons {Config.cRadioButtons}];
+  writeln('PrepareTaskDialogConfig G',', Config.pRadioButtons=',PtrInt(Config.pRadioButtons));
+
+
+  Config.dwCommonButtons := TaskDialogCommonButtonsToInteger(ADlg.CommonButtons);
+  writeln('PrepareTaskDialogConfig H');
+
+
+  Flags := ADlg.Flags;
+  writeln('PrepareTaskDialogConfig I');
+  if (VerificationText <> '') and (tfVerificationFlagChecked in ADlg.Flags) then
+    Include(Flags,tfVerificationFlagChecked)
+  else
+    Exclude(Flags,tfVerificationFlagChecked);
+  writeln('PrepareTaskDialogConfig J');
+  if (Config.cButtons=0) and (CommonButtons=[tcbOk]) then
+    Include(Flags,tfAllowDialogCancellation); // just OK -> Esc/Alt+F4 close
+  writeln('PrepareTaskDialogConfig K');
+
+
+  Config.dwFlags := TaskDialogFlagsToInteger(Flags);
+  writeln('PrepareTaskDialogConfig L');
+
+
+  Config.hMainIcon := TD_ICONS[TF_DIALOGICON(ADlg.MainIcon)];
+  writeln('PrepareTaskDialogConfig M');
+  Config.hFooterIcon := TD_FOOTERICONS[TF_FOOTERICON(ADlg.FooterIcon)];
+  writeln('PrepareTaskDialogConfig N');
+
+  {
+    Although the offcial MS docs (https://learn.microsoft.com/en-us/windows/win32/api/commctrl/ns-commctrl-taskdialogconfig)
+    states that setting the flag TDF_NO_DEFAULT_RADIO_BUTTON should cause that no radiobutton
+    is selected when the dialog displays, testing shows that (at least on Win10) this only
+    works correctly if nDefaultRadioButton does NOT point to a radiobutton in the pRadioButtons array.
+  }
+  if not (tfNoDefaultRadioButton in ADlg.Flags) then
+    Config.nDefaultRadioButton := DefRB + TaskDialogFirstRadioButtonIndex;
+  writeln('PrepareTaskDialogConfig O');
+
+  Config.cxWidth := MulDiv(ADlg.FWidth, 4, DialogBaseUnits);  // cxWidth needed in "dialog units"
+  writeln('PrepareTaskDialogConfig P');
+
+  Config.pfCallback := @TaskDialogCallbackProc;
+  writeln('PrepareTaskDialogConfig Q');
+  Config.lpCallbackData := LONG_PTR(ADlg);
+  writeln('PrepareTaskDialogConfig R');
 end;
 
 class function TWin32WSTaskDialog.Execute(const ADlg: TCustomTaskDialog; AParentWnd: HWND; out ARadioRes: Integer): Integer;
 var
   Config: TTASKDIALOGCONFIG;
   VerifyChecked: BOOL;
+  RU: TWideStringArray;
+  BUT: TButtonArray;
 begin
-  writeln('TWin32WSTaskDialog.Execute');
+  writeln('TWin32WSTaskDialog.Execute A');
   if not Assigned(TaskDialogIndirect)  or
      (tfForceNonNative in ADlg.Flags)
      //Yet to be implemented: or (ADlg.Selection <> '') or (tfQuery in ADlg.Flags)
@@ -1631,12 +1881,19 @@ begin
     Result := inherited Execute(ADlg, AParentWnd, ARadioRes)
   else
   begin
+    writeln('TWin32WSTaskDialog.Execute B');
+    PrepareTaskDialogConfig(TTaskDialog(ADlg), AParentWnd, Config, RU, BUT);
+    writeln('TWin32WSTaskDialog.Execute C');
+
 
     Result := TaskDialogIndirect(@Config, @Result, @ARadioRes, @VerifyChecked);
+    writeln('TWin32WSTaskDialog.Execute D');
+
     //for now let it fail, it's not functional yet.
     Result := -1;
     if (Result = S_OK) then
     begin
+      writeln('TWin32WSTaskDialog.Execute E');
       if VerifyChecked then
         ADlg.Flags := ADlg.Flags + [tfVerificationFlagChecked]
       else

lcl/lcltaskdialog.pas

@@ -772,6 +772,7 @@ var
     end;
     if ModalResult=aButtonDef then
       Dialog.Form.ActiveControl := result;
+    writeln('AddButton: Result.ModalResult=',Result.ModalResult);
   end;
   {$IFDEF MSWINDOwS}
   function TaskDialogFlagsToInteger(aFlags: TTaskDialogFlags): Integer;

lcl/taskdlgemulation.pp

@@ -74,6 +74,19 @@ var
 
 function ExecuteLCLTaskDialog(const ADlg: TTaskDialog; AParentWnd: HWND; out ARadioRes: Integer): Integer;
 
+
+type
+  TLCLTaskDialogIcon = (
+    tiBlank, tiWarning, tiQuestion, tiError, tiInformation, tiNotUsed, tiShield);
+  TLCLTaskDialogFooterIcon = (
+    tfiBlank, tfiWarning, tfiQuestion, tfiError, tfiInformation, tfiShield);
+
+function IconMessage(Icon: TLCLTaskDialogIcon): string;
+function TF_DIALOGICON(const aIcon: TTaskDialogIcon): TLCLTaskDialogIcon;
+function TF_FOOTERICON(const aIcon: TTaskDialogIcon): TLCLTaskDialogFooterIcon;
+
+
+
 implementation
 
 var
@@ -102,11 +115,6 @@ begin
   {$ENDIF}
 end;
 
-type
-  TLCLTaskDialogIcon = (
-    tiBlank, tiWarning, tiQuestion, tiError, tiInformation, tiNotUsed, tiShield);
-  TLCLTaskDialogFooterIcon = (
-    tfiBlank, tfiWarning, tfiQuestion, tfiError, tfiInformation, tfiShield);
 
 const
   LCL_IMAGES: array[TLCLTaskDialogIcon] of Integer = (
@@ -593,9 +601,10 @@ procedure TLCLTaskDialog.HandleEmulatedButtonClicked(Sender: TObject);
 var Btn: TButton absolute Sender;
     CanClose: Boolean;
 begin
-  if Assigned(FDlg) and Assigned(FDlg.OnButtonClicked) then begin
+  if Assigned(FDlg) and Assigned(FDlg.OnButtonClicked) then
+  begin
     CanClose := True;
-    FDlg.OnButtonClicked(FDlg,Btn.ModalResult,CanClose);
+    FDlg.OnButtonClicked(FDlg, FDlg.ButtonIDToModalResult(Btn.ModalResult),CanClose);
     if not CanClose then
       ModalResult := mrNone;
   end;
@@ -627,9 +636,9 @@ begin
 
   CustomButtons := TStringList.Create;
   for B in FDlg.Buttons do
-    CustomButtons.Add(B.Caption);
+    CustomButtons.Add(B.Caption);        //**********   ModalResult and Default???
   Radios := TStringList.Create;
-  for B in FDlg.RadioButtons do
+  for B in FDlg.RadioButtons do          //**********   Default?
     Radios.Add(B.Caption);
 
   //ToDo