On 17/10/2012 10:29 μμ, ik wrote:
Hello,
I'm writing an application that need to perform a counter on big
numbers (0..n).
I wish to display the counter on screen, but also allow to stop the
process itself.
At the moment I did something like:
for i := 0 to Number do
begin
edtValue.text := IntToStr(Number);
application.processmessages;
sleep(200);
end;
How can I use it under a thread that the view will be updated in the
form, but I could also cancel the action on a very long action ?
Thanks,
Ido
Create a new application in lazarus copy and paste the following in the
body of the main form that was created for you.
Make sure that the form events are linked correctly in the object
inspector and run the application.
Watch the caption change as the thread executes its loop when you get
bored double click the form to end the thread.
It has been tested on windows 7 32bit.
{--- FROM HERE
}
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, LMessages,
LCLIntf, LCLType;
const
cMesg = LM_USER+1;
type
{ TmyThread }
TmyThread = class(TThread)
private
FForm : TForm;
FNumber : Int64;
FStoped : Boolean;
FCS : LCLType.TCriticalSection;
function GetStoped : Boolean;
procedure SetStoped(aValue : Boolean);
protected
property Stoped : Boolean read GetStoped write SetStoped;
public
procedure Execute; override;
constructor Create(CreateSuspended: Boolean;
aForm:TForm; aNumber:Int64;
const StackSize: SizeUInt = DefaultStackSize);
destructor Destroy; override;
procedure StopExec;
end;
{ TForm1 }
TForm1 = class(TForm)
procedure FormActivate(Sender : TObject);
procedure FormCreate(Sender : TObject);
procedure FormDblClick(Sender : TObject);
private
{ private declarations }
FThread : TmyThread;
public
{ public declarations }
procedure ThreadMsg(var aMsg:TLMessage); message cMesg;
procedure ThreadDone(Sender:TObject);
end;
var
Form1 : TForm1;
implementation
{ TForm1 }
procedure TForm1.FormActivate(Sender : TObject);
begin
If not assigned(FThread) then begin
FThread := TmyThread.Create(True,Self,1000);
FThread.OnTerminate := @ThreadDone;
FThread.FreeOnTerminate := True;
FThread.Resume;
end;
end;
procedure TForm1.FormCreate(Sender : TObject);
begin
Caption := Caption+'- Thread Exited.';
end;
procedure TForm1.FormDblClick(Sender : TObject);
begin
if Assigned(FThread) then FThread.StopExec;
end;
procedure TForm1.ThreadMsg(var aMsg : TLMessage);
begin
Caption := IntToStr(aMsg.wParam);
end;
procedure TForm1.ThreadDone(Sender : TObject);
begin
FThread := Nil;
Caption := Caption + ' - Thread Exited';
end;
{$R *.lfm}
{ TmyThread }
procedure TmyThread.SetStoped(aValue : Boolean);
begin
EnterCriticalsection(FCS);
try
if FStoped = aValue then Exit;
FStoped := aValue;
finally
LeaveCriticalSection(FCS);
end;
end;
function TmyThread.GetStoped : Boolean;
begin
EnterCriticalsection(FCS);
try
Result := FStoped;
finally
LeaveCriticalSection(FCS);
end;
end;
procedure TmyThread.Execute;
var
Cntr : Int64;
begin
Cntr := 0;
While (Cntr < FNumber) and (not Stoped) do begin
Inc(Cntr);
if Assigned(FForm) then PostMessage(FForm.Handle,cMesg,Cntr,0);
Sleep(500);
end;
end;
constructor TmyThread.Create(CreateSuspended : Boolean; aForm : TForm;
aNumber : Int64; const StackSize : SizeUInt);
begin
FForm := aForm;
FNumber := aNumber;
LCLIntf.InitializeCriticalSection(FCS);
FStoped := False;
inherited Create(CreateSuspended, StackSize);
end;
destructor TmyThread.Destroy;
begin
LCLIntf.DeleteCriticalSection(FCS);
inherited Destroy;
end;
procedure TmyThread.StopExec;
begin
EnterCriticalsection(FCS);
try
fStoped := True;
finally
LeaveCriticalsection(FCS);
end;
end;
end.
{--- TO HERE
-}
--
___
Lazarus mailing list
Lazarus@lists.lazarus.freepascal.org
http://lists.lazarus.freepascal.org/mailman/listinfo/lazarus
