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

TTaskDialog: Start implementing TTaskDialog.ProgressBar for emulated dialog.

Browse Source
This commit is contained in:
Bart 2023-08-25 19:12:26 +02:00
parent f8ee1f55bb
commit a397741a99
2 changed files with 29 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
lcl/dialogs.pp
View File

@ -669,11 +669,11 @@ Type
procedure Initialize; //call after dialog has been instatiated to send message to the dialog window procedure Initialize; //call after dialog has been instatiated to send message to the dialog window
procedure SetRange(AMin, AMax: Integer); procedure SetRange(AMin, AMax: Integer);
published published
property MarqueeSpeed: Cardinal read FMarqueeSpeed write SetMarqueeSpeed default 0; property MarqueeSpeed: Cardinal read FMarqueeSpeed write SetMarqueeSpeed default 0; //Vista+ native dialog only
property Max: Integer read FMax write SetMax default 100; property Max: Integer read FMax write SetMax default 100;
property Min: Integer read FMin write SetMin default 0; property Min: Integer read FMin write SetMin default 0;
property Position: Integer read FPosition write SetPosition default 0; property Position: Integer read FPosition write SetPosition default 0;
property State: TProgressBarState read FState write SetState default pbsNormal; property State: TProgressBarState read FState write SetState default pbsNormal; //Vista+ native dialog only
end; end;

28
lcl/taskdlgemulation.pp
View File

@ -45,7 +45,7 @@ interface
uses uses
Classes, SysUtils, Classes, SysUtils,
LazUTF8, LazUTF8,
LCLType, LCLStrConsts, LCLIntf, InterfaceBase, ImgList, LCLProc, DateUtils, Math, LCLType, LCLStrConsts, LCLIntf, InterfaceBase, ImgList, LCLProc, DateUtils, Math, ComCtrls,
LResources, Menus, Graphics, Forms, Controls, StdCtrls, ExtCtrls, Buttons, Dialogs, DialogRes; LResources, Menus, Graphics, Forms, Controls, StdCtrls, ExtCtrls, Buttons, Dialogs, DialogRes;
@ -72,6 +72,8 @@ type
CommandLinkButtonVSpacing = 2; CommandLinkButtonVSpacing = 2;
BevelMargin = 2; BevelMargin = 2;
BevelHeight = 2; BevelHeight = 2;
ProgressBarHeight = 20;
ProgressBarVSpacing = 16;
private private
/// the Task Dialog structure which created the form /// the Task Dialog structure which created the form
FDlg: TTaskDialog; FDlg: TTaskDialog;
@ -109,6 +111,8 @@ type
VerifyCheckBox: TCheckBox; VerifyCheckBox: TCheckBox;
/// the Expand/Collapse button /// the Expand/Collapse button
ExpandBtn: TButton; ExpandBtn: TButton;
///
ProgressBar: TProgressBar;
procedure GetDefaultButtons(out aButtonDef, aRadioDef: TModalResult); procedure GetDefaultButtons(out aButtonDef, aRadioDef: TModalResult);
procedure InitCaptions; procedure InitCaptions;
@ -116,6 +120,7 @@ type
function GetGlobalLeftMargin: Integer; function GetGlobalLeftMargin: Integer;
procedure AddMainIcon(out ALeft,ATop: Integer; AGlobalLeftMargin: Integer; AParent: TWinControl); procedure AddMainIcon(out ALeft,ATop: Integer; AGlobalLeftMargin: Integer; AParent: TWinControl);
procedure AddPanels; procedure AddPanels;
procedure AddProgressBar(const ALeft: Integer; var ATop: Integer; AWidth: Integer; AParent: TWinControl);
procedure AddRadios(const ARadioOffSet, AWidth, ARadioDef, AFontHeight, ALeft: Integer; var ATop: Integer; AParent: TWinControl); procedure AddRadios(const ARadioOffSet, AWidth, ARadioDef, AFontHeight, ALeft: Integer; var ATop: Integer; AParent: TWinControl);
procedure AddCommandLinkButtons(const ALeft: Integer; var ATop: Integer; AWidth, AButtonDef, AFontHeight: Integer; AParent: TWinControl); procedure AddCommandLinkButtons(const ALeft: Integer; var ATop: Integer; AWidth, AButtonDef, AFontHeight: Integer; AParent: TWinControl);
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);
@ -509,6 +514,24 @@ begin
end; end;
procedure TLCLTaskDialog.AddProgressBar(const ALeft: Integer; var ATop: Integer; AWidth: Integer; AParent: TWinControl);
begin
Inc(ATop, ProgressBarVSpacing);
ProgressBar := TProgressBar.Create(Self);
if (tfShowMarqueeProgressBar in FDlg.Flags) then
ProgressBar.Style := pbstMarquee
else
begin
ProgressBar.Style := pbstNormal;
ProgressBar.Min := FDlg.ProgressBar.Min;
ProgressBar.Max := FDlg.ProgressBar.Max;
ProgressBar.Position := FDlg.ProgressBar.Position;
end;
ProgressBar.SetBounds(ALeft, ATop, AWidth-ALeft-GlobalLeftMargin, ProgressBarHeight);
Inc(ATop, ProgressBar.Height + ProgressBarVSpacing);
ProgressBar.Parent := AParent;
end;
procedure TLCLTaskDialog.AddRadios(const ARadioOffSet, AWidth, ARadioDef, AFontHeight, ALeft: Integer; var ATop: Integer; AParent: TWinControl); procedure TLCLTaskDialog.AddRadios(const ARadioOffSet, AWidth, ARadioDef, AFontHeight, ALeft: Integer; var ATop: Integer; AParent: TWinControl);
var var
i: Integer; i: Integer;
@ -1067,6 +1090,9 @@ begin
TopPanel.Height := ATop; TopPanel.Height := ATop;
CurrParent := MidPanel; CurrParent := MidPanel;
ATop := 0; ATop := 0;
//Add ProgressBar
if ([tfShowProgressBar,tfShowMarqueeProgressBar] * FDlg.Flags <> []) then
AddProgressBar(ALeft, ATop, AWidth, CurrParent);
// add radio CustomButtons // add radio CustomButtons
if (FDlg.RadioButtons.Count > 0) then if (FDlg.RadioButtons.Count > 0) then