2
\$\begingroup\$

Please give thoughts and optimization tips on my thread library.

Update 1 : I have renamed the different method types.

unit AgThread13;

interface

uses
  SysUtils, Classes, Windows, Rtti;

type

  {$SCOPEDENUMS ON$}

  TAgCallType = ( Direct, Synchronize, Queue );

  TAgThread = class;

  TAgThreadSimpleObjectMethod    = procedure of object;
  TAgThreadSimpleAnonymousMethod = procedure;
  TAgThreadObjectMethodWithSelf  = procedure ( const AThread: TAgThread ) of object;

  TAgThread = class ( TThread )
  strict private

    FTag                   : NativeInt;
    FInterval              : NativeInt;
    FEvent                 : THandle;
    FRun                   : Boolean;
    FOnExecute             : TAgThreadSimpleObjectMethod;
    FOnRun                 : TAgThreadSimpleObjectMethod;
    FSimpleObjectMethod    : TAgThreadSimpleObjectMethod;
    FSimpleAnonymousMethod : TAgThreadSimpleAnonymousMethod;
    FObjectMethodWithSelf  : TAgThreadObjectMethodWithSelf;
    FName                  : String;
    FCallType              : TAgCallType;

    procedure SetRun ( const AValue : Boolean );

    function  GetInterval: NativeInt;
    procedure SetInterval ( const AValue : NativeInt );

    procedure SetSimpleObjectMethod    ( const AValue : TAgThreadSimpleObjectMethod    );
    procedure SetSimpleAnonymousMethod ( const AValue : TAgThreadSimpleAnonymousMethod );
    procedure SetObjectMethodWithSelf  ( const AValue : TAgThreadObjectMethodWithSelf );

    procedure DirectCallSimpleObjectMethod; inline;
    procedure DirectCallSimpleAnonymousMethod; inline;
    procedure DirectCallObjectMethodWithSelf; inline;
    procedure SynchronizeSimpleObjectMethod;
    procedure SynchronizeSimpleAnonymousMethod;
    procedure SynchronizeObjectMethodWithSelf;
    procedure QueueSimpleObjectMethod;
    procedure QueueSimpleAnonymousMethod;
    procedure QueueObjectMethodWithSelf;

  strict protected

    procedure Execute; override;
    procedure ExecuteSimpleObjectMethod; virtual;
    procedure ExecuteSimpleAnonymousMethod; virtual;
    procedure ExecuteObjectMethodWithSelf; virtual;

  public

    constructor Create ( const AInterval : NativeInt; const ARun : Boolean = True;
                         const ACallType : TAgCallType = TAgCallType.Direct; 
                         const AName     : String = '' );
    destructor  Destroy; override;

    property  Name     : String                         
              read  FName;

    property  CallType : TAgCallType                    
              read  FCallType;

    property  Run      : Boolean                        
              read  FRun        write SetRun;

    property  Interval : NativeInt                      
              read  GetInterval write SetInterval;

    property  Tag      : NativeInt                      
              read  FTag        write FTag;

    property  OnRun1   : TAgThreadSimpleObjectMethod                      
                                write SetSimpleObjectMethod;

    property  OnRun2   : TAgThreadSimpleAnonymousMethod                   
                                write SetSimpleAnonymousMethod;

    property  OnRun3   : TAgThreadObjectMethodWithSelf                    
                                write SetObjectMethodWithSelf;

  end;

implementation

constructor TAgThread.Create
            ( const AInterval : NativeInt;
              const ARun      : Boolean     = True;
              const ACallType : TAgCallType = TAgCallType.Direct;
              const AName     : String      = '' );
begin

  FEvent    := CreateEvent ( nil, TRUE, FALSE, nil );
  FInterval := AInterval;
  Run       := ARun;
  FName     := AName;
  FCallType := ACallType;

  inherited Create ( False );

end;

destructor  TAgThread.Destroy;
begin
  SetEvent ( FEvent );
  WaitFor;
  inherited;
end;

procedure TAgThread.SetRun
          ( const AValue:  Boolean );
begin
  FRun := AValue;
end;

function  TAgThread.GetInterval: NativeInt;
begin
  Result := FInterval;
end;

procedure TAgThread.SetInterval
          ( const AValue : NativeInt );
begin
  if AValue > 0 then
    FInterval := AValue;
end;

procedure TAgThread.SetSimpleObjectMethod
          ( const AValue : TAgThreadSimpleObjectMethod );
begin

  if not Assigned ( AValue ) then Exit;
  FSimpleObjectMethod := AValue;
  FOnExecute          := ExecuteSimpleObjectMethod;

  case FCallType of
    TAgCallType.Direct      : FOnRun := DirectCallSimpleObjectMethod;
    TAgCallType.Synchronize : FOnRun := SynchronizeSimpleObjectMethod;
    TAgCallType.Queue       : FOnRun := QueueSimpleObjectMethod;
  end;

end;

procedure TAgThread.SetSimpleAnonymousMethod
          ( const AValue : TAgThreadSimpleAnonymousMethod );
begin

  if not Assigned ( AValue ) then Exit;
  FSimpleAnonymousMethod := AValue;
  FOnExecute             := ExecuteSimpleAnonymousMethod;

  case FCallType of
    TAgCallType.Direct      : FOnRun := DirectCallSimpleAnonymousMethod;
    TAgCallType.Synchronize : FOnRun := SynchronizeSimpleAnonymousMethod;
    TAgCallType.Queue       : FOnRun := QueueSimpleAnonymousMethod;
  end;

end;

procedure TAgThread.SetObjectMethodWithSelf
          ( const AValue : TAgThreadObjectMethodWithSelf );
begin

  if not Assigned ( AValue ) then Exit;
  FObjectMethodWithSelf := AValue;
  FOnExecute            := ExecuteObjectMethodWithSelf;

  case FCallType of
    TAgCallType.Direct      : FOnRun := DirectCallObjectMethodWithSelf;
    TAgCallType.Synchronize : FOnRun := SynchronizeObjectMethodWithSelf;
    TAgCallType.Queue       : FOnRun := QueueObjectMethodWithSelf;
  end;

end;

procedure TAgThread.DirectCallSimpleObjectMethod;
begin
  FSimpleObjectMethod;
end;

procedure TAgThread.DirectCallSimpleAnonymousMethod;
begin
  FSimpleAnonymousMethod;
end;

procedure TAgThread.DirectCallObjectMethodWithSelf;
begin
  FObjectMethodWithSelf ( Self );
end;

procedure TAgThread.SynchronizeSimpleObjectMethod;
begin
  Synchronize ( FSimpleObjectMethod );
end;

procedure TAgThread.SynchronizeSimpleAnonymousMethod;
begin
  Synchronize ( FSimpleAnonymousMethod );
end;

procedure TAgThread.SynchronizeObjectMethodWithSelf;
begin
  Synchronize ( procedure
                begin
                  FObjectMethodWithSelf ( Self )
                end );
end;

procedure TAgThread.QueueSimpleObjectMethod;
begin
  Queue ( FSimpleObjectMethod );
end;

procedure TAgThread.QueueSimpleAnonymousMethod;
begin
  Queue ( FSimpleAnonymousMethod );
end;

procedure TAgThread.QueueObjectMethodWithSelf;
begin
  Queue ( procedure
          begin
            FObjectMethodWithSelf ( Self )
          end );
end;

procedure TAgThread.Execute;
begin
  FOnExecute;
  Terminate;
end;

procedure TAgThread.ExecuteSimpleObjectMethod;
begin

  while True do
  begin

    if WaitForSingleObject ( FEvent, FInterval ) = WAIT_OBJECT_0 then
      break;
    if FRun then
      if Assigned ( FSimpleObjectMethod ) then
        FOnRun;

  end;

end;

procedure TAgThread.ExecuteSimpleAnonymousMethod;
begin

  while True do
  begin

    if WaitForSingleObject ( FEvent, FInterval ) = WAIT_OBJECT_0 then
      break;
    if FRun then
      if Assigned ( FSimpleAnonymousMethod ) then
        FOnRun;

  end;

end;

procedure TAgThread.ExecuteObjectMethodWithSelf;
begin

  while True do
  begin

    if WaitForSingleObject ( FEvent, FInterval ) = WAIT_OBJECT_0 then
      break;
    if FRun then
      if Assigned ( FObjectMethodWithSelf ) then
        FOnRun;

  end;

end;

end.
\$\endgroup\$
  • \$\begingroup\$ What's with the Identifier{1,2,3}? Is there really nothing that differentiates those enough for them to warrant their own names? \$\endgroup\$ – cHao Apr 11 '14 at 12:52
  • \$\begingroup\$ @cHao The identifier suffixes 1,2,3 signify the type of method to expect at execution. That can be named but would end up being too explanatory. The arguments would suffice for meaningfulness here. \$\endgroup\$ – Umair Ahmed Apr 11 '14 at 14:28
  • \$\begingroup\$ All the more reason to actually give them descriptive names. I sure don't know WTF a "type 3" method is, without rooting around in the code. Unless it's is a Delphi thing, which i rather doubt. \$\endgroup\$ – cHao Apr 11 '14 at 14:31
  • \$\begingroup\$ @cHao noted. I'll think of some appropriate names. \$\endgroup\$ – Umair Ahmed Apr 11 '14 at 14:32

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Browse other questions tagged or ask your own question.