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

TaskDialog: TLCLTaskDialog: implement Expand/Collapse. Resolves issues ##31397 and ##31396.

Browse Source
This commit is contained in:
Bart 2023-08-16 23:39:04 +02:00
parent 95ebf74b26
commit 925b576e48
1 changed files with 124 additions and 55 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

179
lcl/taskdlgemulation.pp
View File

@ -68,7 +68,10 @@ type
SmallImageSize = 16; SmallImageSize = 16;
CommandLinkButtonHeight = 40; CommandLinkButtonHeight = 40;
RadioVSpacing = 16; RadioVSpacing = 16;
LabelVSpacing = 16;
CommandLinkButtonVSpacing = 2; CommandLinkButtonVSpacing = 2;
BevelMargin = 2;
BevelHeight = 2;
private private
/// the Task Dialog structure which created the form /// the Task Dialog structure which created the form
FDlg: TTaskDialog; FDlg: TTaskDialog;
@ -79,6 +82,7 @@ type
CommandLinkButtonSpacing: Integer; //Height of TBitBtns CommandLinkButtonSpacing: Integer; //Height of TBitBtns
ButtonHeight: Integer; //Height of TButtons ButtonHeight: Integer; //Height of TButtons
GlobalLeftMargin: Integer; GlobalLeftMargin: Integer;
ExpandHeightRequired: Integer;
Timer: TTimer; Timer: TTimer;
TimerStartTime: TTime; TimerStartTime: TTime;
RadioButtonArray: array of TRadioButton; RadioButtonArray: array of TRadioButton;
@ -92,7 +96,9 @@ type
TopPanel: TPanel; TopPanel: TPanel;
MidPanel: TPanel; MidPanel: TPanel;
BottomPanel: TPanel; BottomPanel: TPanel;
Image: TImage; MainImage: TImage;
FooterImage: TImage;
ExpandedTextBevel: TBevel;
/// the labels corresponding to the Task Dialog main elements /// the labels corresponding to the Task Dialog main elements
Element: array[tdeContent..tdeMainInstruction] of TLabel; Element: array[tdeContent..tdeMainInstruction] of TLabel;
/// the Task Dialog query selection list /// the Task Dialog query selection list
@ -115,8 +121,10 @@ type
procedure AddButtons(const ALeft: Integer; var ATop, AButtonLeft: Integer; AWidth, AButtonDef: Integer; APArent: TWinControl); procedure AddButtons(const ALeft: Integer; var ATop, AButtonLeft: Integer; AWidth, AButtonDef: Integer; APArent: TWinControl);
procedure AddCheckBox(const ALeft: Integer; var ATop, XB: Integer; AWidth: Integer; APArent: TWinControl); procedure AddCheckBox(const ALeft: Integer; var ATop, XB: Integer; AWidth: Integer; APArent: TWinControl);
procedure AddExpandButton(const ALeft: Integer; var ATop, XB: Integer; AWidth: Integer; APArent: TWinControl); procedure AddExpandButton(const ALeft: Integer; var ATop, XB: Integer; AWidth: Integer; APArent: TWinControl);
function AddBevel(var ATop: Integer; aWidth: Integer; AParent: TWinControl; Hidden: Boolean = False): TBevel;
procedure AddFooter(const ALeft: Integer; var ATop, XB: Integer; AFontHeight, AWidth: Integer; APArent: TWinControl); procedure AddFooter(const ALeft: Integer; var ATop, XB: Integer; AFontHeight, AWidth: Integer; APArent: TWinControl);
function AddLabel(const AText: string; BigFont: Boolean; const ALeft: Integer; var ATop: Integer; AFontHeight, AWidth: Integer; APArent: TWinControl): TLabel; function AddLabel(const AText: string; BigFont: Boolean; const ALeft: Integer; var ATop: Integer; AFontHeight,
AWidth: Integer; APArent: TWinControl; Hidden: Boolean = False): TLabel;
procedure AddQueryCombo(const ALeft: Integer; var ATop: Integer; AWidth: Integer; AParent: TWinControl); procedure AddQueryCombo(const ALeft: Integer; var ATop: Integer; AWidth: Integer; AParent: TWinControl);
procedure AddQueryEdit(var X,Y: Integer; AWidth: Integer; AParent: TWinControl); procedure AddQueryEdit(var X,Y: Integer; AWidth: Integer; AParent: TWinControl);
procedure SetupTimer; procedure SetupTimer;
@ -469,23 +477,23 @@ begin
aDialogIcon := TF_DIALOGICON(FDlg.MainIcon); aDialogIcon := TF_DIALOGICON(FDlg.MainIcon);
if (LCL_IMAGES[aDialogIcon]<>0) then if (LCL_IMAGES[aDialogIcon]<>0) then
begin begin
Image := TImage.Create(Self); MainImage := TImage.Create(Self);
Image.Parent := AParent; MainImage.Parent := AParent;
Image.Images := DialogGlyphs; MainImage.Images := DialogGlyphs;
Image.ImageIndex := DialogGlyphs.DialogIcon[LCL_IMAGES[aDialogIcon]]; MainImage.ImageIndex := DialogGlyphs.DialogIcon[LCL_IMAGES[aDialogIcon]];
Image.SetBounds(AGlobalLeftMargin, AGlobalLeftMargin, LargeImageSize, LargeImageSize); MainImage.SetBounds(AGlobalLeftMargin, AGlobalLeftMargin, LargeImageSize, LargeImageSize);
Image.Stretch := True; MainImage.Stretch := True;
Image.StretchOutEnabled := False; MainImage.StretchOutEnabled := False;
Image.Proportional := True; MainImage.Proportional := True;
Image.Center := True; MainImage.Center := True;
ALeft := Image.Width+AGlobalLeftMargin*2; ALeft := MainImage.Width+AGlobalLeftMargin*2;
ATop := Image.Top; ATop := MainImage.Top;
if (tfEmulateClassicStyle in FDlg.Flags) then if (tfEmulateClassicStyle in FDlg.Flags) then
inc(ATop, 8); inc(ATop, 8);
end end
else else
begin begin
Image := nil; MainImage := nil;
ALeft := AGlobalLeftMargin; ALeft := AGlobalLeftMargin;
ATop := AGlobalLeftMargin; ATop := AGlobalLeftMargin;
end; end;
@ -732,51 +740,69 @@ begin
Inc(ATop, AHeight+8); Inc(ATop, AHeight+8);
end; end;
function TLCLTaskDialog.AddBevel(var ATop: Integer; aWidth: Integer; AParent: TWinControl; Hidden: Boolean): TBevel;
begin
Result := TBevel.Create(Self);
with Result do begin
Parent := AParent;
//if (FooterImage<>nil) and (ATop<FooterImage.Top+FooterImage.Height) then
// BX := ALeft else
// BX := BevelMargin;
SetBounds(BevelMargin,ATop,aWidth-2*BevelMargin,BevelHeight);
if Hidden then
Visible := False
else
Inc(ATop, BevelHeight);
end;
end;
procedure TLCLTaskDialog.AddFooter(const ALeft: Integer; var ATop, XB: Integer; AFontHeight, AWidth: Integer; APArent: TWinControl); procedure TLCLTaskDialog.AddFooter(const ALeft: Integer; var ATop, XB: Integer; AFontHeight, AWidth: Integer; APArent: TWinControl);
var var
ALabelLeft: Integer; ALabelLeft: Integer;
(*
procedure AddBevel; procedure AddBevel;
var var
BX: integer; BX: integer;
begin begin
with TBevel.Create(Self) do begin with TBevel.Create(Self) do begin
Parent := AParent; Parent := AParent;
if (Image<>nil) and (ATop<Image.Top+Image.Height) then //if (FooterImage<>nil) and (ATop<FooterImage.Top+FooterImage.Height) then
BX := ALeft else // BX := ALeft else
BX := 2; // BX := BevelMargin;
SetBounds(BX,ATop,aWidth-BX-2,2); SetBounds(BevelMargin,ATop,aWidth-2*BevelMargin,BevelHeight);
end; end;
inc(ATop,16);
end; end;
*)
begin begin
if XB<>0 then debugln(['AddFooterText: XB=',XB]);
AddBevel //if XB<>0 then
else AddBevel(ATop, aWidth, AParent);
inc(ATop,16); inc(ATop,LabelVSPacing div 2);
if (LCL_FOOTERIMAGES[TF_FOOTERICON(FDlg.FooterIcon)]<>0) then if (LCL_FOOTERIMAGES[TF_FOOTERICON(FDlg.FooterIcon)]<>0) then
begin begin
Image := TImage.Create(Self); FooterImage := TImage.Create(Self);
Image.Parent := AParent; FooterImage.Parent := AParent;
Image.Images := DialogGlyphs; FooterImage.Images := DialogGlyphs;
Image.ImageWidth := 16; FooterImage.ImageWidth := 16;
Image.ImageIndex := DialogGlyphs.DialogIcon[LCL_FOOTERIMAGES[TF_FOOTERICON(FDlg.FooterIcon)]]; FooterImage.ImageIndex := DialogGlyphs.DialogIcon[LCL_FOOTERIMAGES[TF_FOOTERICON(FDlg.FooterIcon)]];
Image.Stretch := True; FooterImage.Stretch := True;
Image.StretchOutEnabled := False; FooterImage.StretchOutEnabled := False;
Image.Proportional := True; FooterImage.Proportional := True;
Image.Center := True; FooterImage.Center := True;
Image.SetBounds(GlobalLeftMargin,ATop,SmallImageSize,SmallImageSize); FooterImage.SetBounds(GlobalLeftMargin,ATop,SmallImageSize,SmallImageSize);
ALabelLeft := GlobalLeftMargin + Aleft + Image.Width; ALabelLeft := GlobalLeftMargin + Aleft + MainImage.Width;
end end
else else
begin begin
ALabelLeft := ALeft;//24; ALabelLeft := ALeft;//24;
end; end;
Element[tdeFooter] := AddLabel(FooterText, False, ALabelLeft, ATop, AFontHeight, AWidth, AParent); Element[tdeFooter] := AddLabel(FooterText, False, ALabelLeft, ATop, AFontHeight, AWidth, AParent);
Dec(ATop, LabelVSpacing div 2);
end; end;
function TLCLTaskDialog.AddLabel(const AText: string; BigFont: Boolean; const ALeft: Integer; var ATop: Integer; AFontHeight, AWidth: Integer; APArent: TWinControl): TLabel; function TLCLTaskDialog.AddLabel(const AText: string; BigFont: Boolean; const ALeft: Integer; var ATop: Integer; AFontHeight,
AWidth: Integer; APArent: TWinControl; Hidden: Boolean = False): TLabel;
var var
R: TRect; R: TRect;
W: integer; W: integer;
@ -811,7 +837,12 @@ begin
Result.Parent := AParent; Result.Parent := AParent;
LCLIntf.DrawText(Result.Canvas.Handle,PChar(AText),Length(AText),R,DT_CALCRECT or DT_WORDBREAK); LCLIntf.DrawText(Result.Canvas.Handle,PChar(AText),Length(AText),R,DT_CALCRECT or DT_WORDBREAK);
Result.SetBounds(ALeft,ATop,W,R.Bottom); Result.SetBounds(ALeft,ATop,W,R.Bottom);
inc(ATop,R.Bottom+RadioVSpacing); if not Hidden then
inc(ATop,R.Bottom+LabelVSpacing)
else
Result.Visible := False;
//else
// ExpandHeightRequired := R.Bottom+LabelVSpacing;
//debugln(['TLCLTaskDialog.AddLabel End: X=',ALeft,', Result.Left=',Result.Left]); //debugln(['TLCLTaskDialog.AddLabel End: X=',ALeft,', Result.Left=',Result.Left]);
end; end;
@ -928,14 +959,36 @@ end;
procedure TLCLTaskDialog.ExpandDialog; procedure TLCLTaskDialog.ExpandDialog;
begin begin
ExpandBtn.Caption := ExpandButtonCaption; ExpandBtn.Caption := CollapseButtonCaption;
//ToDo: actually expand the dialog if not (tfExpandFooterArea in FDlg.Flags) then
begin
Element[tdeExpandedInfo].Parent.Height := Element[tdeExpandedInfo].Parent.Height + ExpandHeightRequired;
Height := Height + ExpandHeightRequired;
Element[tdeExpandedInfo].Visible := True;
end
else
begin
Height := Height + ExpandHeightRequired;
ExpandedTextBevel.Visible := True;
Element[tdeExpandedInfo].Visible := True;
end;
end; end;
procedure TLCLTaskDialog.CollapseDialog; procedure TLCLTaskDialog.CollapseDialog;
begin begin
ExpandBtn.Caption := CollapseButtonCaption; ExpandBtn.Caption := ExpandButtonCaption;
//ToDo: actually collapse the dialog if not (tfExpandFooterArea in FDlg.Flags) then
begin
Element[tdeExpandedInfo].Visible := False;
Element[tdeExpandedInfo].Parent.Height := Element[tdeExpandedInfo].Parent.Height - ExpandHeightRequired;
Height := Height - ExpandHeightRequired;
end
else
begin
ExpandedTextBevel.Visible := False;
Element[tdeExpandedInfo].Visible := False;
Height := Height - ExpandHeightRequired;
end;
end; end;
procedure TLCLTaskDialog.DoDialogConstructed; procedure TLCLTaskDialog.DoDialogConstructed;
@ -1037,9 +1090,13 @@ begin
// add main texts (DlgTitle, DlgText, Information) // add main texts (DlgTitle, DlgText, Information)
Element[tdeMainInstruction] := AddLabel(DlgTitle, True, ALeft, ATop, FontHeight, aWidth, CurrParent); Element[tdeMainInstruction] := AddLabel(DlgTitle, True, ALeft, ATop, FontHeight, aWidth, CurrParent);
Element[tdeContent] := AddLabel(DlgText, False, ALeft, ATop, FontHeight, aWidth, CurrParent); Element[tdeContent] := AddLabel(DlgText, False, ALeft, ATop, FontHeight, aWidth, CurrParent);
if (ExpandedText <> '') then if (ExpandedText <> '') and not (tfExpandFooterArea in FDlg.Flags) then
// no information collapse/expand yet: it's always expanded begin
Element[tdeExpandedInfo] := AddLabel(ExpandedText, False, ALeft, ATop, FontHeight, aWidth, CurrParent); Element[tdeExpandedInfo] := AddLabel(ExpandedText, False, ALeft, ATop, FontHeight, aWidth, CurrParent, not (tfExpandedByDefault in Fdlg.Flags));
ExpandHeightRequired := Element[tdeExpandedInfo].Height + LabelVSPacing;
//debugln(['ExpandHeightRequired=',ExpandHeightRequired]);
end;
TopPanel.Height := ATop; TopPanel.Height := ATop;
CurrParent := MidPanel; CurrParent := MidPanel;
@ -1085,6 +1142,7 @@ begin
//Add Expand button //Add Expand button
if (ExpandedText <> '') then if (ExpandedText <> '') then
AddExpandButton(GlobalLeftMargin, ATop, XB, aWidth, CurrParent); AddExpandButton(GlobalLeftMargin, ATop, XB, aWidth, CurrParent);
FExpanded := (ExpandedText <> '') and (tfExpandedByDefault in FDlg.Flags);
if (VerificationText <> '') then if (VerificationText <> '') then
AddCheckBox(GlobalLeftMargin, ATop, XB, aWidth, CurrParent); AddCheckBox(GlobalLeftMargin, ATop, XB, aWidth, CurrParent);
@ -1096,20 +1154,31 @@ begin
if (FooterText <> '') then if (FooterText <> '') then
AddFooter(GlobalLeftMargin, ATop, XB, FontHeight, aWidth, CurrParent); AddFooter(GlobalLeftMargin, ATop, XB, FontHeight, aWidth, CurrParent);
ClientHeight := TopPanel.Height + MidPanel.Height + ATop; if (ExpandedText <> '') and (tfExpandFooterArea in FDlg.Flags) then
begin
ExpandedTextBevel := AddBevel(ATop, aWidth, CurrParent, not FExpanded);
Inc(ATop, LabelVSpacing div 2);
Element[tdeExpandedInfo] := AddLabel(ExpandedText, False, ALeft, ATop, FontHeight, aWidth, CurrParent, not FExpanded);
if (tfCallBackTimer in FDlg.Flags) then ExpandHeightRequired := Element[tdeExpandedInfo].Height + BevelHeight + (LabelVSPacing {div 2});
SetupTimer; //debugln(['ExpandHeightRequired=',ExpandHeightRequired]);
//if not FExpanded then
Dec(ATop, LabelVSpacing div 2);
end;
//AddButtons (which comes after adding query) may have set ActiveControl ClientHeight := TopPanel.Height + MidPanel.Height + ATop;
//so do this here and not in AddQueryCombo or AddQueryEdit
if Assigned(QueryCombo) and (tfQueryFocused in FDlg.Flags) then if (tfCallBackTimer in FDlg.Flags) then
ActiveControl := QueryCombo SetupTimer;
else
if Assigned(QueryEdit) and (tfQueryFocused in FDlg.Flags) then //AddButtons (which comes after adding query) may have set ActiveControl
ActiveControl := QueryEdit; //so do this here and not in AddQueryCombo or AddQueryEdit
if Assigned(QueryCombo) and (tfQueryFocused in FDlg.Flags) then
ActiveControl := QueryCombo
else
if Assigned(QueryEdit) and (tfQueryFocused in FDlg.Flags) then
ActiveControl := QueryEdit;
FExpanded := (tfExpandedByDefault in FDlg.Flags);
finally finally
EnableAutoSizing; EnableAutoSizing;
end; end;