paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-07 16:38:02 +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;
FButtons: TTaskDialogButtons;
FCaption: TTranslateString;
FCollapsButtonCaption: TTranslateString;
FCommonButtons: TTaskDialogCommonButtons;
FDefaultButton: TTaskDialogCommonButton;
FExpandButtonCaption: TTranslateString;
@ -688,6 +689,7 @@ type
property Buttons: TTaskDialogButtons read FButtons write SetButtons;
property Caption: TTranslateString read FCaption write FCaption;
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 ExpandButtonCaption: TTranslateString read FExpandButtonCaption write FExpandButtonCaption;
property ExpandedText: TTranslateString read FExpandedText write FExpandedText;
@ -725,6 +727,7 @@ type
property Buttons;
property Caption;
property CommonButtons;
property CollapsButtonCaption;
property DefaultButton;
property ExpandButtonCaption;
property ExpandedText;

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

@ -1846,7 +1846,6 @@ var
if (MainInstruction = '') then
MainInstruction := Utf8ToUtf16(IconMessage(TF_DIALOGICON(ADlg.MainIcon)));
Content := Utf8ToUtf16(ADlg.Text);
CollapsedControlText := Utf8ToUtf16(ADlg.ExpandButtonCaption);
VerificationText := Utf8ToUtf16(ADlg.VerificationText);
if (AParentWnd = 0) then
begin
@ -1857,10 +1856,7 @@ var
end;
ExpandedInformation := Utf8ToUtf16(ADlg.ExpandedText);
CollapsedControlText := Utf8ToUtf16(ADlg.ExpandButtonCaption);
//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
ExpandedControlText := Utf8ToUtf16(ADlg.CollapsButtonCaption);
Footer := Utf8ToUtf16(ADlg.FooterText);

19
lcl/taskdlgemulation.pp
View File

@ -7,7 +7,7 @@ interface
uses
Classes, SysUtils,
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;
@ -31,7 +31,7 @@ type
//CustomButtons, Radios: TStringList;
DialogCaption, DlgTitle, DlgText,
ExpandButtonCaption, ExpandedText, FooterText,
ExpandButtonCaption, CollapsButtonCaption, ExpandedText, FooterText,
VerificationText: String;
CommonButtons: TTaskDialogCommonButtons;
@ -525,8 +525,18 @@ begin
//inc(Y, 16);
X := ALeftMargin;
if (ExpandButtonCaption = '') then
ExpandButtonCaption := '>>';
WB := Canvas.TextWidth(ExpandButtonCaption)+32;//52;
begin
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([' XB=', XB]);
debugln([' diff=', X+WB-XB]);
@ -798,6 +808,7 @@ begin
DlgTitle := FDlg.Title;
DlgText := FDlg.Text;
ExpandButtonCaption := FDlg.ExpandButtonCaption;
CollapsButtonCaption := FDlg.CollapsButtonCaption;
ExpandedText := FDlg.ExpandedText;
FooterText := FDlg.FooterText;
VerificationText := FDlg.VerificationText;