paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-09 15:48:03 +02:00
Code Issues Packages Projects Releases Wiki Activity

TTaskDialog: implement CustomMainIcon and CustomFooterIcon, needed for flags tfUseHIconMain and tfUseHIconFooter respectively.

Browse Source 
The flags now work on Windows Vista+ native dialog.
Partly resolves issue #40449.
This commit is contained in:
Bart 2023-08-20 13:48:40 +02:00
parent fe4a986145
commit d7801adb2a
3 changed files with 23 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
lcl/dialogs.pp
View File

@ -643,6 +643,8 @@ type
FCaption: TTranslateString; FCaption: TTranslateString;
FCollapseButtonCaption: TTranslateString; FCollapseButtonCaption: TTranslateString;
FCommonButtons: TTaskDialogCommonButtons; FCommonButtons: TTaskDialogCommonButtons;
FCustomFooterIcon: TIcon;
FCustomMainIcon: TIcon;
FDefaultButton: TTaskDialogCommonButton; FDefaultButton: TTaskDialogCommonButton;
FExpandButtonCaption: TTranslateString; FExpandButtonCaption: TTranslateString;
FExpanded: Boolean; FExpanded: Boolean;
@ -676,6 +678,8 @@ type
FWidth: Integer; FWidth: Integer;
FOnButtonClicked: TTaskDlgClickEvent; FOnButtonClicked: TTaskDlgClickEvent;
procedure SetButtons(const Value: TTaskDialogButtons); procedure SetButtons(const Value: TTaskDialogButtons);
procedure SetCustomFooterIcon(AValue: TIcon);
procedure SetCustomMainIcon(AValue: TIcon);
procedure SetFlags(AValue: TTaskDialogFlags); procedure SetFlags(AValue: TTaskDialogFlags);
procedure SetQueryChoices(AValue: TStrings); procedure SetQueryChoices(AValue: TStrings);
procedure SetRadioButtons(const Value: TTaskDialogButtons); procedure SetRadioButtons(const Value: TTaskDialogButtons);
@ -707,6 +711,8 @@ type
property Button: TTaskDialogButtonItem read FButton write FButton; property Button: TTaskDialogButtonItem read FButton write FButton;
property Buttons: TTaskDialogButtons read FButtons write SetButtons; property Buttons: TTaskDialogButtons read FButtons write SetButtons;
property Caption: TTranslateString read FCaption write FCaption; property Caption: TTranslateString read FCaption write FCaption;
property CustomFooterIcon: TIcon read FCustomFooterIcon write SetCustomFooterIcon;
property CustomMainIcon: TIcon read FCustomMainIcon write SetCustomMainIcon;
property CommonButtons: TTaskDialogCommonButtons read FCommonButtons write FCommonButtons default [tcbOk, tcbCancel]; property CommonButtons: TTaskDialogCommonButtons read FCommonButtons write FCommonButtons default [tcbOk, tcbCancel];
property CollapseButtonCaption: TTranslateString read FCollapseButtonCaption write FCollapseButtonCaption; property CollapseButtonCaption: TTranslateString read FCollapseButtonCaption write FCollapseButtonCaption;
property DefaultButton: TTaskDialogCommonButton read FDefaultButton write FDefaultButton default tcbOk; property DefaultButton: TTaskDialogCommonButton read FDefaultButton write FDefaultButton default tcbOk;

15
lcl/include/taskdialog.inc
View File

@ -95,6 +95,9 @@ begin
FMainIcon := tdiInformation; FMainIcon := tdiInformation;
FQueryChoices := TStringList.Create; FQueryChoices := TStringList.Create;
FCustomFooterIcon := TIcon.Create;
FCustomMainIcon := TIcon.Create;
end; end;
function TCustomTaskDialog.ButtonIDToModalResult(const AButtonID: Integer function TCustomTaskDialog.ButtonIDToModalResult(const AButtonID: Integer
@ -132,6 +135,8 @@ begin
FButtons.Free; FButtons.Free;
FRadioButtons.Free; FRadioButtons.Free;
FQueryChoices.Free; FQueryChoices.Free;
FCustomFooterIcon.Free;
FCustomMainIcon.Free;
inherited Destroy; inherited Destroy;
end; end;
@ -275,6 +280,16 @@ begin
FButtons.Assign(Value); FButtons.Assign(Value);
end; end;
procedure TCustomTaskDialog.SetCustomFooterIcon(AValue: TIcon);
begin
FCustomFooterIcon.Assign(AValue);
end;
procedure TCustomTaskDialog.SetCustomMainIcon(AValue: TIcon);
begin
FCustomMainIcon.Assign(AValue);
end;
function DbgS(aFlag: TTaskDialogFlag): String; overload; function DbgS(aFlag: TTaskDialogFlag): String; overload;
begin begin
WriteStr(Result, aFlag); WriteStr(Result, aFlag);

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

@ -1918,14 +1918,12 @@ var
if not (tfUseHIconMain in Flags) then if not (tfUseHIconMain in Flags) then
Config.pszMainIcon := TD_ICONS[ADlg.MainIcon] Config.pszMainIcon := TD_ICONS[ADlg.MainIcon]
else else
//ToDo: needs implemenation of TTaskDialog.CustomMainIcon Config.hMainIcon := ADlg.CustomMainIcon.Handle;
Config.hMainIcon := 0;
if not (tfUseHIconFooter in Flags) then if not (tfUseHIconFooter in Flags) then
Config.pszFooterIcon := TD_ICONS[ADlg.FooterIcon] Config.pszFooterIcon := TD_ICONS[ADlg.FooterIcon]
else else
//ToDo: needs implemenation of TTaskDialog.CustomFooterIcon Config.hFooterIcon := ADlg.CustomFooterIcon.Handle;
Config.hFooterIcon := 0;
{ {
Although the offcial MS docs (https://learn.microsoft.com/en-us/windows/win32/api/commctrl/ns-commctrl-taskdialogconfig) Although the offcial MS docs (https://learn.microsoft.com/en-us/windows/win32/api/commctrl/ns-commctrl-taskdialogconfig)