[Lazarus] Threads
Antonio Fortuny
a.fortuny at sitasoftware.lu
Tue Aug 27 11:01:59 CEST 2013
Hi Folks.
I'm facing a problem where threads are involved.
I have a test program with a main form and using threads. When I run
without threads, a Close button executed the TForm.Close method and the
program terminates without problem.
But when the threads (one or more) on closing, the TForm.Close method is
still executed but the program continues execution. All other components
on the main form are still active.
As if the Close action had no effect. The same behaviour is observed in
Win32 and Linux.
Ther is the Execute method of the thread:
procedure TMsgTread.Execute;
var
PFileEvent: pDirNotifyEvent;
FileName: String;
len: Integer;
Counter: Integer=0;
Delay: Integer;
begin
Delay := MAX_DELAY;
FRunning := True;
while not terminated do begin
if Delay <= 0 then begin
PFileEvent := new(pDirNotifyEvent);
PFileEvent^.FileName := nil;
Inc(Counter);
FileName := Format('#%d file from_thread:%3.3d', [FID, Counter]);
len := Length(FileName);
PFileEvent^.FileNameSize := len;
ReAllocMem(PFileEvent^.FileName, len + 1);
Move(PChar(FileName)^, PFileEvent^.FileName^, len);
(PFileEvent^.FileName + len)^ := #0;
PFileEvent^.Actions := [fnaNewFile, fnaModified];
PostQMessage(FMessageQ, FILE_EVENT, PFileEvent^.FileName,
PFileEvent);
Delay := MAX_DELAY;
end;
Sleep(FTimeOut);
Dec(Delay, FTimeOut)
end;
PostQMessage(FMessageQ, 0, Format('thread #%d terminated', [FID]), nil);
FRunning := False
end;
the theards launching code:
for NThreads := 1 to EThreads.Value do begin
FMsgTread := TMsgTread.Create;
FMsgTread.SendToHandle := Self.Handle;
FMsgTread.ID := NThreads;
FMsgTread.MessageQ := FmsgQ;
FMsgTread.FMessageID := USER_FILE_MONITOR;
FMsgTread.TimeOut := wTimeOut;
ATh[NThreads - 1] := FMsgTread;
ATh[NThreads - 1].Start;
Inc(wTimeOut, 40);
if wTimeOut > 400 then
wTimeOut := 100 + NThreads;
FMsgTread := nil
end;
and the threads stop code:
for NThreads := 1 to EThreads.Value do begin
Memo1.Lines.Add(Format('Stoppting thread #%d', [NThreads]));
FMsgTread := ATh[NThreads - 1];
FMsgTread.Terminate;
WaitForThreadTerminate(FMsgTread.Handle, MAX_DELAY);
FreeAndNil(FMsgTread);
ATh[NThreads - 1] := nil;
Application.ProcessMessages
end;
Thanks.
Antonio.
More information about the Lazarus
mailing list