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

TaskDialog: implement property CollapsButtonCaption.

Browse Source 
Delphi does not have this, but the Windows TaskDialogIndirect API has it.
It controls the text next to the Expand/Collaps button if the dialog is in expanded state.
This commit is contained in:
Bart 2023-08-07 22:05:30 +02:00
parent 04df5e253a
commit 892cf32728
3 changed files with 19 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
lcl/dialogs.pp
View File

@ -627,6 +627,7 @@ type
FButton: TTaskDialogButtonItem; FButton: TTaskDialogButtonItem;
FButtons: TTaskDialogButtons; FButtons: TTaskDialogButtons;
FCaption: TTranslateString; FCaption: TTranslateString;
FCollapsButtonCaption: TTranslateString;
FCommonButtons: TTaskDialogCommonButtons; FCommonButtons: TTaskDialogCommonButtons;
FDefaultButton: TTaskDialogCommonButton; FDefaultButton: TTaskDialogCommonButton;
FExpandButtonCaption: TTranslateString; FExpandButtonCaption: TTranslateString;
@ -688,6 +689,7 @@ type
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 CommonButtons: TTaskDialogCommonButtons read FCommonButtons write FCommonButtons default [tcbOk, tcbCancel]; property CommonButtons: TTaskDialogCommonButtons read FCommonButtons write FCommonButtons default [tcbOk, tcbCancel];
property CollapsButtonCaption: TTranslateString read FCollapsButtonCaption write FCollapsButtonCaption;
property DefaultButton: TTaskDialogCommonButton read FDefaultButton write FDefaultButton default tcbOk; property DefaultButton: TTaskDialogCommonButton read FDefaultButton write FDefaultButton default tcbOk;
property ExpandButtonCaption: TTranslateString read FExpandButtonCaption write FExpandButtonCaption; property ExpandButtonCaption: TTranslateString read FExpandButtonCaption write FExpandButtonCaption;
property ExpandedText: TTranslateString read FExpandedText write FExpandedText; property ExpandedText: TTranslateString read FExpandedText write FExpandedText;
@ -725,6 +727,7 @@ type
property Buttons; property Buttons;
property Caption; property Caption;
property CommonButtons; property CommonButtons;
property CollapsButtonCaption;
property DefaultButton; property DefaultButton;
property ExpandButtonCaption; property ExpandButtonCaption;
property ExpandedText; property ExpandedText;

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

@ -1846,7 +1846,6 @@ var
if (MainInstruction = '') then if (MainInstruction = '') then
MainInstruction := Utf8ToUtf16(IconMessage(TF_DIALOGICON(ADlg.MainIcon))); MainInstruction := Utf8ToUtf16(IconMessage(TF_DIALOGICON(ADlg.MainIcon)));
Content := Utf8ToUtf16(ADlg.Text); Content := Utf8ToUtf16(ADlg.Text);
CollapsedControlText := Utf8ToUtf16(ADlg.ExpandButtonCaption);
VerificationText := Utf8ToUtf16(ADlg.VerificationText); VerificationText := Utf8ToUtf16(ADlg.VerificationText);
if (AParentWnd = 0) then if (AParentWnd = 0) then
begin begin
@ -1857,10 +1856,7 @@ var
end; end;
ExpandedInformation := Utf8ToUtf16(ADlg.ExpandedText); ExpandedInformation := Utf8ToUtf16(ADlg.ExpandedText);
CollapsedControlText := Utf8ToUtf16(ADlg.ExpandButtonCaption); CollapsedControlText := Utf8ToUtf16(ADlg.ExpandButtonCaption);
ExpandedControlText := Utf8ToUtf16(ADlg.CollapsButtonCaption);
//Seems to be the caption of the ExpandButton when ExpandedText is displayed
//If it's empty, then the caption of the ExpandButton remains the same
ExpandedControlText := ''; //currently no matching field in TTaskDialog
Footer := Utf8ToUtf16(ADlg.FooterText); Footer := Utf8ToUtf16(ADlg.FooterText);

19
lcl/taskdlgemulation.pp
View File

@ -7,7 +7,7 @@ interface
uses uses
Classes, SysUtils, Classes, SysUtils,
LazUTF8, LazUTF8,
LCLType, LCLStrConsts, LCLIntf, InterfaceBase, ImgList, LCLProc, DateUtils, LCLType, LCLStrConsts, LCLIntf, InterfaceBase, ImgList, LCLProc, DateUtils, Math,
LResources, Menus, Graphics, Forms, Controls, StdCtrls, ExtCtrls, Buttons, Dialogs, DialogRes; LResources, Menus, Graphics, Forms, Controls, StdCtrls, ExtCtrls, Buttons, Dialogs, DialogRes;
@ -31,7 +31,7 @@ type
//CustomButtons, Radios: TStringList; //CustomButtons, Radios: TStringList;
DialogCaption, DlgTitle, DlgText, DialogCaption, DlgTitle, DlgText,
ExpandButtonCaption, ExpandedText, FooterText, ExpandButtonCaption, CollapsButtonCaption, ExpandedText, FooterText,
VerificationText: String; VerificationText: String;
CommonButtons: TTaskDialogCommonButtons; CommonButtons: TTaskDialogCommonButtons;
@ -525,8 +525,18 @@ begin
//inc(Y, 16); //inc(Y, 16);
X := ALeftMargin; X := ALeftMargin;
if (ExpandButtonCaption = '') then if (ExpandButtonCaption = '') then
ExpandButtonCaption := '>>'; begin
WB := Canvas.TextWidth(ExpandButtonCaption)+32;//52; if (CollapsButtonCaption = '') then
begin
ExpandButtonCaption := 'Show details';
CollapsButtonCaption := 'Hide details';
end
else
ExpandButtonCaption := CollapsButtonCaption;
end;
if (CollapsButtonCaption = '') then
CollapsButtonCaption := ExpandButtonCaption;
WB := Max(Canvas.TextWidth(ExpandButtonCaption), Canvas.TextWidth(CollapsButtonCaption)) +32;//52;
debugln([' X+WB=', X+WB]); debugln([' X+WB=', X+WB]);
debugln([' XB=', XB]); debugln([' XB=', XB]);
debugln([' diff=', X+WB-XB]); debugln([' diff=', X+WB-XB]);
@ -798,6 +808,7 @@ begin
DlgTitle := FDlg.Title; DlgTitle := FDlg.Title;
DlgText := FDlg.Text; DlgText := FDlg.Text;
ExpandButtonCaption := FDlg.ExpandButtonCaption; ExpandButtonCaption := FDlg.ExpandButtonCaption;
CollapsButtonCaption := FDlg.CollapsButtonCaption;
ExpandedText := FDlg.ExpandedText; ExpandedText := FDlg.ExpandedText;
FooterText := FDlg.FooterText; FooterText := FDlg.FooterText;
VerificationText := FDlg.VerificationText; VerificationText := FDlg.VerificationText;