paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-14 02:19:39 +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 SetRange(AMin, AMax: Integer);
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 Min: Integer read FMin write SetMin 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;

28
lcl/taskdlgemulation.pp
View File

@ -45,7 +45,7 @@ interface
uses
Classes, SysUtils,
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;
@ -72,6 +72,8 @@ type
CommandLinkButtonVSpacing = 2;
BevelMargin = 2;
BevelHeight = 2;
ProgressBarHeight = 20;
ProgressBarVSpacing = 16;
private
/// the Task Dialog structure which created the form
FDlg: TTaskDialog;
@ -109,6 +111,8 @@ type
VerifyCheckBox: TCheckBox;
/// the Expand/Collapse button
ExpandBtn: TButton;
///
ProgressBar: TProgressBar;
procedure GetDefaultButtons(out aButtonDef, aRadioDef: TModalResult);
procedure InitCaptions;
@ -116,6 +120,7 @@ type
function GetGlobalLeftMargin: Integer;
procedure AddMainIcon(out ALeft,ATop: Integer; AGlobalLeftMargin: Integer; AParent: TWinControl);
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 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);
@ -509,6 +514,24 @@ begin
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);
var
i: Integer;
@ -1067,6 +1090,9 @@ begin
TopPanel.Height := ATop;
CurrParent := MidPanel;
ATop := 0;
//Add ProgressBar
if ([tfShowProgressBar,tfShowMarqueeProgressBar] * FDlg.Flags <> []) then
AddProgressBar(ALeft, ATop, AWidth, CurrParent);
// add radio CustomButtons
if (FDlg.RadioButtons.Count > 0) then