From d31e76a1f6c96ee921cfa1177d0d17e99be928e1 Mon Sep 17 00:00:00 2001 From: Bart <9132501-flyingsheep@users.noreply.gitlab.com> Date: Tue, 1 Aug 2023 15:54:34 +0200 Subject: [PATCH] TaskDialog: implement OnRadioButtonClicked event. --- lcl/dialogs.pp | 5 +++++ lcl/include/taskdialog.inc | 22 ++++++++++++++++++---- lcl/interfaces/win32/win32wsdialogs.pp | 9 ++++++++- lcl/taskdlgemulation.pp | 20 +++++++++++++++++++- 4 files changed, 50 insertions(+), 6 deletions(-) diff --git a/lcl/dialogs.pp b/lcl/dialogs.pp index cf734bc51b..277baa2249 100644 --- a/lcl/dialogs.pp +++ b/lcl/dialogs.pp @@ -640,6 +640,7 @@ type FOnDialogCreated: TNotifyEvent; FOnDialogDestroyed: TNotifyEvent; FOnExpand: TNotifyEvent; + FOnRadioButtonClicked: TNotifyEvent; FOnTimer: TTaskDlgTimerEvent; FOnVerificationClicked: TNotifyEvent; FQueryChoices: TStrings; @@ -662,6 +663,8 @@ type class procedure WSRegisterClass; override; function DoExecute(ParentWnd: HWND): Boolean; dynamic; procedure DoOnButtonClicked(AModalResult: Integer; var ACanClose: Boolean); dynamic; + procedure DoOnRadioButtonClicked(ButtonID: Integer); dynamic; + procedure SetRadioButtonFromRadioIndex(AIndex: Integer); public constructor Create(AOwner: TComponent); override; destructor Destroy; override; @@ -698,6 +701,7 @@ type property OnVerificationClicked: TNotifyEvent read FOnVerificationClicked write FOnVerificationClicked; property OnExpand: TNotifyEvent read FOnExpand write FOnExpand; property OnTimer: TTaskDlgTimerEvent read FOnTimer write FOnTimer; + property OnRadioButtonClicked: TNotifyEvent read FOnRadioButtonClicked write FOnRadioButtonClicked; end; TTaskDialog = class(TCustomTaskDialog) @@ -728,6 +732,7 @@ type property OnVerificationClicked; property OnExpand; property OnTimer; + property OnRadioButtonClicked; end; const diff --git a/lcl/include/taskdialog.inc b/lcl/include/taskdialog.inc index 5b749e088c..d075947a46 100644 --- a/lcl/include/taskdialog.inc +++ b/lcl/include/taskdialog.inc @@ -152,10 +152,7 @@ begin //(https://docwiki.embarcadero.com/Libraries/Alexandria/en/Vcl.Dialogs.TCustomTaskDialog.Execute) //But it seems that Delphi in fact does the same: it will always return True, as long as we succeed in showing the dialog. Result := (ButtonID >= 0); - if (ARadioRes >= TaskDialogFirstRadioButtonIndex) and (aRadioRes-TaskDialogFirstRadioButtonIndex < RadioButtons.Count) then - FRadioButton := RadioButtons[ARadioRes-TaskDialogFirstRadioButtonIndex] as TTaskDialogRadioButtonItem - else - FRadioButton := nil; + SetRadioButtonFromRadioIndex(aRadioRes); //debugln(['TWSTaskDialogClass(WidgetSetClass).Execute(Self)=',ButtonID,', Result=',Result]); //debugln([' ButtonID=',ButtonID]); //debugln([' FModalResult=',FModalResult]); @@ -173,6 +170,23 @@ begin FOnButtonClicked(Self, AModalResult, ACanClose); end; +procedure TCustomTaskDialog.DoOnRadioButtonClicked(ButtonID: Integer); +begin + if Assigned(FOnRadioButtonClicked) then + begin + SetRadioButtonFromRadioIndex(ButtonID); + FOnRadioButtonClicked(Self); + end; +end; + +procedure TCustomTaskDialog.SetRadioButtonFromRadioIndex(AIndex: Integer); +begin + if (AIndex >= TaskDialogFirstRadioButtonIndex) and (AIndex-TaskDialogFirstRadioButtonIndex < RadioButtons.Count) then + FRadioButton := RadioButtons[AIndex-TaskDialogFirstRadioButtonIndex] as TTaskDialogRadioButtonItem + else + FRadioButton := nil; +end; + function TCustomTaskDialog.Execute(ParentWnd: HWND): Boolean; begin diff --git a/lcl/interfaces/win32/win32wsdialogs.pp b/lcl/interfaces/win32/win32wsdialogs.pp index 300b37b17c..faad92ca63 100644 --- a/lcl/interfaces/win32/win32wsdialogs.pp +++ b/lcl/interfaces/win32/win32wsdialogs.pp @@ -1653,6 +1653,10 @@ begin Result := TLongRec(GetDialogBaseUnits).L; end; +type + TTaskDialogAccess = class(TCustomTaskDialog) + end; + function TaskDialogCallbackProc(hwnd: HWND; uNotification: UINT; wParam: WPARAM; {%H-}lParam: LPARAM; dwRefData: Long_Ptr): HRESULT; stdcall; var Dlg: TTaskDialog absolute dwRefData; @@ -1743,7 +1747,10 @@ begin lParam: Must be zero. Return value: The return value is ignored. } - if IsConsole then writeln('ToDo: implement OnRadioButtonClicked'); + {$PUSH} + {$ObjectChecks OFF} + TTaskDialogAccess(Dlg).DoOnRadioButtonClicked(wParam); + {$POP} end; end; end; diff --git a/lcl/taskdlgemulation.pp b/lcl/taskdlgemulation.pp index 5dcbf11962..e6b639bae5 100644 --- a/lcl/taskdlgemulation.pp +++ b/lcl/taskdlgemulation.pp @@ -55,10 +55,11 @@ type function AddLabel(const AText: string; BigFont: boolean; var X, Y: Integer; AFontHeight, AWidth: Integer; APArent: TWinControl): TLabel; procedure AddQueryCombo(var X,Y: Integer; AWidth: Integer; AParent: TWinControl); procedure AddQueryEdit(var X,Y: Integer; AWidth: Integer; AParent: TWinControl); - procedure OnTimer(Sender: TObject); procedure SetupTimer; procedure ResetTimer; + procedure OnTimer(Sender: TObject); + procedure OnRadioButtonClick(Sender: TObject); procedure DoDialogConstructed; procedure DoDialogCreated; procedure DoDialogDestroyed; @@ -103,6 +104,10 @@ function TF_FOOTERICON(const aIcon: TTaskDialogIcon): TLCLTaskDialogFooterIcon; implementation +type + TTaskDialogAccess = class(TCustomTaskDialog) + end; + var LDefaultFont: TFont; @@ -387,6 +392,7 @@ begin with RadioButtonArray[i] do begin Parent := AParent; + Tag := FDlg.RadioButtons[i].Index + TaskDialogFirstRadioButtonIndex; AutoSize := False; SetBounds(X+16,Y,aWidth-32-X, (6-AFontHeight) + ARadioOffset); Caption := NoCR(FDlg.RadioButtons[i].Caption, aHint); //LCL RadioButton doesn't support multiline captions @@ -397,6 +403,7 @@ begin inc(Y,Height + ARadioOffset); if not (tfNoDefaultRadioButton in FDlg.Flags) and ((i=0) or (i=aRadioDef)) then Checked := True; + OnClick := @OnRadioButtonClick; end; end; inc(Y,24); @@ -675,6 +682,17 @@ begin end; end; +procedure TLCLTaskDialog.OnRadioButtonClick(Sender: TObject); +var + ButtonID: Integer; +begin + ButtonID := (Sender as TRadioButton).Tag; + {$PUSH} + {$ObjectChecks OFF} + TTaskDialogAccess(FDlg).DoOnRadioButtonClicked(ButtonID); + {$POP} +end; + procedure TLCLTaskDialog.SetupTimer; begin Timer := TTimer.Create(Self);