jvqmtthreading.pas

East make Tray Icon in delphi

  try
    if Status = tsInitializing then
      CreateAndRun
    else
    if Status = tsWaiting then
      FIntThread.Resume
    else
      raise EMTThreadError.CreateRes(@RsEThreadNotInitializedOrWaiting);
  finally
    FStatusChange.Release;
  end;
end;

procedure TMTThread.SetName(const Value: string);
begin
  FStatusChange.Acquire;
  try
    if Status in [tsInitializing, tsFinished] then
      FName := Value
    else
    begin
      if CurrentMTThread <> Self then
        raise EMTThreadError.CreateRes(@RsECannotChangeNameOfOtherActiveThread);
  
      FName := Value;
      if FIntThread <> nil then
      begin
        FIntThread.Name := FName;
        FIntThread.RaiseName;
      end;
    end;
  finally
    FStatusChange.Release;
  end;
end;

procedure TMTThread.Synchronize(Method: TThreadMethod);
begin
  if CurrentMTThread = Self then
    FIntThread.Synchronize(Method)
  else
  if CurrentMTThread = nil then
    Method
  else
    CurrentMTThread.Synchronize(Method);
end;

procedure TMTThread.Terminate;
begin
  if Status in [tsTerminating, tsFinished] then
    Exit;
  
  FStatusChange.Acquire;
  try
    if FIntThread <> nil then
      FIntThread.Terminate  {thread was Running}
    else
      FFinished := True;    {thread was initializing}
  
    // make sure thread escapes from any Wait() calls
    ReleaseSemaphore(FTerminateSignal, 1, nil);
  finally
    FStatusChange.Release;
  end;
end;

procedure TMTThread.Wait;
var
  SelfRef: TMTThread;
begin
  if FManager.AcquireThread(Ticket, SelfRef) then
  try
    if GetCurrentThreadID = MainThreadID then
    begin
      while Status <> tsFinished do
      begin
        CheckSynchronize;
        Sleep(1);
      end;
    end
    else
    begin
      while Status <> tsFinished do
        Sleep(1);
    end;
  finally
    Release;
  end;
end;

//=== { TMTManager } =========================================================

constructor TMTManager.Create;
begin
  inherited Create;
  FGenTicket := TCriticalSection.Create;
  FThreadsChange := TCriticalSection.Create;
  FThreads := TObjectList.Create(True);
end;

destructor TMTManager.Destroy;
var
  I: Integer;
begin
  // set the terminate flag at each thread
  TerminateThreads;
  // wait for them to finish
  WaitThreads;

  FThreadsChange.Acquire;
  try
    for I := 0 to FThreads.Count-1 do
      Log('Unreleased thread: "' + TMTThread(FThreads[I]).Name + '"'); // do not localize
  finally
    FThreadsChange.Release;
  end;

  FThreads.Free;
  FThreadsChange.Free;
  FGenTicket.Free;
  inherited Destroy;
end;

function TMTManager.AcquireNewThread: TMTThread;
begin
  Result := TMTThread.Create(Self, GenerateTicket);
  try
    Result.IncRef;
    FThreadsChange.Acquire;
    try
      FThreads.Add(Result);
    finally
      FThreadsChange.Release;
    end;
  except
    Result.Free;
    raise;
  end;
end;

function TMTManager.AcquireThread(Ticket: TMTTicket; var Thread: TMTThread):
  Boolean;
begin
  FThreadsChange.Acquire;
  try
    Result := FindThread(Ticket, Thread);
    if Result then
      Thread.IncRef;
  finally
    FThreadsChange.Release;
  end;
end;

// returns 0 = False
//         1 = True
//        -1 = RaiseID found and active

function TMTManager.InternalActiveThreads(RaiseID: Longword): Integer;
var
  I: Integer;
begin
  Result := 0;
  FThreadsChange.Acquire;
  try
    for I := 0 to FThreads.Count - 1 do
      if TMTThread(FThreads[I]).Status <> tsFinished then
      begin
        if (RaiseID <> 0) and
           (TMTThread(FThreads[I]).FIntThread.ThreadID = RaiseID) then
          Result := -1
          // no Break; here: Return -1 only when RaiseID is the last active thread 
        else
        begin
          Result := 1;
          Break;
        end;
      end;
  finally
    FThreadsChange.Release;
  end;
end;

function TMTManager.ActiveThreads: Boolean;
begin
  Result := InternalActiveThreads(0) <> 0;
end;

function TMTManager.FindThread(Ticket: TMTTicket; var Thread: TMTThread):
  Boolean;
var
  I: Integer;
begin
  FThreadsChange.Acquire;
  try
    I := FThreads.Count-1;
    while (I <> -1) and (TMTThread(FThreads[I]).Ticket <> Ticket) do
      Dec(I);
  
    Result := I <> -1;
    if Result then
      Thread := TMTThread(FThreads[I])
    else
      Thread := nil;

  finally
    FThreadsChange.Release;
  end;
end;

function TMTManager.GenerateTicket: TMTTicket;
begin
  FGenTicket.Acquire;
  try
    Result := FNextTicket;
    Inc(FNextTicket);
  finally
    FGenTicket.Release;
  end;
end;

procedure TMTManager.Log(const Msg: string);
begin
  // (rom) no OutputDebugString in production code
  {$IFDEF DEBUGINFO_ON}
  OutputDebugString(PChar('[' + ClassName + '] ' + Msg));
  {$ENDIF DEBUGINFO_ON}
end;

procedure TMTManager.OnThreadFinished(Thread: TMTThread);
begin
  TryRemoveThread(Thread);
end;

procedure TMTManager.ReleaseThread(Ticket: TMTTicket);
var
  Thread: TMTThread;
begin
  FThreadsChange.Acquire;
  try
    if FindThread(Ticket, Thread) then
      Thread.DecRef
    else
      raise EMTThreadError.CreateRes(@RsEReleaseOfUnusedTicket);

    // if this was the last reference then the thread must be removed
    TryRemoveThread(Thread);
  finally
    FThreadsChange.Release;
  end;
end;

procedure TMTManager.TerminateThreads;
var
  I: Integer;
begin
  FThreadsChange.Acquire;
  try
    for I := 0 to FThreads.Count-1 do
      TMTThread(FThreads[I]).Terminate;
  finally
    FThreadsChange.Release;
  end;
end;

procedure TMTManager.TryRemoveThread(Thread: TMTThread);
begin
  FThreadsChange.Acquire;
  try
    if (Thread.Status = tsFinished) and (Thread.ReferenceCount = 0) then
      FThreads.Remove(Thread);
  finally
    FThreadsChange.Release;
  end;
end;

// wait until the threads are all finished

procedure TMTManager.WaitThreads;
begin
  // running from inside the main VCL thread?
  if GetCurrentThreadID = MainThreadID then
  begin
    //  use CheckSynchronise to process the OnFinished events
    while ActiveThreads do
    begin
      CheckSynchronize;
      Sleep(1);
    end;
  end
  else
  begin
    //running in a MTThread, just wait for all threads to finish
    while True do
    begin
      case InternalActiveThreads(GetCurrentThreadID) of
        0:
          Break;
        1:
          { Nothing };
       -1:
         raise EMTThreadError.CreateRes(@RsECurThreadIsPartOfManager);
      end;
      Sleep(1);
    end;
  end;
end;




{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvQMTThreading.pas,v $';
    Revision: '$Revision: 1.29 $';
    Date: '$Date: 2005/02/06 14:06:14 $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}


initialization 
  {$IFDEF UNITVERSIONING}
  RegisterUnitVersion(HInstance, UnitVersioning);
  {$ENDIF UNITVERSIONING} 
 

finalization 
 
  {$IFDEF UNITVERSIONING}
  UnregisterUnitVersion(HInstance);
  {$ENDIF UNITVERSIONING} 

end.