The problem in the sample is mainly what is done inside the thread function; not exactly the BeginThread call itself.
If you want to interact with the LCL, you'd better use the TThread class instead. If you just want to use a very simple thread function, without any interaction with the LCL, BeginThread is OK.
So, it depends of your need.
Hereafter a very basic Lazarus test program, using a global variable and a timer to test the end of the thread (see atached project "BeginThreadTest.zip").
The interesting part of the code:
...
uses
Windows;
function MyThreadFunc(Parameter: pointer): integer; forward;
var
ThreadId: TThreadID;
ThreadOver: Boolean;
procedure TForm1.Button1Click(Sender: TObject);
begin
Application.Terminate;
end;
procedure TForm1.Button2Click(Sender: TObject);
var i: Longword;
begin
StaticText1.Caption := '';
ThreadOver := false;
ThreadId := BeginThread(nil, 0, @MyThreadFunc, @ThreadOver, 0, i);
if ThreadId = 0 then
ShowMessage('Error when beginning thread')
else
begin
StaticText1.Caption := sLineBreak + 'Thread is running...';
Timer1.Enabled := true;
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
if ThreadOver then
begin
CloseHandle(ThreadId);
StaticText1.Caption := sLineBreak + 'Thread has stopped.';
Timer1.Enabled := False;
end;
end;
function MyThreadFunc(Parameter: pointer): integer;
const NumberOfSeconds = 10;
var i: integer;
begin
result := 0; // (Avoids warning);
i := 0;
while i < NumberOfSeconds do
begin
SysUtils.Beep;
SysUtils.Sleep(1000);
inc(i);
end;
ThreadOver := true;
EndThread(0);
end;
Another Free Pascal test program to simulate a timer for a console program, using mainly Windows API (see "ttest.zip"), especially to detect the end of the thread.
program ttest;
{$mode objfpc}{$H+}
uses Windows;
const TIMER_INTERVAL = 5000; // (ms)
const TIMER_NBREVENTS = 1; // Number of External Events to look for in the Timer Thread (Only 1 in this sample)
const TIMER_MAXTICKS = 4; // Maximum Number of Timer Ticks (To simulate a way to exit from the test program)
var
HandEvGloEnd: Longword = 0; // Handle for Event : Global End
HandEvReqEnd: Longword = 0; // Handle for Event : Request End
HandleThread: Longword = 0; // Handle for Timer Thread
NbrTimerTicks: Integer = 0; // Current Number of Timer Ticks
// Called on Each Timer Tick
procedure ProcToCall();
begin
Writeln('Timer Tick');
Inc(NbrTimerTicks);
if NbrTimerTicks>=TIMER_MAXTICKS then
SetEvent(HandEvGloEnd); // Ask to quit the main infinite waiting
end;
function TimerThread(PP: Pointer): Integer;
var ArrEvHandle: array [0..Pred(TIMER_NBREVENTS)] of Longword; // Array of Events to Look for
begin
ArrEvHandle[0]:=HandEvReqEnd;
while True do
begin
Write('Waiting ... ');
WaitForMultipleObjects(TIMER_NBREVENTS,@ArrEvHandle,False,TIMER_INTERVAL);
if WaitforSingleObject(HandEvReqEnd,0)<>WAIT_TIMEOUT then // Request to End ?
begin
Writeln('No more waiting');
Break;
end;
ProcToCall();
end;
Result:=0;
EndThread(0);
end;
procedure StartTimerThread();
var i1: Longword;
begin
Writeln();
Writeln('Start Timer Thread');
HandEvReqEnd:=CreateEvent(Nil,True,False,PChar('MyEventNames_ReqEnd'));
HandleThread:=BeginThread(Nil,0,TThreadFunc(@TimerThread),Nil,0,i1);
end;
procedure StopTimerThread(Const ExitForced: Integer);
begin
Writeln('Stop Timer Thread');
if ExitForced=0 then
begin
SetEvent(HandEvReqEnd);
WaitForSingleObject(HandleThread,3000); // Wait 3s mawimum for the "real" ending of the thread (it should be quite enough)
end;
CloseHandle(HandEvReqEnd);
CloseHandle(HandleThread);
end;
begin
HandEvGloEnd:=CreateEvent(Nil,True,False,PChar('MyEventNames_GloEnd'));
StartTimerThread();
WaitforSingleObject(HandEvGloEnd,INFINITE); // Simulate an infinite waiting
StopTimerThread(0);
CloseHandle(HandEvGloEnd);
end.
*** Edit *** And BeginThread is not very portable, while TThread is.