jvqmtcomponents.pas

East make Tray Icon in delphi

end;

procedure TJvMTThread.OnIntTerminating(Thread: TMTThread);
begin
  DoTerminating(TJvMTSingleThread(Thread));
end;

procedure TJvMTThread.ReleaseThread;
begin
  // check if there is an acquired thread
  if FThread <> nil then
  begin
    // release the thread and invalidate the pointer
    FThread.Release;
    FThread := nil;
  end;
end;

procedure TJvMTThread.Run;
begin
  HookThread;
  FThread.Run;
end;

procedure TJvMTThread.RunCopy;
begin
  ReleaseThread;
  Run;
end;

procedure TJvMTThread.SetManager(Value: TJvMTManager);
begin
  UnHookThread;
  inherited SetManager(Value);
end;

procedure TJvMTThread.SetOnExecute(Value: TJvMTThreadEvent);
begin
  UnHookThread;
  FOnExecute := Value;
end;

procedure TJvMTThread.SetOnFinished(Value: TJvMTThreadEvent);
begin
  UnHookThread;
  FOnFinished := Value;
end;

procedure TJvMTThread.SetOnTerminating(Value: TJvMTThreadEvent);
begin
  UnHookThread;
  FOnTerminating := Value;
end;

procedure TJvMTThread.Synchronize(Method: TThreadMethod);
begin
  HookThread;
  FThread.Synchronize(Method);
end;

procedure TJvMTThread.Terminate;
begin
  HookThread;
  FThread.Terminate;
end;

procedure TJvMTThread.UnHookThread;
begin
  if FThread <> nil then
  begin
    if FThread.Status in [tsInitializing, tsFinished] then
    begin
      FThread.Terminate; {incase initializing}
      FThread.Release;
      FThread := nil;
    end
    else
      raise EThread.CreateRes(@RsEOperatorNotAvailable);
  end;
end;

procedure TJvMTThread.Wait;
begin
  HookThread;
  FThread.Wait;
end;
    
procedure TJvMTThread.DoExecute(MTThread: TJvMTSingleThread);
begin
  if Assigned(FOnExecute) then
    FOnExecute(Self, MTThread);
end;

procedure TJvMTThread.DoFinished(MTThread: TJvMTSingleThread);
begin
  if Assigned(FOnFinished) then
    FOnFinished(Self, MTThread);
end;

procedure TJvMTThread.DoTerminating(MTThread: TJvMTSingleThread);
begin
  if Assigned(FOnTerminating) then
    FOnTerminating(Self, MTThread);
end;

procedure TJvMTThread.Loaded;
begin
  inherited Loaded;
  // Component is ready. Shall we start a thread?
  if (not (csDesigning in ComponentState)) and FRunOnCreate then
    Run;
end;

//=== { TJvMTSectionBase } ===================================================

destructor TJvMTSectionBase.Destroy;
begin
  // signal interested components that we are going down
  inherited Destroy;
  // cleanup
  FSync.Free;
end;

procedure TJvMTSectionBase.CheckInactiveProperty;
begin
  if Active then
    raise EThread.CreateRes(@RsECannotChangePropertySection);
end;

procedure TJvMTSectionBase.Enter;
begin
  HookSync;
  FSync.Acquire;
end;

function TJvMTSectionBase.GetActive: Boolean;
begin
  Result := FSync <> nil;
end;

procedure TJvMTSectionBase.HookSync;
begin
  if not Active then
    CreateSync;
end;

procedure TJvMTSectionBase.Leave;
begin
  HookSync;
  FSync.Release;
end;

//=== { TJvMTSection } =======================================================

constructor TJvMTSection.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FAllowRecursion := True;
end;

procedure TJvMTSection.CreateSync;
begin
  if FAllowRecursion then
    FSync := TMTCriticalSection.Create(Name)
  else
    FSync := TMTMutex.Create(Name);

  if FInitEntered then
    Enter;
end;

procedure TJvMTSection.SetAllowRecursion(Value: Boolean);
begin
  CheckInactiveProperty;
  FAllowRecursion := Value;
end;

procedure TJvMTSection.SetInitEntered(Value: Boolean);
begin
  CheckInactiveProperty;
  FInitEntered := Value;
end;

//=== { TJvMTCountingSection } ===============================================

constructor TJvMTCountingSection.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FMaxCount := 1;
end;

procedure TJvMTCountingSection.CreateSync;
begin
  FSync := TMTSemaphore.Create(FMaxCount-FInitCount, FMaxCount, Name);
end;

procedure TJvMTCountingSection.SetInitAndMax(Init,Max: Integer);
begin
  CheckInactiveProperty;
  if (Max < 1) or (Init < 0) or (Init > Max) then
    raise EInvalidOperation.CreateResFmt(@SPropertyOutOfRange, [ClassName]);
  
  FInitCount := Init;
  FMaxCount := Max;
end;

procedure TJvMTCountingSection.SetInitCount(Value: Integer);
begin
  SetInitAndMax(Value, FMaxCount);
end;

procedure TJvMTCountingSection.SetMaxCount(Value: Integer);
begin
  SetInitAndMax(FInitCount, Value);
end;

//=== { TJvMTAsyncBufferBase } ===============================================

constructor TJvMTAsyncBufferBase.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FMaxBufferSize := MTDefaultBufferSize;
  FHooking := TCriticalSection.Create;
end;

destructor TJvMTAsyncBufferBase.Destroy;
begin
  // notify interested components
  inherited Destroy;
  // cleanup
  FBuffer.Free;
  FHooking.Free;
end;

procedure TJvMTAsyncBufferBase.HookBuffer;
begin
  // buffer still uncreated?
  if FBuffer = nil then
  begin
    // enter critical section
    FHooking.Enter;
    try
      // perform check again. and create if we are the first in this section
      if FBuffer = nil then
       CreateBuffer;
    finally
      FHooking.Leave;
    end;
  end;
end;

function TJvMTAsyncBufferBase.Read: TObject;
begin
  HookBuffer;
  Result := FBuffer.Read;
end;

procedure TJvMTAsyncBufferBase.SetMaxBufferSize(Value: Integer);
begin
  if FBuffer <> nil then
    raise EThread.CreateRes(@RsECannotChangePropertyBuffer);
  FMaxBufferSize := Value;
end;

procedure TJvMTAsyncBufferBase.Write(AObject: TObject);
begin
  HookBuffer;
  FBuffer.Write(AObject);
end;

//=== { TJvMTThreadToVCL } ===================================================

procedure TJvMTThreadToVCL.CreateBuffer;
begin
  FBuffer := TMTBufferToVCL.Create(FMaxBufferSize, Name);
  TMTBufferToVCL(FBuffer).OnCanRead := DoCanRead;
end;

procedure TJvMTThreadToVCL.DoCanRead(Sender: TObject);
begin
  // call the OnCanRead event with this object as the sender
  if Assigned(FOnCanRead) then
    FOnCanRead(Self);
end;

//=== { TJvMTVCLToThread } ===================================================

procedure TJvMTVCLToThread.CreateBuffer;
begin
  FBuffer := TMTVCLToBuffer.Create(FMaxBufferSize, Name);
  TMTVCLToBuffer(FBuffer).OnCanWrite := DoCanWrite;
end;

procedure TJvMTVCLToThread.DoCanWrite(Sender: TObject);
begin
  // call the OnCanWrite event with this object as the sender
  if Assigned(FOnCanWrite) then
    FOnCanWrite(Self);
end;

procedure TJvMTVCLToThread.Loaded;
begin
  inherited Loaded;
  // force first Event
  HookBuffer;
  if Assigned(FOnCanWrite) then
    FOnCanWrite(Self);
end;

//=== { TJvMTThreadToThread } ================================================

constructor TJvMTThreadToThread.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FMaxBufferSize := MTDefaultBufferSize;
  FHooking := TCriticalSection.Create;
end;

destructor TJvMTThreadToThread.Destroy;
begin
  inherited Destroy;
  FQueue.Free;
  FHooking.Free;
end;

procedure TJvMTThreadToThread.HookQueue;
begin
  // buffer still uncreated?
  if FQueue = nil then
  begin
    // enter critical section
    FHooking.Enter;
    try
      // perform check again. and create if we are the first in this section
      if FQueue = nil then
        FQueue := TMTBoundedQueue.Create(FMaxBufferSize,Name);
    finally
      FHooking.Leave;
    end;
  end;
end;

function TJvMTThreadToThread.Read: TObject;
begin
  HookQueue;
  Result := FQueue.Pop;
end;

procedure TJvMTThreadToThread.SetMaxBufferSize(Value: Integer);
begin
  if FQueue <> nil then
    raise EThread.CreateRes(@RsECannotChangePropertyBuffer);
  if Value < 1 then
    raise EInvalidOperation.CreateResFmt(@SPropertyOutOfRange, [ClassName]);
  FMaxBufferSize := Value;
end;

procedure TJvMTThreadToThread.Write(AObject: TObject);
begin
  HookQueue;
  FQueue.Push(AObject);
end;

//=== { TJvMTMonitorSection } ================================================

constructor TJvMTMonitorSection.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FMonitor := TMTMonitor.Create;
end;

destructor TJvMTMonitorSection.Destroy;
begin
  FMonitor.Free;
  inherited Destroy;
end;

procedure TJvMTMonitorSection.Enter;
begin
  FMonitor.Enter;
end;

function TJvMTMonitorSection.GetCondition(ID: Integer): TMTCondition;
begin
  Result := FMonitor.Condition[ID];
end;

procedure TJvMTMonitorSection.Leave;
begin
  FMonitor.Leave;
end;


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

initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}


end.