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

Refactoring TTaskDialog: TLCLTaskDialog: factor out AddLabel.

Browse Source
This commit is contained in:
Bart 2023-07-22 15:39:34 +02:00
parent 17fee115bf
commit 30ed531405
1 changed files with 43 additions and 84 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

127
lcl/taskdlgemulation.pp
View File

@ -50,6 +50,7 @@ type
procedure AddCommandLinkButtons(var X, Y: Integer; AWidth, AButtonDef, AFontHeight: Integer; AParent: TWinControl); procedure AddCommandLinkButtons(var X, Y: Integer; AWidth, AButtonDef, AFontHeight: Integer; AParent: TWinControl);
procedure AddButtonsAndCheckBox(var X,Y, XB: Integer; AWidth, AButtonDef: Integer; APArent: TWinControl); procedure AddButtonsAndCheckBox(var X,Y, XB: Integer; AWidth, AButtonDef: Integer; APArent: TWinControl);
procedure AddFooter(var X, Y, XB: Integer; AFontHeight, AWidth: Integer; APArent: TWinControl); procedure AddFooter(var X, Y, XB: Integer; AFontHeight, AWidth: Integer; APArent: TWinControl);
function AddLabel(const AText: string; BigFont: boolean; var X, Y: Integer; AFontHeight, AWidth: Integer; APArent: TWinControl): TLabel;
protected protected
procedure HandleEmulatedButtonClicked(Sender: TObject); procedure HandleEmulatedButtonClicked(Sender: TObject);
@ -525,45 +526,6 @@ procedure TLCLTaskDialog.AddFooter(var X, Y, XB: Integer; AFontHeight, AWidth: I
inc(Y,16); inc(Y,16);
end; end;
function AddLabel(Text: string; BigFont: boolean): TLabel;
var R: TRect;
W: integer;
begin
if Text = '' then
exit(nil);
Result := TLabel.Create(Self);
Result.Parent := AParent;
Result.WordWrap := True;
if BigFont then
begin
if (tfEmulateClassicStyle in FDlg.Flags) then
begin
Result.Font.Height := AFontHeight-2;
Result.Font.Style := [fsBold]
end
else
begin
Result.Font.Height := AFontHeight-4;
Result.Font.Color := clHighlight;
end;
end
else
Result.Font.Height := AFontHeight;
Result.AutoSize := False;
R.Left := 0;
R.Top := 0;
W := aWidth-X-8;
R.Right := W;
R.Bottom := Result.Height;
LCLIntf.DrawText(Result.Canvas.Handle,PChar(Text),Length(Text),R,DT_CALCRECT or DT_WORDBREAK);//lazarus does not return box height on OSX (Lazarus bug), the height is stored in the rect in all cases, so we don't need to use the Result
Result.SetBounds(X,Y,W,R.Bottom);
Result.Caption := Text;
inc(Y,R.Bottom+16);
end;
begin begin
if XB<>0 then if XB<>0 then
AddBevel AddBevel
@ -587,10 +549,48 @@ begin
begin begin
X := 24; X := 24;
end; end;
Element[tdeFooter] := AddLabel(FooterText, False); Element[tdeFooter] := AddLabel(FooterText, False, X, Y, AFontHeight, AWidth, AParent);
end; end;
function TLCLTaskDialog.AddLabel(const AText: string; BigFont: boolean; var X, Y: Integer; AFontHeight, AWidth: Integer; APArent: TWinControl): TLabel;
var
R: TRect;
W: integer;
begin
if (AText = '') then
Exit(nil);
Result := TLabel.Create(Self);
Result.Parent := AParent;
Result.WordWrap := True;
if BigFont then
begin
if (tfEmulateClassicStyle in FDlg.Flags) then
begin
Result.Font.Height := AFontHeight-2;
Result.Font.Style := [fsBold]
end
else
begin
Result.Font.Height := AFontHeight-4;
Result.Font.Color := clHighlight;
end;
end
else
Result.Font.Height := AFontHeight;
Result.AutoSize := False;
R.Left := 0;
R.Top := 0;
W := aWidth-X-8;
R.Right := W;
R.Bottom := Result.Height;
LCLIntf.DrawText(Result.Canvas.Handle,PChar(Text),Length(Text),R,DT_CALCRECT or DT_WORDBREAK);//lazarus does not return box height on OSX (Lazarus bug), the height is stored in the rect in all cases, so we don't need to use the Result
Result.SetBounds(X,Y,W,R.Bottom);
Result.Caption := AText;
inc(Y,R.Bottom+16);
end;
procedure TLCLTaskDialog.HandleEmulatedButtonClicked(Sender: TObject); procedure TLCLTaskDialog.HandleEmulatedButtonClicked(Sender: TObject);
var Btn: TButton absolute Sender; var Btn: TButton absolute Sender;
CanClose: Boolean; CanClose: Boolean;
@ -616,47 +616,6 @@ var
aHint: String; aHint: String;
List: TStringListUTF8Fast; List: TStringListUTF8Fast;
Btn: TTaskDialogCommonButton; Btn: TTaskDialogCommonButton;
function AddLabel(Text: string; BigFont: boolean): TLabel;
var R: TRect;
W: integer;
begin
if Text = '' then
exit(nil);
Result := TLabel.Create(Self);
Result.Parent := CurrParent;
Result.WordWrap := True;
if BigFont then
begin
if (tfEmulateClassicStyle in FDlg.Flags) then
begin
Result.Font.Height := FontHeight-2;
Result.Font.Style := [fsBold]
end
else
begin
Result.Font.Height := FontHeight-4;
Result.Font.Color := clHighlight;
end;
end
else
Result.Font.Height := FontHeight;
Result.AutoSize := False;
R.Left := 0;
R.Top := 0;
W := aWidth-X-8;
R.Right := W;
R.Bottom := Result.Height;
LCLIntf.DrawText(Result.Canvas.Handle,PChar(Text),Length(Text),R,DT_CALCRECT or DT_WORDBREAK);//lazarus does not return box height on OSX (Lazarus bug), the height is stored in the rect in all cases, so we don't need to use the Result
Result.SetBounds(X,Y,W,R.Bottom);
Result.Caption := Text;
inc(Y,R.Bottom+16);
end;
begin begin
if FDlg.RadioButtons.DefaultButton<> nil then if FDlg.RadioButtons.DefaultButton<> nil then
@ -753,11 +712,11 @@ begin
SetupIcon(IconBorder, X, Y, CurrParent); SetupIcon(IconBorder, X, Y, CurrParent);
// add main texts (DlgTitle, DlgText, Information) // add main texts (DlgTitle, DlgText, Information)
Element[tdeMainInstruction] := AddLabel(DlgTitle, True); Element[tdeMainInstruction] := AddLabel(DlgTitle, True, X, Y, FontHeight, aWidth, CurrParent);
Element[tdeContent] := AddLabel(DlgText, False); Element[tdeContent] := AddLabel(DlgText, False, X, Y, FontHeight, aWidth, CurrParent);
if (ExpandedText <> '') then if (ExpandedText <> '') then
// no information collapse/expand yet: it's always expanded // no information collapse/expand yet: it's always expanded
Element[tdeExpandedInfo] := AddLabel(ExpandedText, False); Element[tdeExpandedInfo] := AddLabel(ExpandedText, False, X, Y, FontHeight, aWidth, CurrParent);
// add radio CustomButtons // add radio CustomButtons