I'm making a patch for an old game (Command & Conquer 1, Win95 edition), and in some cases, executing the patch requires going through a function written in the Pascal script that could take quite a while.
At the moment, I execute this at the moment the page is changed to the "installing" page, so, after the user has selected all options and confirmed to install, right before the installer starts actually adding (and deleting) files.
procedure CurPageChanged(CurPageID: Integer);
begin
if (CurPageID = wpInstalling) then
begin
// Rename all saveg_hi.### files to savegame.###
renameSaveGames();
// clean up the ginormous files mess left behind if the game was installed from the 'First Decade' compilation pack
cleanupTFD();
end;
end;
But since the process could be rather long, I'd prefer to somehow add it to the actual install progress bar. Is there any way to accomplish this?
You can control the ProgressGauge from the install page of the WizardForm. In the following script is shown how to update the progress bar from a loop (which you'll just replace with your actions). For safety are progress bar values like min, max and position saved before the custom actions are performed and restored when they're done.
[Code]
procedure CurPageChanged(CurPageID: Integer);
var
I: Integer;
ProgressMin: Longint;
ProgressMax: Longint;
ProgressPos: Longint;
begin
if CurPageID = wpInstalling then
begin
// save the original "configuration" of the progress bar
ProgressMin := WizardForm.ProgressGauge.Min;
ProgressMax := WizardForm.ProgressGauge.Max;
ProgressPos := WizardForm.ProgressGauge.Position;
// output some status and setup the min and max progress values
WizardForm.StatusLabel.Caption := 'Doing my own pre-install...';
WizardForm.ProgressGauge.Min := 0;
WizardForm.ProgressGauge.Max := 100;
// here will be your time consuming actions with the progress update
for I := 0 to 100 do
begin
WizardForm.FilenameLabel.Caption := 'I''m on ' + IntToStr(I) + '%';
WizardForm.ProgressGauge.Position := I;
Sleep(50);
end;
// restore the original "configuration" of the progress bar
WizardForm.ProgressGauge.Min := ProgressMin;
WizardForm.ProgressGauge.Max := ProgressMax;
WizardForm.ProgressGauge.Position := ProgressPos;
end;
end;
Related
My installer has a custom finish page with an image on it. I referred this Custom Welcome and Finished page with stretched image in Inno Setup solution for it. But the issue is with the check box at finish page, it is coming on top of the finish page image with a white background. If I removed postinstall flag, then it will automatically launch my app. But I want the user to be able to choose like how checkbox does. So is there any way to transparent the check box launch message on top of my image? Would TNewCheckBox help here?
[Run]
Filename: "app\My program.exe"; Description: "{cm:LaunchProgram}"; #
Flags: nowait postinstall skipifsilent
In standard Inno Setup, I do not think you can make WizardForm.RunList (TNewCheckListBox) transparent. But as the simple TNewCheckListBox is transparent, you can replace the WizardForm.RunList with TNewCheckListBox.
[Code]
procedure RunCheckBoxClick(Sender: TObject);
begin
WizardForm.RunList.Checked[0] := TNewCheckBox(Sender).Checked;
end;
procedure CurPageChanged(CurPageID: Integer);
var
RunCheckBox: TNewCheckBox;
begin
if CurPageID = wpFinished then
begin
if (not WizardForm.RunList.Visible) or
(WizardForm.RunList.Items.Count < 1) then
begin
Log('No items to run');
end
else
if WizardForm.RunList.Items.Count > 1 then
begin
Log('More than one item to run, keeping the standard non-transparent run list');
end
else
begin
Log('Replacing the one item in the run list with a simple transparent checkbox');
RunCheckBox := TNewCheckBox.Create(WizardForm);
RunCheckBox.Parent := WizardForm.RunList.Parent;
RunCheckBox.Left := WizardForm.RunList.Left + ScaleX(4);
RunCheckBox.Top := WizardForm.RunList.Top + ScaleY(4);
RunCheckBox.Width := WizardForm.RunList.Width;
RunCheckBox.Height := ScaleY(RunCheckBox.Height);
RunCheckBox.Checked := WizardForm.RunList.Checked[0];
RunCheckBox.Caption := WizardForm.RunList.ItemCaption[0];
RunCheckBox.OnClick := #RunCheckBoxClick;
WizardForm.RunList.Visible := False;
end
end;
end;
I am trying following code for a GUI to show 2 identical windows. I am using show rather than showmodal:
program RnTFormclass;
{$mode delphi}
uses
//cthreads, // for linux only.
Interfaces, Forms, StdCtrls;
type
RnTForm = class(TForm)
private
wnd: TForm;
btn: TButton;
public
constructor create;
procedure showit;
end;
constructor RnTForm.create;
begin
//Application.Initialize; //removed.
wnd := TForm.Create(Application);
with wnd do begin
Height := 300;
Width := 400;
Position:= poDesktopCenter;
Caption := 'LAZARUS WND';
end;
btn := TButton.Create(wnd);
with btn do begin
SetBounds(0, 0, 100, 50);
Caption := 'Click Me';
Parent := wnd;
end;
end;
procedure RnTForm.showit;
begin
wnd.Show;
end;
var
myform1, myform2: RnTForm;
begin
// create windows:
myform1 := RnTForm.Create;
myform2 := RnTForm.Create;
// show windows:
myform1.showit;
myform2.showit;
end.
I want two identical windows to show/open up. Though the program runs without any error or warning, not even one window is shown.
The program just terminates.
Where is the problem and how can it be solved? Thanks for your help.
Edit: As pointed out in the comments, Application.initialize is being called twice and not run. I have commented out Application.initialize and the code still does not open up any of the window. (It does open windows one by one if show is replaced by showModal).
Main question is how to keep window open after show?
Taking suggestions from comments, I got it working by following main method:
begin
Application.Initialize;
// create windows:
myform1 := RnTForm.Create;
myform2 := RnTForm.Create;
// show windows:
myform1.showit;
myform2.showit;
Application.run;
end.
Now both the windows appear and I can click and work on any of them.
However, on closing both the windows, the program still keeps running in background. An exit button with its click function needs to be added.
I have ran into what I consider to be a progress bar bug on Windows 7. To demonstrate the bug I created a WinForm application with a button and a progress bar. In the button's 'on-click' handle I have the following code.
private void buttonGo_Click(object sender, EventArgs e)
{
this.progressBar.Minimum = 0;
this.progressBar.Maximum = 100;
this.buttonGo.Text = "Busy";
this.buttonGo.Update();
for (int i = 0; i <= 100; ++i)
{
this.progressBar.Value = i;
this.Update();
System.Threading.Thread.Sleep(10);
}
this.buttonGo.Text = "Ready";
}
The expected behavior is for the progress bar to advance to 100% and then the button text to change to 'Ready'. However, when developing this code on Windows 7, I noticed that the progress bar would rise to about 75% and then the button text would change to 'Ready'. Assuming the code is synchronous, this should not happen!
On further testing I found that the exact same code running on Windows Server 2003 produced the expected results. Furthermore, choosing a non aero theme on Windows 7 produces the expected results.
In my mind, this seems like a bug. Often it is very hard to make a progress bar accurate when the long operation involves complex code but in my particular case it was very straight forward and so I was little disappointed when I found the progress control did not accurately represent the progress.
Has anybody else noticed this behavior? Has anybody found a workaround?
It has to do with the animation of the progress bar. If your progress bar is at 0% and you set it to 100% then it will not jump there, but animate the progress bar smoothly filling up. If this is too slow, you will be done before the progress bar finished animating. So even though you have already set it to 80, 90 and 100%, the animation still lags behind.
I never found a way to turn this off, however I have a workaround. The animation is only being done if you increment the progress bar. If you move it backwards, it will immediately jump to that position. So if I want the progress bar to be at x% (x != 100) then I move it to x+1 and then to x. If I want it at 100% I move it to 100, 99 and 100%. (Or whatever values you use, you get the idea.) This works fast enough to not to be visible, and you can leave this code in for previous Windows versions as well. (though I don't)
HTH
I had the same problem. Fozi's tipp was helping me. Before setting a new value I have set the value + 1. To make this work also for 100% the maximum must be increased before. The following worked fine for me.
if (NewValue < progressBar.Maximum)
{
progressBar.Value = NewValue + 1;
progressBar.Value--;
}
else
{
progressBar.Maximum++;
progressBar.Value = progressBar.Maximum;
progressBar.Value--;
progressBar.Maximum--;
}
I think the original problem is related to timing and Win7's (or Aero's) animation mechanism for the progress bar.
This Sub is on the form that contains the progress bar (pBar).
It varies the bar's .Maximum and keeps .Value fixed at 10 for percent completes of 1 to 99. The bar's .Minimum is set to 0 at design time.
This sorted out the problem for me.
Public Sub UpdateStatusPC(ByVal pc As Integer)
Try
If pc < 0 Then
pBar.Maximum = 100
pBar.Value = 0
ElseIf pc > 100 Then
pBar.Maximum = 100
pBar.Value = 100
ElseIf pc = 0 Then
pBar.Maximum = 10
pBar.Value = 0
Else
pBar.Value = 10
pBar.Maximum = 10 / CDbl(pc / 100.0)
End If
pBar.Update()
Catch ex As Exception
MsgBox("UpdateStatusPC: " & ex.Message)
End Try
End Sub
To Delphi users facing the same problem: Below is a unit called ProgressBarFix that you can use to automatically patch the problem without worrying about changing your progress bar code -- just include ProgressBarFix in your form's interface "uses" clause after the ComCtrls uses and you'll get the workaround automatically:
unit ProgressBarFix;
(* The standard progress bar fails under Windows theming -- it fails to animate
all the way to the right side. C.f.,
http://stackoverflow.com/questions/2217688/windows-7-aero-theme-progress-bar-bug
To work around the problem, include ProgressBarFix in the interface section's
"uses" clause *after* ComCtrls (this replaces the TProgressBar definition in
ConCtrls with the one here, effectively allowing the control defined on the
form to be replaced with the patch version.
c.f., http://www.deltics.co.nz/blog/?p=222and http://melander.dk/articles/splitter *)
interface
uses ComCtrls ;
type TProgressBar = class(ComCtrls.TProgressBar)
private
procedure SetPosition(Value: Integer);
function GetPosition: Integer;
published
property Position: Integer read GetPosition write SetPosition default 0;
end ;
implementation
{ TProgressBar }
function TProgressBar.GetPosition: Integer;
begin
result := inherited Position
end;
procedure TProgressBar.SetPosition(Value: Integer);
begin
if Value=inherited Position then
exit ;
if value<Max then begin
inherited Position := value+1 ;
inherited Position := value
end else begin
Max := Max+1 ;
inherited Position := Max ;
inherited Position := value ;
Max := Max-1
end
end;
end.
Disable visual effect option "Animate controls and elements inside windows" in "Performance options". Then the progressbars won't be animated any longer.
I have seen similar issues with progress bars on Vista and Windows 7.
The key problem in my case was the blocking of the UI thread. (Like you do in your sample).
Windows does not like applications that don't respond to new messages in the message queue. If you spend too much time on one message, windows will mark your application as "not responsive". In Vista/Win7, windows also decides to stop updating your application window.
As a workaround, you could put the actual work on a background worker, or call Application.DoEvents() every once in a while. You do need to make sure that your progress bar window is modal, or else the DoEvents() may enable new commands to start executing halfway through your background processing.
If that feels to kludgy, the more proper way is to do your background work on a BackgroundWorker thread. It comes with support for sending events to the UI thread to update the progress bar.
(09/2015) I just jumped from D6 to XE8. Having a number of issues. Including this TProgressBar thing. Tabled it for a while. Came across this (Erik Knowles) fix tonight. Fantastic. Except: the first scenario I ran through had a Max value of 9,770,880. And it (Erik Knowles' "original" fix) REALLY added to the time this process took (with all the extra actual updating of the ProgressBar).
So I expanded his class to reduce the amount of times the ProgressBar actually redraws itself. But ONLY IF the "original" Max value is greater than MIN_TO_REWORK_PCTS (I settled on 5000 here).
If so, the ProgressBar only updates itself HUNDO times (here I started with and pretty much settled on 100, hence the "HUNDO" name).
I accounted for some quirkiness at the Max value as well:
if Abs(FOriginalMax - value) <= 1 then
pct := HUNDO
I tested this against my original 9.8m Max. And, with this standalone test app:
:
uses
:
ProgressBarFix;
const
PROGRESS_PTS = 500001;
type
TForm1 = class(TForm)
Label1: TLabel;
PB: TProgressBar;
Button1: TButton;
procedure Button1Click(Sender: TObject);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
x: integer;
begin
PB.Min := 0;
PB.Max := PROGRESS_PTS;
PB.Position := 0;
for x := 1 to PROGRESS_PTS do
begin
//let's do something
//
Label1.Caption := Format('%d of %d',[x,PROGRESS_PTS]);
Update;
PB.Position := x;
end;
PB.Position := 0;
end;
end.
with PROGRESS_PTS values of:
10
100
1,000
10,000
100,000
1,000,000
It's smooth and "accurate" for all of these values - without really slowing anything down.
In testing, I was able to toggle my compiler directive DEF_USE_MY_PROGRESS_BAR to test both ways (this TProgressBar replacement vs the original).
Note that you might want to uncomment the call to Application.ProcessMessages.
Here is the (my "enhanced") ProgressBarFix source:
unit ProgressBarFix;
interface
uses
Vcl.ComCtrls;
type
TProgressBar = class(Vcl.ComCtrls.TProgressBar)
const
HUNDO = 100;
MIN_TO_REWORK_PCTS = 5000;
private
function GetMax: integer;
procedure SetMax(value: integer);
function GetPosition: integer;
procedure SetPosition(value: integer);
published
property Max: integer read GetMax write SetMax default 100;
property Position: integer read GetPosition write SetPosition default 0;
private
FReworkingPcts: boolean;
FOriginalMax: integer;
FLastPct: integer;
end;
implementation
function TProgressBar.GetMax: integer;
begin
result := inherited Max;
end;
procedure TProgressBar.SetMax(value: integer);
begin
FOriginalMax := value;
FLastPct := 0;
FReworkingPcts := FOriginalMax > MIN_TO_REWORK_PCTS;
if FReworkingPcts then
inherited Max := HUNDO
else
inherited Max := value;
end;
function TProgressBar.GetPosition: integer;
begin
result := inherited Position;
end;
procedure TProgressBar.SetPosition(value: integer);
var
pct: integer;
begin
//Application.ProcessMessages;
if value = inherited Position then
exit;
if FReworkingPcts then
begin
if Abs(FOriginalMax - value) <= 1 then
pct := HUNDO
else
pct := Trunc((value / FOriginalMax) * HUNDO);
if pct = FLastPct then
exit;
FLastPct := pct;
value := pct;
end;
if value < Max then
begin
inherited Position := Succ(value);
inherited Position := value;
end
else
begin
Max := Succ(Max);
inherited Position := Max;
inherited Position := value;
Max := Pred(Max);
end;
end;
end.
I need a simple thing: have advance and normal installation buttons. For normal case it is all simple - I used default next button with some logic on NextButtonClick to set a condition variable and skeep some pages using ShouldSkipPage . Yet for advanced setup I created a new button and all I need it to do on click is to open next installer page:
procedure CurPageChanged(CurPageID : Integer);
begin
if CurPageID = wpWelcome then begin
AdvancedButton := TButton.Create(WizardForm);
AdvancedButton.Caption := 'Advanced Install';
AdvancedButton.Left := WizardForm.InfoAfterPage.Left + 10;
AdvancedButton.Top := WizardForm.InfoAfterPage.Height + 88;
AdvancedButton.Parent := WizardForm.NextButton.Parent;
# AdvancedButton.OnClick := What shall I call to open say next page (or some page by given PageID value)
end
else begin
AdvancedButton.Visible := False;
end;
end;
So What shall I call to open say next page (or some page by given PageID value) on my button click (could not find any NextPage or some SetPage function in Inno API)?
There is no such thing as "Direct jump to page" in Inno Setup.
All you need is to quietly skip certain pages in 'Advanced mode'.
Simply do the same as in regular installer. Set one variable for holding 'Advanced mode'. After clicking the Advance button:
[Code]
var
IsAdvanced: Boolean;
procedure AdvancedButtonClick(Sender: TObject);
begin
IsAdvanced := True;
WizardForm.NextButton.OnClick(nil);
end;
procedure InitializeWizard;
var
AdvancedButton: TNewButton;
begin
// not necessary; just for sure
IsAdvanced := False;
// create the button
AdvancedButton := TNewButton.Create(WizardForm);
AdvancedButton.Caption := 'Advanced Install';
AdvancedButton.Left := WizardForm.InfoAfterPage.Left + 10;
AdvancedButton.Top := WizardForm.InfoAfterPage.Height + 88;
AdvancedButton.Parent := WizardForm.NextButton.Parent;
AdvancedButton.OnClick := #AdvancedButtonClick;
end;
function ShouldSkipPage(PageID: Integer): Boolean;
begin
// the <page where you want to end up> fill with the wizard page constant
// of the page where you want to end up, e.g. wpReady
Result := IsAdvanced and (PageID <> <page where you want to end up>);
end;
With this logic you can simulate quiet 'jump' to certain page.
I have ran into what I consider to be a progress bar bug on Windows 7. To demonstrate the bug I created a WinForm application with a button and a progress bar. In the button's 'on-click' handle I have the following code.
private void buttonGo_Click(object sender, EventArgs e)
{
this.progressBar.Minimum = 0;
this.progressBar.Maximum = 100;
this.buttonGo.Text = "Busy";
this.buttonGo.Update();
for (int i = 0; i <= 100; ++i)
{
this.progressBar.Value = i;
this.Update();
System.Threading.Thread.Sleep(10);
}
this.buttonGo.Text = "Ready";
}
The expected behavior is for the progress bar to advance to 100% and then the button text to change to 'Ready'. However, when developing this code on Windows 7, I noticed that the progress bar would rise to about 75% and then the button text would change to 'Ready'. Assuming the code is synchronous, this should not happen!
On further testing I found that the exact same code running on Windows Server 2003 produced the expected results. Furthermore, choosing a non aero theme on Windows 7 produces the expected results.
In my mind, this seems like a bug. Often it is very hard to make a progress bar accurate when the long operation involves complex code but in my particular case it was very straight forward and so I was little disappointed when I found the progress control did not accurately represent the progress.
Has anybody else noticed this behavior? Has anybody found a workaround?
It has to do with the animation of the progress bar. If your progress bar is at 0% and you set it to 100% then it will not jump there, but animate the progress bar smoothly filling up. If this is too slow, you will be done before the progress bar finished animating. So even though you have already set it to 80, 90 and 100%, the animation still lags behind.
I never found a way to turn this off, however I have a workaround. The animation is only being done if you increment the progress bar. If you move it backwards, it will immediately jump to that position. So if I want the progress bar to be at x% (x != 100) then I move it to x+1 and then to x. If I want it at 100% I move it to 100, 99 and 100%. (Or whatever values you use, you get the idea.) This works fast enough to not to be visible, and you can leave this code in for previous Windows versions as well. (though I don't)
HTH
I had the same problem. Fozi's tipp was helping me. Before setting a new value I have set the value + 1. To make this work also for 100% the maximum must be increased before. The following worked fine for me.
if (NewValue < progressBar.Maximum)
{
progressBar.Value = NewValue + 1;
progressBar.Value--;
}
else
{
progressBar.Maximum++;
progressBar.Value = progressBar.Maximum;
progressBar.Value--;
progressBar.Maximum--;
}
I think the original problem is related to timing and Win7's (or Aero's) animation mechanism for the progress bar.
This Sub is on the form that contains the progress bar (pBar).
It varies the bar's .Maximum and keeps .Value fixed at 10 for percent completes of 1 to 99. The bar's .Minimum is set to 0 at design time.
This sorted out the problem for me.
Public Sub UpdateStatusPC(ByVal pc As Integer)
Try
If pc < 0 Then
pBar.Maximum = 100
pBar.Value = 0
ElseIf pc > 100 Then
pBar.Maximum = 100
pBar.Value = 100
ElseIf pc = 0 Then
pBar.Maximum = 10
pBar.Value = 0
Else
pBar.Value = 10
pBar.Maximum = 10 / CDbl(pc / 100.0)
End If
pBar.Update()
Catch ex As Exception
MsgBox("UpdateStatusPC: " & ex.Message)
End Try
End Sub
To Delphi users facing the same problem: Below is a unit called ProgressBarFix that you can use to automatically patch the problem without worrying about changing your progress bar code -- just include ProgressBarFix in your form's interface "uses" clause after the ComCtrls uses and you'll get the workaround automatically:
unit ProgressBarFix;
(* The standard progress bar fails under Windows theming -- it fails to animate
all the way to the right side. C.f.,
http://stackoverflow.com/questions/2217688/windows-7-aero-theme-progress-bar-bug
To work around the problem, include ProgressBarFix in the interface section's
"uses" clause *after* ComCtrls (this replaces the TProgressBar definition in
ConCtrls with the one here, effectively allowing the control defined on the
form to be replaced with the patch version.
c.f., http://www.deltics.co.nz/blog/?p=222and http://melander.dk/articles/splitter *)
interface
uses ComCtrls ;
type TProgressBar = class(ComCtrls.TProgressBar)
private
procedure SetPosition(Value: Integer);
function GetPosition: Integer;
published
property Position: Integer read GetPosition write SetPosition default 0;
end ;
implementation
{ TProgressBar }
function TProgressBar.GetPosition: Integer;
begin
result := inherited Position
end;
procedure TProgressBar.SetPosition(Value: Integer);
begin
if Value=inherited Position then
exit ;
if value<Max then begin
inherited Position := value+1 ;
inherited Position := value
end else begin
Max := Max+1 ;
inherited Position := Max ;
inherited Position := value ;
Max := Max-1
end
end;
end.
Disable visual effect option "Animate controls and elements inside windows" in "Performance options". Then the progressbars won't be animated any longer.
I have seen similar issues with progress bars on Vista and Windows 7.
The key problem in my case was the blocking of the UI thread. (Like you do in your sample).
Windows does not like applications that don't respond to new messages in the message queue. If you spend too much time on one message, windows will mark your application as "not responsive". In Vista/Win7, windows also decides to stop updating your application window.
As a workaround, you could put the actual work on a background worker, or call Application.DoEvents() every once in a while. You do need to make sure that your progress bar window is modal, or else the DoEvents() may enable new commands to start executing halfway through your background processing.
If that feels to kludgy, the more proper way is to do your background work on a BackgroundWorker thread. It comes with support for sending events to the UI thread to update the progress bar.
(09/2015) I just jumped from D6 to XE8. Having a number of issues. Including this TProgressBar thing. Tabled it for a while. Came across this (Erik Knowles) fix tonight. Fantastic. Except: the first scenario I ran through had a Max value of 9,770,880. And it (Erik Knowles' "original" fix) REALLY added to the time this process took (with all the extra actual updating of the ProgressBar).
So I expanded his class to reduce the amount of times the ProgressBar actually redraws itself. But ONLY IF the "original" Max value is greater than MIN_TO_REWORK_PCTS (I settled on 5000 here).
If so, the ProgressBar only updates itself HUNDO times (here I started with and pretty much settled on 100, hence the "HUNDO" name).
I accounted for some quirkiness at the Max value as well:
if Abs(FOriginalMax - value) <= 1 then
pct := HUNDO
I tested this against my original 9.8m Max. And, with this standalone test app:
:
uses
:
ProgressBarFix;
const
PROGRESS_PTS = 500001;
type
TForm1 = class(TForm)
Label1: TLabel;
PB: TProgressBar;
Button1: TButton;
procedure Button1Click(Sender: TObject);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
x: integer;
begin
PB.Min := 0;
PB.Max := PROGRESS_PTS;
PB.Position := 0;
for x := 1 to PROGRESS_PTS do
begin
//let's do something
//
Label1.Caption := Format('%d of %d',[x,PROGRESS_PTS]);
Update;
PB.Position := x;
end;
PB.Position := 0;
end;
end.
with PROGRESS_PTS values of:
10
100
1,000
10,000
100,000
1,000,000
It's smooth and "accurate" for all of these values - without really slowing anything down.
In testing, I was able to toggle my compiler directive DEF_USE_MY_PROGRESS_BAR to test both ways (this TProgressBar replacement vs the original).
Note that you might want to uncomment the call to Application.ProcessMessages.
Here is the (my "enhanced") ProgressBarFix source:
unit ProgressBarFix;
interface
uses
Vcl.ComCtrls;
type
TProgressBar = class(Vcl.ComCtrls.TProgressBar)
const
HUNDO = 100;
MIN_TO_REWORK_PCTS = 5000;
private
function GetMax: integer;
procedure SetMax(value: integer);
function GetPosition: integer;
procedure SetPosition(value: integer);
published
property Max: integer read GetMax write SetMax default 100;
property Position: integer read GetPosition write SetPosition default 0;
private
FReworkingPcts: boolean;
FOriginalMax: integer;
FLastPct: integer;
end;
implementation
function TProgressBar.GetMax: integer;
begin
result := inherited Max;
end;
procedure TProgressBar.SetMax(value: integer);
begin
FOriginalMax := value;
FLastPct := 0;
FReworkingPcts := FOriginalMax > MIN_TO_REWORK_PCTS;
if FReworkingPcts then
inherited Max := HUNDO
else
inherited Max := value;
end;
function TProgressBar.GetPosition: integer;
begin
result := inherited Position;
end;
procedure TProgressBar.SetPosition(value: integer);
var
pct: integer;
begin
//Application.ProcessMessages;
if value = inherited Position then
exit;
if FReworkingPcts then
begin
if Abs(FOriginalMax - value) <= 1 then
pct := HUNDO
else
pct := Trunc((value / FOriginalMax) * HUNDO);
if pct = FLastPct then
exit;
FLastPct := pct;
value := pct;
end;
if value < Max then
begin
inherited Position := Succ(value);
inherited Position := value;
end
else
begin
Max := Succ(Max);
inherited Position := Max;
inherited Position := value;
Max := Pred(Max);
end;
end;
end.