type
TProgressProc = procedure (aProgress: Integer) of object; // 0 to 100
TProgressThread = class(TThread)
private
FProgressProc: TProgressProc;
FProgressValue: integer;
procedure SynchedProgress;
protected
procedure Progress(aProgress: integer); virtual;
public
constructor Create(aProgressProc: TProgressProc; CreateSuspended: Boolean = False); reintroduce; virtual;
end;
{ TProgressThread }
constructor TProgressThread.Create(aProgressProc: TProgressProc; CreateSuspended: Boolean = False);
begin
inherited Create(CreateSuspended);
FreeOnTerminate := True;
FProgressProc := aProgressProc;
end;
procedure TProgressThread.Progress(aProgress: Integer);
begin
FProgressValue := aProgress;
Synchronize(SynchedProgress);
end;
procedure TProgressThread.SynchedProgress;
begin
if Assigned(FProgressProc) then
FProgressProc(FProgressValue);
end;
type
TMyThread = class(TProgressThread)
protected
procedure Execute; override;
end;
procedure TMyThread.Execute;
var I: Integer;
begin
Progress(0);
for I := 1 to 100 do
begin
Sleep(1000);
Progress(I);
end;
end;
type
TForm1 = class(TForm)
ProgressBar1: TProgressBar;
private
procedure UpdateProgressBar(aProgress: Integer);
end;
procedure TForm1.UpdateProgressBar(aProgress: Integer);
begin
ProgressBar1.Position := aProgress;
ProgressBar1.Update; // Make sure to repaint the progressbar
end;
type
TForm1 = class(TForm)
btnStart: TButton;
procedure btnStartClick(Sender: TObject);
private
fMyThread: TMyThread;
end;
procedure TForm1.btnStartClick(Sender: TObject);
begin
if not Assigned(fMyThread) then
fMyThread := TMyThread.Create(UpdateProgressbar);
end;
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, StdCtrls;
type
TProgressProc = procedure (aProgress: Integer) of object; // 0 to 100
TProgressThread = class(TThread)
private
FProgressProc: TProgressProc;
FProgressValue: integer;
procedure SynchedProgress;
protected
procedure Progress(aProgress: integer); virtual;
public
constructor Create(aProgressProc: TProgressProc; CreateSuspended: Boolean = False); reintroduce; virtual;
end;
TMyThread = class(TProgressThread)
protected
procedure Execute; override;
end;
TForm1 = class(TForm)
btnStart: TButton;
ProgressBar1: TProgressBar;
procedure btnStartClick(Sender: TObject);
private
fMyThread: TMyThread;
procedure UpdateProgressBar(aProgress: Integer);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ TProgressThread }
constructor TProgressThread.Create(aProgressProc: TProgressProc; CreateSuspended: Boolean = False);
begin
inherited Create(CreateSuspended);
FreeOnTerminate := True;
FProgressProc := aProgressProc;
end;
procedure TProgressThread.Progress(aProgress: Integer);
begin
FProgressValue := aProgress;
Synchronize(SynchedProgress);
end;
procedure TProgressThread.SynchedProgress;
begin
if Assigned(FProgressProc) then
FProgressProc(FProgressValue);
end;
{ TMyThread }
procedure TMyThread.Execute;
var I: Integer;
begin
Progress(0);
for I := 1 to 100 do
begin
Sleep(1000);
Progress(I);
end;
end;
{ TForm1 }
procedure TForm1.UpdateProgressBar(aProgress: Integer);
begin
ProgressBar1.Position := aProgress;
ProgressBar1.Update; // Make sure to repaint the progressbar
if aProgress >= 100 then
fMyThread := nil;
end;
procedure TForm1.btnStartClick(Sender: TObject);
begin
if not Assigned(fMyThread) then
fMyThread := TMyThread.Create(UpdateProgressBar);
end;
end.
Have a question about something in this article? You can receive help directly from the article author. Sign up for a free trial to get started.
Comments (4)
Commented:
Author
Commented:i'll try and add a OTL sample :)
Commented:
Anyway OTL is just another method of threading, I still don't see the big impact, because I didn't see any binary samples yet.
3 beers is enough, would not make you drunk.
Commented:
https://www.experts-exchange.com/questions/26640643/Delphi-2010-Copy-1-file-to-15-usb-devices-at-once-with-progress.html
is it wrong?