paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-08 07:37:02 +02:00
Code Issues Packages Projects Releases Wiki Activity

TaskDialog: implement OnRadioButtonClicked event.

Browse Source
This commit is contained in:
Bart 2023-08-01 15:54:34 +02:00
parent a2a14d0641
commit d31e76a1f6
4 changed files with 50 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
lcl/dialogs.pp
View File

@ -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

22
lcl/include/taskdialog.inc
View File

@ -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

9
lcl/interfaces/win32/win32wsdialogs.pp
View File

@ -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;

20
lcl/taskdlgemulation.pp
View File

@ -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);