How can I terminate thread directly outside of thread in delphi? - multithreading

I want to terminate thread by clicking the button. If the thread normally works without user interruption it is OK but sometimes user needs to abort thread and that's the question that how user abort the thread.
Here is my code that I tested:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, mmsystem, ExtCtrls;
type
TForm1 = class(TForm)
Image1: TImage;
procedure Image1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
end;
type
hangth = class(TThread)
private
{ Private declarations }
protected
procedure Execute; override;
procedure play;
end;
var
Form1: TForm1;
played: boolean;
szalhang: hangth;
implementation
{$R *.dfm}
procedure hangth.play;
begin
played := true;
szalhang.Terminate;
end;
procedure hangth.Execute;
begin
played := false;
SndPlaySound(pchar('hang.wav'), SND_SYNC);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
played := true;
end;
procedure TForm1.Image1Click(Sender: TObject);
begin
if played = true then begin
szalhang := hangth.Create(true);
szalhang.Resume;
end else begin
szalhang.Terminate();
// here i want to terminate thread, but it doesn't want to be killed.
end;
end;
end.

When you call TThread.Terminate(), it sets the TThread.Terminated property to true and does nothing else. It is the responsibility of your TThread.Execute() code to look at the TThread.Terminated property periodically and exit gracefully when it is True. However, in this situation, that is not possible because SndPlaySound() is blocking the thread, and there is no way to interrupt SndPlaySound() when it is running in SND_SYNC mode. Your only option would be to use the Win32 API TerminateThread() function to perform a brute-force termination of the thread.
Since you obviously need more control over the playback of the audio, and detection of when the audio is finished playing, then SndPlaySound() is not the best solution for your needs. You have a TForm, you might consider using Delphi's TMediaPlayer component, for example:
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.MPlayer;
type
MPlayerState = (mpsClosed, mpsOpened, mpsPlaying);
TForm1 = class(TForm)
Image1: TImage;
MediaPlayer1: TMediaPlayer;
procedure MediaPlayer1Notify(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Image1Click(Sender: TObject);
private
{ Private declarations }
State: MPlayerState;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm56.FormCreate(Sender: TObject);
begin
State := mpsClosed;
MediaPlayer1.FileName := 'C:\full path to\hang.wav';
end;
procedure TForm56.MediaPlayer1Notify(Sender: TObject);
begin
case MediaPlayer1.Mode of
mpStopped, mpPlaying:
State := mpsOpened;
end;
end;
procedure TForm1.Image1Click(Sender: TObject);
begin
if State = mpsClosed then
begin
MediaPlayer1.Notify := False;
MediaPlayer1.Wait := True;
MediaPlayer1.Open;
State := mpsOpened;
end;
if State = mpsOpened then
begin
MediaPlayer1.Notify := True;
MediaPlayer1.Wait := False;
MediaPlayer1.Play;
if MediaPlayer1.Error = 0 then
State := mpsPlaying
end else
begin
MediaPlayer1.Notify := False;
MediaPlayer1.Wait := True;
MediaPlayer1.Stop;
State := mpsOpened;
MediaPlayer1.Notify := False;
MediaPlayer1.Wait := True;
MediaPlayer1.Close;
State := mpsClosed;
end;
end;
end.

Related

Reading thread's fields from synchronized event handler

Is it safe to read a thread object's fields from an event handler called by the Synchronize procedure?
For example:
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ComCtrls;
type
TMyThread = class(TThread)
public
Max : Integer;
Position : Integer;
OnPositionChanged : TNotifyEvent;
procedure Execute(); override;
end;
TForm1 = class(TForm)
ProgressBar1: TProgressBar;
procedure FormCreate(Sender: TObject);
private
procedure MyOnPositionChanged(Sender : TObject);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
var
Th : TMyThread;
procedure TMyThread.Execute();
begin
while not Terminated do
begin
//doing stuffs
Sleep(500);
//position + 1
Inc(Position);
//event handler
if(Assigned(OnPositionChanged)) then
begin
Synchronize(
procedure()
begin
OnPositionChanged(Self);
end
);
end;
//check for reaching the max value
if(Position = Max)
then Terminate;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
//preparing thread
Th := TMyThread.Create(True);
Th.FreeOnTerminate := True;
Th.Max := ProgressBar1.Max;
Th.Position := ProgressBar1.Position;
Th.OnPositionChanged := MyOnPositionChanged;
//starting thread
Th.Start;
end;
procedure TForm1.MyOnPositionChanged(Sender : TObject);
begin
//updating progressbar
ProgressBar1.Position := (Sender as TMyThread).Position;
end;
end.
I'm wondering if there could be some thread-safety problem in reading the thread's fields from the main thread while the other thread is running
Yes, this is generally safe. The thread's Execute() method is blocked while Synchronize() is running, so the thread won't be updating the fields while the main thread is using them.
Where this can break down is if you happen to have another thread updating the same fields without Synchronize()'ing access to them.

How to show a "Please wait " modal form from a TThread and free it when the job is done?

I've been working just for a while trying to make a modal form to inform the user to wait until the job is ends.
This is a simple example of what I'm trying to do:
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
TLoader = class(TThread)
private
FStrings: TStrings;
procedure ShowWait;
procedure EndsWait;
public
Constructor Create(AStrings: TStrings);
Destructor Destroy; override;
procedure Execute; override;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
Var
List: TStrings;
begin
List := TStringList.Create;
try
// Load Some Data here
TLoader.Create(List);
finally
List.Free;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
end;
{ TLoader }
constructor TLoader.Create(AStrings: TStrings);
begin
inherited Create;
FreeOnTerminate:= True;
FStrings:= TStringList.Create;
FStrings.AddStrings(AStrings);
end;
destructor TLoader.Destroy;
begin
FStrings.Free;
inherited;
end;
procedure TLoader.EndsWait;
begin
TForm(Application.FindComponent('FWait')).Free;
end;
procedure TLoader.Execute;
begin
inherited;
Synchronize(ShowWait);
// Do Some Job while not terminated
Sleep(1000);
// Free Wait Form
// This part is not working
Synchronize(EndsWait);
end;
procedure TLoader.ShowWait;
begin
With TForm.Create(Application) do
begin
// Some code
Name:= 'FWait';
ShowModal;
end;
end;
end.
Everything is working as I expected, except Synchronize(EndsWait); which did not close and free the modal form.
How can I display a modal form while a TThread is running and free it when the TThread terminated?
UPDATE:
I've try to do as Remy suggest as the following:
type
TForm2 = class(TForm)
procedure FormShow(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
TLoader = class(TThread)
protected
procedure DoTerminate; override;
procedure DoCloseModal;
public
constructor Create;
procedure Execute; override;
end;
var
Form2: TForm2;
implementation
{$R *.dfm}
{ TLoader }
constructor TLoader.Create;
begin
inherited Create;
FreeOnTerminate:= True;
end;
procedure TLoader.DoCloseModal;
begin
Form2.ModalResult:= mrOk;
end;
procedure TLoader.DoTerminate;
begin
inherited DoTerminate;
Synchronize(DoCloseModal);
end;
procedure TLoader.Execute;
begin
inherited;
Sleep(200);
end;
procedure TForm2.FormShow(Sender: TObject);
begin
TLoader.Create;
end;
end.
The main form button click event handler:
procedure TForm1.Button1Click(Sender: TObject);
begin
with TForm2.Create(nil) do
try
ShowModal;
finally
Free;
end;
end;
You have two choices:
Do not use a modal form to begin with. TThread.Synchronize() blocks your thread until the synced method exits, but TForm.ShowModal() blocks that method until the Form is closed. Use TThread.Synchronize() (or better, TThread.Queue()) to Create()+Show() (not ShowModal()) the Wait Form, then return to the thread and let it do its work as needed, then Synchronize()/Queue() again (or, use the thread's OnTerminate event) to Close()+Free() the Wait Form when done.
alternatively, if you want to use a modal Wait Form, then do not let the thread manage the Wait Form at all. Have your button OnClick handler Create()+ShowModal() (not Show()) the Wait Form, and Free() it when ShowModal() exits. Have the Wait Form internally create and terminate the thread when the Wait Form is shown and closed, respectively. If the thread ends before the Wait Form is closed, the thread's OnTerminate handler can Close() the Form (which simply sets the Form's ModalResult) so that ShowModal() will exit in the OnClick handler.
After a while, I made a uWaitForm.pas unit:
unit uWaitForm;
interface
uses
System.Classes, Vcl.Controls, Vcl.Forms;
type
TWaitForm = class(TForm)
private
FThread: TThread;
protected
procedure Activate; override;
procedure DoClose(var Action: TCloseAction); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
end;
TWaitThread = class(TThread)
private
FForm: TWaitForm;
FModalResult: TModalResult;
protected
procedure Execute; override;
procedure DoSetModalResult;
public
constructor Create(AForm: TWaitForm);
destructor Destroy; override;
end;
implementation
{ TWaitForm }
procedure TWaitForm.Activate;
begin
inherited;
FThread:= TWaitThread.Create(Self);
end;
constructor TWaitForm.Create(AOwner: TComponent);
begin
inherited CreateNew(AOwner);
Name:= 'WaitForm';
BorderStyle:= bsDialog;
Caption:= 'Please wait...';
Width:= 200;
Height:= 150;
Position:= poDesktopCenter;
end;
destructor TWaitForm.Destroy;
begin
if Assigned(FThread) then
FThread.Terminate;
inherited;
end;
procedure TWaitForm.DoClose(var Action: TCloseAction);
begin
inherited;
if Assigned(FThread) then
begin
TWaitThread(FThread).FModalResult:= mrCancel;
FThread.Terminate;
end;
end;
{ TWaitThread }
constructor TWaitThread.Create(AForm: TWaitForm);
begin
inherited Create;
FreeOnTerminate:= True;
FForm:= AForm;
FModalResult:= mrOk;
end;
destructor TWaitThread.Destroy;
begin
if Assigned(FForm) then
Synchronize(nil, DoSetModalResult);
inherited;
end;
procedure TWaitThread.DoSetModalResult;
begin
FForm.ModalResult:= FModalResult;
end;
procedure TWaitThread.Execute;
begin
inherited;
// Do the work while not terminated
// You can check for Terminated here and set FModalResult accordingly to receive it from ShowModal
// By default it's mrOk (Job is done, the thread doesn't cancled)
Sleep(200);
end;
end.
Then use it
with TWaitForm.Create(nil) do
try
//Get ModalResult here and do something accordingly
// mrCancel means the dialog form closed and the the Thread job aborted
// mrOk The job is done and the form closed
ShowModal;
finally
Free;
end;

TFloatAnimation within anonymous thread. Thread wont die and animation wont restart

I've been struggling with this for a day or two and cannot find an answer anywhere. I thought this answer might help but it didn't.
In my sample code below I have two Timage Components each containing a "Start Image". When clicking on the "Start Button" two anonymous threads are created, one animates Image1 between the Start Image and End Image, the other does the same for Image2.
My problem is that when the KillAnimation boolean is set to True both animations should stop (which they do) but only one of the threads exit, the other one stops animating but leaves the image mid-animation.
I have the same problem if I use a predefined thread as well.
The sample application has only two images, the real world app can have anywhere from 15 to 24. Anonymous threads seem to suit because I can create them and no have to worry about defining up to 24 TThreads. I hope that makes sense.
unit Unit1;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes,
System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Objects,
FMX.Controls.Presentation, FMX.StdCtrls, FMX.Ani, FMX.Effects,
FMX.Filter.Effects;
type
TForm1 = class(TForm)
Image1: TImage;
Image2: TImage;
BtnStop: TButton;
BtnStart: TButton;
BtnReset: TButton;
procedure BtnStopClick(Sender: TObject);
procedure BtnStartClick(Sender: TObject);
procedure BtnResetClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure createthread(TheImage: TImage; TargetBMP: String);
end;
var
Form1: TForm1;
KillAnimation: Boolean;
implementation
{$R *.fmx}
procedure TForm1.BtnStopClick(Sender: TObject);
begin
KillAnimation := true;
end;
procedure TForm1.createthread(TheImage: TImage; TargetBMP: String);
begin
{ The thread works right up until it is stopped. Even though two
threads are started only one finishes. In addition, the images
do not end up as the target image, and neither image can be
reset even if I reload them from files. }
TThread.CreateAnonymousThread(
procedure()
var
Wiggle: TWiggleTransitionEffect;
TheFloat: TFloatAnimation;
begin
TThread.NameThreadForDebugging('Animate ' + TheImage.Name);
Wiggle := TWiggleTransitionEffect.Create(Nil);
Wiggle.RandomSeed := 0.3;
Wiggle.Progress := 0;
Wiggle.Parent := TheImage;
TThread.Synchronize(TThread.CurrentThread,
procedure()
Begin
Wiggle.Target.LoadFromFile(TargetBMP)
end);
TheFloat := TFloatAnimation.Create(Nil);
TheFloat.Parent := Wiggle;
TheFloat.PropertyName := 'Progress';
TheFloat.Duration := 2;
TheFloat.AutoReverse := true;
TheFloat.Loop := true;
TheFloat.StartValue := 0;
TheFloat.StopValue := 100;
TheFloat.StartFromCurrent := false;
TheFloat.start;
while not KillAnimation do
application.handlemessage;
TheFloat.stop;
end).start;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Image1.Bitmap.LoadFromFile('c:\sample\startimage.png');
Image2.Bitmap.LoadFromFile('c:\sample\startimage.png');
end;
procedure TForm1.BtnStartClick(Sender: TObject);
begin
KillAnimation := false;
createthread(Image1, 'c:\sample\endimage.png');
createthread(Image2, 'c:\sample\endimage.png');
end;
procedure TForm1.BtnResetClick(Sender: TObject);
begin
KillAnimation := false;
Image1.Bitmap.LoadFromFile('c:\sample\startimage.png');
Image2.Bitmap.LoadFromFile('c:\sample\startimage.png');
end;
end.
I would have thought that creating the Transition and FloatAnimation within the thread meant they would be destroyed when done because FreeOnTerminate is True.
When I try to reset the Images using "image1.bitmap.loadfromfile" it doesn't change.
The images are 170 x 170 png files.
What have I done wrong here?
My goal is to pass TImage and an Image File to the thread, let it animate until told to stop. It is unlikely that I'll need all 24 images to animate, but you never know.
Apologies if I shouldn't have posted all the code from my sample. At least you can see everything going on.
You should NOT be using a thread for this at all. UI elements, including visual effects, should be used only in the main UI thread. And unless you are developing your app for mobile platforms, objects are not destroyed automatically when they go out of scope, you have to destroy them yourself when you are done using them, or else assign them an Owner that will destroy them for you.
Try this instead:
unit Unit1;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Objects, FMX.Controls.Presentation,
FMX.StdCtrls, FMX.Ani, FMX.Effects, FMX.Filter.Effects;
type
TForm1 = class(TForm)
Image1: TImage;
Image2: TImage;
BtnStop: TButton;
BtnStart: TButton;
BtnReset: TButton;
procedure BtnStopClick(Sender: TObject);
procedure BtnStartClick(Sender: TObject);
procedure BtnResetClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
Float1: TFloatAnimation;
Float2: TFloatAnimation;
function PrepareEffect(TheImage: TImage; const TargetBMP: String): TFloatAnimation;
procedure ResetImages;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.fmx}
procedure TForm1.BtnResetClick(Sender: TObject);
begin
ResetImages;
end;
procedure TForm1.BtnStartClick(Sender: TObject);
begin
Float1.start;
Float2.start;
end;
procedure TForm1.BtnStopClick(Sender: TObject);
begin
Float1.stop;
Float2.stop;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
ResetImages;
Float1 := PrepareEffect(Image1, 'c:\sample\endimage.png');
Float2 := PrepareEffect(Image2, 'c:\sample\endimage.png');
end;
function TForm1.PrepareEffect(TheImage: TImage; const TargetBMP: String): TFloatAnimation;
var
Wiggle: TWiggleTransitionEffect;
TheFloat: TFloatAnimation;
begin
Wiggle := TWiggleTransitionEffect.Create(Self);
Wiggle.RandomSeed := 0.3;
Wiggle.Progress := 0;
Wiggle.Parent := TheImage;
Wiggle.Target.LoadFromFile(TargetBMP);
TheFloat := TFloatAnimation.Create(Self);
TheFloat.Parent := Wiggle;
TheFloat.PropertyName := 'Progress';
TheFloat.Duration := 2;
TheFloat.AutoReverse := true;
TheFloat.Loop := true;
TheFloat.StartValue := 0;
TheFloat.StopValue := 100;
TheFloat.StartFromCurrent := false;
Result := TheFloat;
end;
procedure TForm1.ResetImages;
begin
Image1.Bitmap.LoadFromFile('c:\sample\startimage.png');
Image2.Bitmap.LoadFromFile('c:\sample\startimage.png');
end;
end.

Delphi XE + thread + idHttp without memory leaks

At first HI ALL and sry for my English.
can somebody share work source with create + destroy threads with simple GET in execute ?
i try do it by myself but always get memory leaks((
i test it with code at end of source
initialization
ReportMemoryLeaksOnShutdown := True;
btw ill Google it 2 week and test many samples... and always have leaks by default =(
delphi XE7 32bit at windows 7 x64
when i press stop button i still see some connections
after closing i get this message
cant post image, need 10 reputation...
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, sButton, sMemo, sEdit,
sSpinEdit, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP,System.SyncObjs;
type
TForm1 = class(TForm)
StartBtn: TsButton;
StopBtn: TsButton;
ThreadCount: TsSpinEdit;
sdt1: TsEdit;
sm1: TsMemo;
procedure StartBtnClick(Sender: TObject);
procedure StopBtnClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
type
Thread = class(TThread)
private
HTTP : TIdHTTP;
result:integer;
InputIndex:integer;
public
procedure Local;
constructor Create(CreateSuspended:boolean);
destructor Destroy; override;
protected
procedure Execute; override;
end;
var
Form1: TForm1;
LocalWork: Boolean;
target: string;
implementation
{$R *.dfm}
constructor Thread.Create(CreateSuspended: boolean);
begin
Inherited Create(true);
FreeOnTerminate:=true;
HTTP:=TIdHTTP.Create(nil);
HTTP.ReadTimeout := 2000;
Resume;
end;
destructor Thread.Destroy;
begin
try
If HTTP.Connected then
begin
HTTP.Disconnect(false);
HTTP.IOHandler.InputBuffer.Clear();
HTTP.IOHandler.Close;
Terminate;
end;
finally
WaitFor;
FreeAndNil(HTTP);
end;
inherited;
end;
procedure Thread.Execute;
begin
while (LocalWork=True) do
begin
if LocalWork=true then
begin
HTTP.Get(target);
if HTTP.ResponseCode=200 then
begin
result:=1;
end
else
begin
result:=2;
end;
Synchronize(Local);
end
else
begin
EndThread(0);
end;
end;
EndThread(0);
end;
procedure Thread.Local;
begin
if result=1 then Form1.sm1.Lines.Add('Good ');
if result=2 then Form1.sm1.Lines.Add('Bad ');
end;
procedure TForm1.StartBtnClick(Sender: TObject);
var
i:integer;
begin
target := sdt1.Text;
LocalWork := True;
for I := 0 to ThreadCount.Value-1 do
begin
sm1.Lines.Add('Thread createrd '+inttostr(i));
Thread.Create(true); // создаем замароженный поток
end;
end;
procedure TForm1.StopBtnClick(Sender: TObject);
begin
LocalWork:=false;
end;
initialization
ReportMemoryLeaksOnShutdown := True;
end.
Inside the thread constructor, call inherited Create(false);. And skip the Resume call at the end. The thread will not start until the constructor has finished anyway.
In the thread Execute method, skip the EndThread calls, since the thread will handle this when the Execute method ends.
In the Destroy destructor, do not call Terminate and Waitfor. They do not belong there at all. The thread is told to FreeOnTerminate, and will do so gracefully.

Delphi - Updating status bar from thread

What is the best way to update a status bar in mainform from one tthread class object.
For Example, I have one TThread object that make a very big quanty of stuff and i want that the verbose message acording to what soft do you do appear on status bar.
Create the thread with a reference to a callback method, which can be called synchonized if assigned.
Example;
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TInfoMessageCall=Procedure (const info:String) of object;
TMyThread=Class(TThread)
Constructor Create(Susp:Boolean;CallBack:TInfoMessageCall);overload;
Procedure Execute;override;
private
FMessage:String;
FInfoProc:TInfoMessageCall;
Procedure CallCallBack;
End;
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
procedure ACallBack(const s: String);
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ TMyThread }
Procedure TForm1.ACallBack(Const s:String);
begin
Caption := s;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
With TMyThread.Create(false,ACallBack) do
FreeOnTerminate := true;
end;
procedure TMyThread.CallCallBack;
begin
if Assigned(FInfoProc) then FInfoProc(FMessage);
end;
constructor TMyThread.Create(Susp: Boolean; CallBack: TInfoMessageCall);
begin
Inherited Create(Susp);
FInfoProc := CallBack;
end;
procedure TMyThread.Execute;
var
i:Integer;
begin
inherited;
for I := 1 to 10 do
begin
FMessage := Format('Info %d',[i]);
Synchronize(CallCallBack);
Sleep(200);
end;
end;
end.

Resources