[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