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

TaskDialog: TLCLTaskDialog:

Browse Source 
- trying to simplify laying out the controls.
- use more meaningfull variable and constant names.
- cut down on "magic numbers".
- try to use the same left margins everywhere (ToDo: right margins).
- simplify calculation the global margins: now only depends on tfEmulateClassicStyle, not on presence of an icon.
- use a slightly smaller left margin for not tfEmulateClassicStyle (16 instead of 24), looks a bit better when compared to native Vista+ dialog.
- more factoring out.
- as a byproduct: resolves issue #40437.
- less debug output.
This commit is contained in:
Bart 2023-08-09 13:39:06 +02:00
parent 441266a440
commit 321020750e
1 changed files with 182 additions and 160 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

342
lcl/taskdlgemulation.pp
View File

@ -21,6 +21,12 @@ type
{ TLCLTaskDialog } { TLCLTaskDialog }
TLCLTaskDialog = class(TForm) TLCLTaskDialog = class(TForm)
private
const
RadioIndent = 16;
ComboBoxHeight = 22;
LargeImageSize = 32;
SmallImageSize = 16;
private private
/// the Task Dialog structure which created the form /// the Task Dialog structure which created the form
FDlg: TTaskDialog; FDlg: TTaskDialog;
@ -50,17 +56,20 @@ type
/// the Expand/Collaps button /// the Expand/Collaps button
ExpandBtn: TButton; ExpandBtn: TButton;
procedure GetDefaultButtons(out aButtonDef, aRadioDef: TModalResult);
procedure AddIcon(out IconBorder,X,Y: Integer; AParent: TWinControl); procedure InitCaptions;
procedure InitGlobalDimensionsAndStyle(ACustomButtonsTextLength: Integer; out aWidth, aFontHeight: Integer);
function GetGlobalLeftMargin: Integer;
procedure AddIcon(out ALeft,ATop: Integer; AGlobalLeftMargin: Integer; AParent: TWinControl);
procedure AddPanel; procedure AddPanel;
procedure AddRadios(ARadioOffSet, AWidth, ARadioDef, AFontHeight: Integer; var X,Y: Integer; AParent: TWinControl); procedure AddRadios(const ARadioOffSet, AWidth, ARadioDef, AFontHeight, ALeft: Integer; var ATop: Integer; AParent: TWinControl);
procedure AddCommandLinkButtons(var X, Y: Integer; AWidth, AButtonDef, AFontHeight: Integer; AParent: TWinControl); procedure AddCommandLinkButtons(const ALeft: Integer; var ATop: Integer; AWidth, AButtonDef, AFontHeight: Integer; AParent: TWinControl);
procedure AddButtons(var X,Y, XB: Integer; AWidth, AButtonDef: Integer; APArent: TWinControl); procedure AddButtons(const ALeft: Integer; var ATop, AButtonLeft: Integer; AWidth, AButtonDef: Integer; APArent: TWinControl);
procedure AddCheckBox(var X,Y, XB: Integer; AWidth, ALeftMargin: Integer; APArent: TWinControl); procedure AddCheckBox(const ALeft: Integer; var ATop, XB: Integer; AWidth: Integer; APArent: TWinControl);
procedure AddExpandButton(var X,Y, XB: Integer; AWidth, ALeftMargin: Integer; APArent: TWinControl); procedure AddExpandButton(const ALeft: Integer; var ATop, XB: Integer; AWidth: Integer; APArent: TWinControl);
procedure AddFooter(var X, Y, XB: Integer; AFontHeight, AWidth, AIconBorder: Integer; APArent: TWinControl); procedure AddFooter(const ALeft: Integer; var ATop, XB: Integer; AFontHeight, AWidth, AGlobalLeftMargin: Integer; APArent: TWinControl);
function AddLabel(const AText: string; BigFont: boolean; var X, Y: 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): TLabel;
procedure AddQueryCombo(var X,Y: 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;
procedure ResetTimer; procedure ResetTimer;
@ -315,18 +324,88 @@ begin
ARadioRes := i+TaskDialogFirstRadioButtonIndex; ARadioRes := i+TaskDialogFirstRadioButtonIndex;
end; end;
procedure TLCLTaskDialog.GetDefaultButtons(out aButtonDef, aRadioDef: TModalResult);
begin
if FDlg.RadioButtons.DefaultButton<> nil then
aRadioDef := FDlg.RadioButtons.DefaultButton.Index
else
aRadioDef := 0;
if FDlg.Buttons.DefaultButton<>nil then
aButtonDef := FDlg.Buttons.DefaultButton.ModalResult
else
aButtonDef := TD_BTNMOD[FDlg.DefaultButton];
end;
procedure TLCLTaskDialog.InitCaptions;
begin
DialogCaption := FDlg.Caption;
DlgTitle := FDlg.Title;
DlgText := FDlg.Text;
ExpandButtonCaption := FDlg.ExpandButtonCaption;
CollapsButtonCaption := FDlg.CollapsButtonCaption;
ExpandedText := FDlg.ExpandedText;
FooterText := FDlg.FooterText;
VerificationText := FDlg.VerificationText;
if (DialogCaption = '') then
if (Application.MainForm = nil) then
DialogCaption := Application.Title
else
DialogCaption := Application.MainForm.Caption;
if (DlgTitle = '') then
DlgTitle := IconMessage(TF_DIALOGICON(FDlg.MainIcon));
end;
procedure TLCLTaskDialog.AddIcon(out IconBorder,X,Y: Integer; AParent: TWinControl); procedure TLCLTaskDialog.InitGlobalDimensionsAndStyle(ACustomButtonsTextLength: Integer; out aWidth, aFontHeight: Integer);
begin
PixelsPerInch := 96; // we are using 96 PPI in the code, scale it automatically at ShowModal
Font.PixelsPerInch := 96;
BorderStyle := bsDialog;
if (tfAllowDialogCancellation in FDlg.Flags) then
BorderIcons := [biSystemMenu]
else
BorderIcons := [];
if (tfPositionRelativeToWindow in FDlg.Flags) then
Position := poOwnerFormCenter
else
Position := poScreenCenter;
if not (tfEmulateClassicStyle in FDlg.Flags) then
Font := DefaultFont;
aFontHeight := Font.Height;
if (aFontHeight = 0) then
aFontHeight := Screen.SystemFont.Height;
aWidth := FDlg.Width;
if (aWidth <= 0) then
begin
aWidth := Canvas.TextWidth(DlgTitle);
if (aWidth > 300) or (Canvas.TextWidth(DlgText) > 300) or
(ACustomButtonsTextLength > 40) then
aWidth := 480 else
aWidth := 420;
end
else
if (aWidth < 120) then aWidth := 120;
ClientWidth := aWidth;
Height := 200;
//debugln(['Font: Name=',Font.Name,', Size=',Font.Size,', Height=',Font.Height]);
end;
function TLCLTaskDialog.GetGlobalLeftMargin: Integer;
begin
if (tfEmulateClassicStyle in FDlg.Flags) then
Result := 10
else
Result := 16;
end;
procedure TLCLTaskDialog.AddIcon(out ALeft,ATop: Integer; AGlobalLeftMargin: Integer; AParent: TWinControl);
var var
aDialogIcon: TLCLTaskDialogIcon; aDialogIcon: TLCLTaskDialogIcon;
begin begin
if (tfEmulateClassicStyle in FDlg.Flags) then
IconBorder := 10
else
IconBorder := 24;
aDialogIcon := TF_DIALOGICON(FDlg.MainIcon); aDialogIcon := TF_DIALOGICON(FDlg.MainIcon);
if (LCL_IMAGES[aDialogIcon]<>0) then if (LCL_IMAGES[aDialogIcon]<>0) then
begin begin
@ -334,23 +413,21 @@ begin
Image.Parent := AParent; Image.Parent := AParent;
Image.Images := DialogGlyphs; Image.Images := DialogGlyphs;
Image.ImageIndex := DialogGlyphs.DialogIcon[LCL_IMAGES[aDialogIcon]]; Image.ImageIndex := DialogGlyphs.DialogIcon[LCL_IMAGES[aDialogIcon]];
Image.SetBounds(IconBorder,IconBorder, 32, 32); Image.SetBounds(AGlobalLeftMargin, AGlobalLeftMargin, LargeImageSize, LargeImageSize);
Image.Stretch := True; Image.Stretch := True;
Image.StretchOutEnabled := False; Image.StretchOutEnabled := False;
Image.Proportional := True; Image.Proportional := True;
Image.Center := True; Image.Center := True;
X := Image.Width+IconBorder*2; ALeft := Image.Width+AGlobalLeftMargin*2;
Y := Image.Top; ATop := Image.Top;
if (tfEmulateClassicStyle in FDlg.Flags) then if (tfEmulateClassicStyle in FDlg.Flags) then
inc(Y, 8); inc(ATop, 8);
end end
else else
begin begin
Image := nil; Image := nil;
if (not (tfEmulateClassicStyle in FDlg.Flags)) and (DlgTitle <> '') then ALeft := AGlobalLeftMargin;
IconBorder := IconBorder*2; ATop := AGlobalLeftMargin;
X := IconBorder;
Y := IconBorder;
end; end;
end; end;
@ -365,7 +442,7 @@ begin
Panel.Color := clWindow; Panel.Color := clWindow;
end; end;
procedure TLCLTaskDialog.AddRadios(ARadioOffSet, AWidth, ARadioDef, AFontHeight: Integer; var X,Y: Integer; AParent: TWinControl); procedure TLCLTaskDialog.AddRadios(const ARadioOffSet, AWidth, ARadioDef, AFontHeight, ALeft: Integer; var ATop: Integer; AParent: TWinControl);
var var
i: Integer; i: Integer;
aHint: String; aHint: String;
@ -379,24 +456,24 @@ begin
Parent := AParent; Parent := AParent;
Tag := FDlg.RadioButtons[i].Index + TaskDialogFirstRadioButtonIndex; Tag := FDlg.RadioButtons[i].Index + TaskDialogFirstRadioButtonIndex;
AutoSize := False; AutoSize := False;
SetBounds(X+16,Y,aWidth-32-X, (6-AFontHeight) + ARadioOffset); SetBounds(ALeft+RadioIndent,ATop,aWidth-(2*RadioIndent)-ALeft, (6-AFontHeight) + ARadioOffset);
Caption := FDlg.RadioButtons[i].Caption; //LCL RadioButton doesn't support multiline captions Caption := FDlg.RadioButtons[i].Caption;
inc(Y,Height + ARadioOffset); inc(ATop,Height + ARadioOffset);
if not (tfNoDefaultRadioButton in FDlg.Flags) and ((i=0) or (i=aRadioDef)) then if not (tfNoDefaultRadioButton in FDlg.Flags) and ((i=0) or (i=aRadioDef)) then
Checked := True; Checked := True;
OnClick := @OnRadioButtonClick; OnClick := @OnRadioButtonClick;
end; end;
end; end;
inc(Y,24); inc(ATop,24);
end; end;
procedure TLCLTaskDialog.AddCommandLinkButtons(var X, Y: Integer; AWidth, AButtonDef, AFontHeight: Integer; AParent: TWinControl); procedure TLCLTaskDialog.AddCommandLinkButtons(const ALeft: Integer; var ATop: Integer; AWidth, AButtonDef, AFontHeight: Integer; AParent: TWinControl);
var var
i: Integer; i: Integer;
CommandLink: TBitBtn; CommandLink: TBitBtn;
aHint: String; aHint: String;
begin begin
inc(Y,8); inc(ATop,8);
for i := 0 to FDlg.Buttons.Count-1 do for i := 0 to FDlg.Buttons.Count-1 do
begin begin
CommandLink := TBitBtn.Create(Self); CommandLink := TBitBtn.Create(Self);
@ -405,15 +482,15 @@ begin
Parent := AParent; Parent := AParent;
Font.Height := AFontHeight-3; Font.Height := AFontHeight-3;
if (tfEmulateClassicStyle in FDlg.Flags) then if (tfEmulateClassicStyle in FDlg.Flags) then
FCommandLinkButtonWidth := aWidth-10-X FCommandLinkButtonWidth := aWidth-10-ALeft
else else
FCommandLinkButtonWidth := aWidth-16-X; FCommandLinkButtonWidth := aWidth-16-ALeft;
SetBounds(X,Y,FCommandLinkButtonWidth,40); SetBounds(ALeft,ATop,FCommandLinkButtonWidth,40);
Caption := FDlg.Buttons[i].Caption; Caption := FDlg.Buttons[i].Caption;
Hint := FDlg.Buttons[i].CommandLinkHint; Hint := FDlg.Buttons[i].CommandLinkHint;
if (Hint <> '') then if (Hint <> '') then
ShowHint := True; ShowHint := True;
inc(Y,Height+2); inc(ATop,Height+2);
ModalResult := i+TaskDialogFirstButtonIndex; ModalResult := i+TaskDialogFirstButtonIndex;
OnClick := @OnButtonClicked; OnClick := @OnButtonClicked;
if ModalResult=aButtonDef then if ModalResult=aButtonDef then
@ -440,10 +517,10 @@ begin
end; end;
end; end;
end; end;
inc(Y,24); inc(ATop,24);
end; end;
procedure TLCLTaskDialog.AddButtons(var X, Y, XB: Integer; AWidth, AButtonDef: Integer; APArent: TWinControl); procedure TLCLTaskDialog.AddButtons(const ALeft: Integer; var ATop, AButtonLeft: Integer; AWidth, AButtonDef: Integer; APArent: TWinControl);
var var
CurrTabOrder, i: Integer; CurrTabOrder, i: Integer;
Btn: TTaskDialogCommonButton; Btn: TTaskDialogCommonButton;
@ -453,18 +530,18 @@ var
WB: integer; WB: integer;
begin begin
WB := Canvas.TextWidth(s)+52; WB := Canvas.TextWidth(s)+52;
dec(XB,WB); dec(AButtonLeft,WB);
if XB<X shr 1 then if AButtonLeft<ALeft {shr 1} then
begin begin
XB := aWidth-WB; AButtonLeft := aWidth-WB;
inc(Y,32); inc(ATop,32);
end; end;
Result := TButton.Create(Self); Result := TButton.Create(Self);
Result.Parent := AParent; Result.Parent := AParent;
if (tfEmulateClassicStyle in FDlg.Flags) then if (tfEmulateClassicStyle in FDlg.Flags) then
Result.SetBounds(XB,Y,WB-10,22) Result.SetBounds(AButtonLeft,ATop,WB-10,22)
else else
Result.SetBounds(XB,Y,WB-12,28); Result.SetBounds(AButtonLeft,ATop,WB-12,28);
Result.Caption := s; Result.Caption := s;
Result.ModalResult := AModalResult; Result.ModalResult := AModalResult;
Result.TabOrder := CurrTabOrder; Result.TabOrder := CurrTabOrder;
@ -495,9 +572,10 @@ var
ActiveControl := Result; ActiveControl := Result;
end; end;
begin begin
debugln(['TLCLTaskDialog.AddButtons: ALeft=',ALeft,', aWidth=',aWidth,', AParent=',DbgSName(AParent),', AParent.ClientWidth=',AParent.ClientWidth]);
CurrTabOrder := Panel.TabOrder; CurrTabOrder := Panel.TabOrder;
inc(Y, 16); inc(ATop, 16);
XB := aWidth; AButtonLeft := aWidth;
if not (tfUseCommandLinks in FDlg.Flags) then if not (tfUseCommandLinks in FDlg.Flags) then
for i := FDlg.Buttons.Count-1 downto 0 do for i := FDlg.Buttons.Count-1 downto 0 do
AddButton(FDlg.Buttons[i].Caption,i+TaskDialogFirstButtonIndex,i); AddButton(FDlg.Buttons[i].Caption,i+TaskDialogFirstButtonIndex,i);
@ -508,38 +586,35 @@ begin
end; end;
end; end;
procedure TLCLTaskDialog.AddCheckBox(var X, Y, XB: Integer; AWidth, ALeftMargin: Integer; APArent: TWinControl); procedure TLCLTaskDialog.AddCheckBox(const ALeft: Integer; var ATop, XB: Integer; AWidth: Integer; APArent: TWinControl);
begin begin
debugln(['TLCLTaskDialog.AddCheckBox: ALeft=',ALeft]);
VerifyCheckBox := TCheckBox.Create(Self); VerifyCheckBox := TCheckBox.Create(Self);
with VerifyCheckBox do with VerifyCheckBox do
begin begin
Parent := AParent; Parent := AParent;
if (X > ALeftMargin) then if (ALeft+16+Canvas.TextWidth(VerificationText) > XB) then begin
X := ALeftMargin; inc(ATop,32);
if (X+16+Canvas.TextWidth(VerificationText) > XB) then begin
inc(Y,32);
XB := aWidth; XB := aWidth;
end; end;
SetBounds(X,Y,XB-X,24); SetBounds(ALeft,ATop,XB-ALeft,24);
Caption := VerificationText; Caption := VerificationText;
Checked := FVerifyChecked; Checked := FVerifyChecked;
OnClick := @OnVerifyClicked; OnClick := @OnVerifyClicked;
end; end;
end; end;
procedure TLCLTaskDialog.AddExpandButton(var X, Y, XB: Integer; procedure TLCLTaskDialog.AddExpandButton(const ALeft: Integer; var ATop, XB: Integer; AWidth: Integer; APArent: TWinControl);
AWidth, ALeftMargin: Integer; APArent: TWinControl);
var var
CurrTabOrder: TTabOrder; CurrTabOrder: TTabOrder;
WB, AHeight: Integer; WB, AHeight: Integer;
begin begin
CurrTabOrder := Panel.TabOrder; CurrTabOrder := Panel.TabOrder;
//inc(Y, 16);
X := ALeftMargin;
if (ExpandButtonCaption = '') then if (ExpandButtonCaption = '') then
begin begin
if (CollapsButtonCaption = '') then if (CollapsButtonCaption = '') then
begin begin
//ToDo: make this a resourcestring in LCLStrConsts unit
ExpandButtonCaption := 'Show details'; ExpandButtonCaption := 'Show details';
CollapsButtonCaption := 'Hide details'; CollapsButtonCaption := 'Hide details';
end end
@ -549,13 +624,9 @@ begin
if (CollapsButtonCaption = '') then if (CollapsButtonCaption = '') then
CollapsButtonCaption := ExpandButtonCaption; CollapsButtonCaption := ExpandButtonCaption;
WB := Max(Canvas.TextWidth(ExpandButtonCaption), Canvas.TextWidth(CollapsButtonCaption)) +32;//52; WB := Max(Canvas.TextWidth(ExpandButtonCaption), Canvas.TextWidth(CollapsButtonCaption)) +32;//52;
//debugln([' X+WB=', X+WB]); if (ALeft+WB > XB) then
//debugln([' XB=', XB]);
//debugln([' diff=', X+WB-XB]);
if (X+WB > XB) then
begin begin
//debugln('TLCLTaskDialog.AddExpandButton: too wide'); inc(ATop,32);
inc(Y,32);
XB := aWidth; XB := aWidth;
end; end;
@ -565,7 +636,7 @@ begin
AHeight := 22 AHeight := 22
else else
AHeight := 28; AHeight := 28;
ExpandBtn.SetBounds(X,Y,WB-12,AHeight); ExpandBtn.SetBounds(ALeft,ATop,WB-12,AHeight);
if not (tfExpandedByDefault in FDlg.Flags) then if not (tfExpandedByDefault in FDlg.Flags) then
ExpandBtn.Caption := ExpandButtonCaption ExpandBtn.Caption := ExpandButtonCaption
else else
@ -573,29 +644,32 @@ begin
ExpandBtn.ModalResult := mrNone; ExpandBtn.ModalResult := mrNone;
ExpandBtn.TabOrder := CurrTabOrder; ExpandBtn.TabOrder := CurrTabOrder;
ExpandBtn.OnClick := @OnExpandButtonClicked; ExpandBtn.OnClick := @OnExpandButtonClicked;
Inc(Y, AHeight+8); Inc(ATop, AHeight+8);
end; end;
procedure TLCLTaskDialog.AddFooter(var X, Y, XB: Integer; AFontHeight, AWidth, AIconBorder: Integer; APArent: TWinControl); procedure TLCLTaskDialog.AddFooter(const ALeft: Integer; var ATop, XB: Integer; AFontHeight, AWidth, AGlobalLeftMargin: Integer; APArent: TWinControl);
var
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 (Y<Image.Top+Image.Height) then if (Image<>nil) and (ATop<Image.Top+Image.Height) then
BX := X else BX := ALeft else
BX := 2; BX := 2;
SetBounds(BX,Y,aWidth-BX-2,2); SetBounds(BX,ATop,aWidth-BX-2,2);
end; end;
inc(Y,16); inc(ATop,16);
end; end;
begin begin
if XB<>0 then if XB<>0 then
AddBevel AddBevel
else else
inc(Y,16); inc(ATop,16);
if (LCL_FOOTERIMAGES[TF_FOOTERICON(FDlg.FooterIcon)]<>0) then if (LCL_FOOTERIMAGES[TF_FOOTERICON(FDlg.FooterIcon)]<>0) then
begin begin
Image := TImage.Create(Self); Image := TImage.Create(Self);
@ -607,22 +681,22 @@ begin
Image.StretchOutEnabled := False; Image.StretchOutEnabled := False;
Image.Proportional := True; Image.Proportional := True;
Image.Center := True; Image.Center := True;
Image.SetBounds(AIconBorder,Y,16,16); Image.SetBounds(AGlobalLeftMargin,ATop,SmallImageSize,SmallImageSize);
X := 40+Image.Width; ALabelLeft := AGlobalLeftMargin + Aleft + Image.Width;
end end
else else
begin begin
X := 24; ALabelLeft := ALeft;//24;
end; end;
Element[tdeFooter] := AddLabel(FooterText, False, X, Y, AFontHeight, AWidth, AParent); Element[tdeFooter] := AddLabel(FooterText, False, ALabelLeft, ATop, AFontHeight, AWidth, AParent);
end; end;
function TLCLTaskDialog.AddLabel(const AText: string; BigFont: boolean; var X, Y: 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): TLabel;
var var
R: TRect; R: TRect;
W: integer; W: integer;
begin begin
//debugln(['TLCLTaskDialog.AddLabel A: AText=',AText,',X=',X,', AParent=',DbgSName(AParent),', AParent.Width=',AParent.Width,', Self.Width=',Self.Width]); //debugln(['TLCLTaskDialog.AddLabel A: AText=',AText,',X=',ALeft,', AParent=',DbgSName(AParent),', AParent.Width=',AParent.Width,', Self.Width=',Self.Width]);
if (AText = '') then if (AText = '') then
Exit(nil); Exit(nil);
Result := TLabel.Create(Self); Result := TLabel.Create(Self);
@ -645,29 +719,27 @@ begin
Result.AutoSize := False; Result.AutoSize := False;
R.Left := 0; R.Left := 0;
R.Top := 0; R.Top := 0;
W := aWidth-X-8; W := aWidth-ALeft-8;
R.Right := W; R.Right := W;
R.Bottom := Result.Height; R.Bottom := Result.Height;
Result.Caption := AText; Result.Caption := AText;
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);
//debugln(['TLCLTaskDialog.AddLabel before Result.SetBounds(',X,',',Y,',',W,',',R.Bottom,')']); Result.SetBounds(ALeft,ATop,W,R.Bottom);
Result.SetBounds(X,Y,W,R.Bottom); inc(ATop,R.Bottom+16);
//debugln(['TLCLTaskDialog.AddLabel after Result.SetBounds(',X,',',Y,',',W,',',R.Bottom,'), Result.BoundsRect=',DbgS(Result.BoundsRect)]); //debugln(['TLCLTaskDialog.AddLabel End: X=',ALeft,', Result.Left=',Result.Left]);
inc(Y,R.Bottom+16);
//debugln(['TLCLTaskDialog.AddLabel End: X=',X,', Result.Left=',Result.Left]);
end; end;
procedure TLCLTaskDialog.AddQueryCombo(var X, Y: Integer; AWidth: Integer; AParent: TWinControl); procedure TLCLTaskDialog.AddQueryCombo(const ALeft: Integer; var ATop: Integer; AWidth: Integer; AParent: TWinControl);
begin begin
QueryCombo := TComboBox.Create(Self); QueryCombo := TComboBox.Create(Self);
with QueryCombo do with QueryCombo do
begin begin
Items.Assign(FDlg.QueryChoices); Items.Assign(FDlg.QueryChoices);
if (FCommandLinkButtonWidth > 0) then if (FCommandLinkButtonWidth > 0) then
SetBounds(X,Y,FCommandLinkButtonWidth,22) //right align with the buttons SetBounds(ALeft,ATop,FCommandLinkButtonWidth,ComboBoxHeight) //right align with the buttons
else else
SetBounds(X,Y,aWidth-32-X,22); SetBounds(ALeft,ATop,aWidth-32-ALeft,ComboBoxHeight);
if (tfQueryFixedChoices in FDlg.Flags) then if (tfQueryFixedChoices in FDlg.Flags) then
Style := csDropDownList Style := csDropDownList
else else
@ -683,7 +755,7 @@ begin
end; end;
Parent := AParent; Parent := AParent;
end; end;
inc(Y,42); inc(ATop,42);
end; end;
procedure TLCLTaskDialog.AddQueryEdit(var X, Y: Integer; AWidth: Integer; AParent: TWinControl); procedure TLCLTaskDialog.AddQueryEdit(var X, Y: Integer; AWidth: Integer; AParent: TWinControl);
@ -833,7 +905,7 @@ var
aRadioDef, aButtonDef: TModalResult; aRadioDef, aButtonDef: TModalResult;
B: TTaskDialogBaseButtonItem; B: TTaskDialogBaseButtonItem;
ButtonID: Integer; ButtonID: Integer;
ARadioOffset, FontHeight, aWidth, IconBorder, X, Y, i, XB: integer; ARadioOffset, FontHeight, aWidth, GlobalLeftMargin, ALeft, ATop, i, XB: integer;
CurrParent: TWinControl; CurrParent: TWinControl;
aDialogIcon: TLCLTaskDialogIcon; aDialogIcon: TLCLTaskDialogIcon;
CommandLink: TBitBtn; CommandLink: TBitBtn;
@ -844,32 +916,16 @@ var
begin begin
DisableAutoSizing; DisableAutoSizing;
try try
if FDlg.RadioButtons.DefaultButton<> nil then GetDefaultButtons(aButtonDef, aRadioDef);
aRadioDef := FDlg.RadioButtons.DefaultButton.Index
else
aRadioDef := 0;
if FDlg.Buttons.DefaultButton<>nil then
aButtonDef := FDlg.Buttons.DefaultButton.ModalResult
else
aButtonDef := TD_BTNMOD[FDlg.DefaultButton];
CustomButtonsTextLength := 0; CustomButtonsTextLength := 0;
for B in FDlg.Buttons do for B in FDlg.Buttons do
CustomButtonsTextLength := CustomButtonsTextLength + Length(B.Caption); CustomButtonsTextLength := CustomButtonsTextLength + Length(B.Caption);
InitCaptions;
DialogCaption := FDlg.Caption;
DlgTitle := FDlg.Title;
DlgText := FDlg.Text;
ExpandButtonCaption := FDlg.ExpandButtonCaption;
CollapsButtonCaption := FDlg.CollapsButtonCaption;
ExpandedText := FDlg.ExpandedText;
FooterText := FDlg.FooterText;
VerificationText := FDlg.VerificationText;
FVerifyChecked := (tfVerificationFlagChecked in FDlg.Flags); FVerifyChecked := (tfVerificationFlagChecked in FDlg.Flags);
CommonButtons := FDlg.CommonButtons; CommonButtons := FDlg.CommonButtons;
if (CommonButtons=[]) and (FDlg.Buttons.Count=0) then if (CommonButtons=[]) and (FDlg.Buttons.Count=0) then
begin begin
CommonButtons := [tcbOk]; CommonButtons := [tcbOk];
@ -877,48 +933,8 @@ begin
aButtonDef := mrOk; aButtonDef := mrOk;
end; end;
if (DialogCaption = '') then InitGlobalDimensionsAndStyle(CustomButtonsTextLength, aWidth, FontHeight);
if (Application.MainForm = nil) then
DialogCaption := Application.Title
else
DialogCaption := Application.MainForm.Caption;
if (DlgTitle = '') then
DlgTitle := IconMessage(TF_DIALOGICON(FDlg.MainIcon));
PixelsPerInch := 96; // we are using 96 PPI in the code, scale it automatically at ShowModal
Font.PixelsPerInch := 96;
BorderStyle := bsDialog;
if (tfAllowDialogCancellation in FDlg.Flags) then
BorderIcons := [biSystemMenu]
else
BorderIcons := [];
if (tfPositionRelativeToWindow in FDlg.Flags) then
Position := poOwnerFormCenter
else
Position := poScreenCenter;
if not (tfEmulateClassicStyle in FDlg.Flags) then
Font := DefaultFont;
FontHeight := Font.Height;
if (FontHeight = 0) then
FontHeight := Screen.SystemFont.Height;
aWidth := FDlg.Width;
if (aWidth <= 0) then
begin
aWidth := Canvas.TextWidth(DlgTitle);
if (aWidth > 300) or (Canvas.TextWidth(DlgText) > 300) or
(CustomButtonsTextLength > 40) then
aWidth := 480 else
aWidth := 420;
end
else
if (aWidth < 120) then aWidth := 120;
ClientWidth := aWidth;
Height := TaskDialogFirstRadioButtonIndex;
Caption := DialogCaption; Caption := DialogCaption;
// create a white panel for the main dialog part // create a white panel for the main dialog part
@ -926,64 +942,70 @@ begin
CurrParent := Panel; CurrParent := Panel;
// handle main dialog icon // handle main dialog icon
AddIcon(IconBorder, X, Y, CurrParent); GlobalLeftMargin := GetGlobalLeftMargin;
AddIcon(ALeft, ATop, GlobalLeftMargin, CurrParent);
//debugln('SetupControls');
//debugln([' GlobalLeftMargin=',GlobalLeftMargin]);
//debugln([' ALeft=',ALeft]);
//debugln([' ATop=',ATop]);
// add main texts (DlgTitle, DlgText, Information) // add main texts (DlgTitle, DlgText, Information)
Element[tdeMainInstruction] := AddLabel(DlgTitle, True, X, Y, FontHeight, aWidth, CurrParent); Element[tdeMainInstruction] := AddLabel(DlgTitle, True, ALeft, ATop, FontHeight, aWidth, CurrParent);
Element[tdeContent] := AddLabel(DlgText, False, X, Y, FontHeight, aWidth, CurrParent); Element[tdeContent] := AddLabel(DlgText, False, ALeft, ATop, 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, X, Y, FontHeight, aWidth, CurrParent); Element[tdeExpandedInfo] := AddLabel(ExpandedText, False, ALeft, ATop, FontHeight, aWidth, CurrParent);
// add radio CustomButtons // add radio CustomButtons
if (FDlg.RadioButtons.Count > 0) then if (FDlg.RadioButtons.Count > 0) then
begin begin
ARadioOffset := 1; ARadioOffset := 1;
AddRadios(ARadioOffSet, aWidth, aRadioDef, FontHeight, X, Y, CurrParent); AddRadios(ARadioOffSet, aWidth, aRadioDef, FontHeight, ALeft, ATop, CurrParent);
end; end;
// add command links CustomButtons // add command links CustomButtons
if (tfUseCommandLinks in FDlg.Flags) and (FDlg.Buttons.Count<>0) then if (tfUseCommandLinks in FDlg.Flags) and (FDlg.Buttons.Count<>0) then
AddCommandLinkButtons(X, Y, aWidth, aButtonDef, FontHeight, CurrParent); AddCommandLinkButtons(ALeft, ATop, aWidth, aButtonDef, FontHeight, CurrParent);
// add query combobox list or QueryEdit // add query combobox list or QueryEdit
if (tfQuery in FDlg.Flags) and (FDlg.QueryChoices.Count > 0) then if (tfQuery in FDlg.Flags) and (FDlg.QueryChoices.Count > 0) then
AddQueryCombo(X, Y, aWidth, CurrParent) AddQueryCombo(ALeft, ATop, aWidth, CurrParent)
else else
begin begin
if (tfSimpleQuery in FDlg.Flags) and (FDlg.SimpleQuery <> '') then if (tfSimpleQuery in FDlg.Flags) and (FDlg.SimpleQuery <> '') then
AddQueryEdit(X, Y, aWidth, CurrParent); AddQueryEdit(ALeft, ATop, aWidth, CurrParent);
end; end;
// from now we won't add components to the white panel, but to the form // from now we won't add components to the white panel, but to the form
Panel.Height := Y; Panel.Height := ATop;
CurrParent := Self; CurrParent := Self;
XB := 0; XB := 0;
ALeft := GlobalLeftMargin; //Left most margin of the form
// add CustomButtons and verification checkbox // add CustomButtons and verification checkbox
if (CommonButtons <> []) or if (CommonButtons <> []) or
((FDlg.Buttons.Count<>0) and not (tfUseCommandLinks in FDlg.Flags)) then ((FDlg.Buttons.Count<>0) and not (tfUseCommandLinks in FDlg.Flags)) then
begin begin
AddButtons(X, Y, XB, aWidth, aButtonDef, CurrParent); AddButtons(ALeft, ATop, XB, aWidth, aButtonDef, CurrParent);
end; end;
//Add Expand button //Add Expand button
if (ExpandedText <> '') then if (ExpandedText <> '') then
AddExpandButton(X, Y, XB, aWidth, IconBorder, CurrParent); AddExpandButton(ALeft, ATop, XB, aWidth, CurrParent);
if (VerificationText <> '') then if (VerificationText <> '') then
AddCheckBox(X, Y, XB, aWidth, IconBorder, CurrParent); AddCheckBox(ALeft, ATop, XB, aWidth, CurrParent);
inc(Y,36); inc(ATop,36);
// add FooterText text with optional icon // add FooterText text with optional icon
if (FooterText <> '') then if (FooterText <> '') then
AddFooter(X, Y, XB, FontHeight, aWidth, IconBorder, CurrParent); AddFooter(ALeft, ATop, XB, FontHeight, aWidth, GlobalLeftMargin, CurrParent);
ClientHeight := Y; ClientHeight := ATop;
if (tfCallBackTimer in FDlg.Flags) then if (tfCallBackTimer in FDlg.Flags) then
SetupTimer; SetupTimer;