Custom thread error checking

[djjd47130]

I've built a custom thread which is designed in a way to be further inherited for common uses. It includes some things which the original TThread does not have, and since I am still uncomfortable with threads, I need someone to look this code over and point out any issues I might have with it.

Brief documentation is included in this unit at the top. There's also an example use of it further below. I've tested it quite a bit already, but I need a second eye on this. Multithreading is not a subject to joke with, I need to make sure I'm designing this right.

JD.Thread.pas

{ JD Thread Library
  Purpose:
    TJDThread is inherited from the standard TThread and encapsulates more
    common functionality than the original thread object. The structure of
    how it works differs greatly from the original thread.
  Additions:
    Start/Stop controls
    Start/Stop events
    ActiveX CoInitialize handling
    Init/Uninit override procedures and events
    Repeat loop executions
    Delay between loop executions
  Differences
    Resume/Terminate replaced with Start/Stop and Active property
    Execute procedure replaced with Run procedure
    Always executing, but only calling "Run" when active
  How to Use
    Standard threads requre overriding the "Execute" procedure, but this thread
    instead requires overriding the "Run" procedure. Initialize and Uninitialize
    procedures also require overriding and are called upon creation/destruction
    of the entire thread. The init procs are useful for creating/destroying
    certain private classes and preparing for the actual execution.
}
unit JD.Thread;

interface

uses
  Windows, Classes, SysUtils, ActiveX, ComObj;

type
  TJDThread = class;

  TJDThreadEvent = procedure(Sender: TJDThread) of object;

  TJDThread = class(TThread)
  private
    FActive: Bool;
    FExecDelay: Integer;
    FRepeatExec: Bool;
    FUsesActiveX: Bool;
    FOnAfterRun: TJDThreadEvent;
    FOnBeforeRun: TJDThreadEvent;
    FOnStop: TJDThreadEvent;
    FOnStart: TJDThreadEvent;
    FOnInitialize: TJDThreadEvent;
    FOnUninitialize: TJDThreadEvent;
    procedure Startup;
    procedure Cleanup;
    procedure Execute; override;
    procedure Resume;
    procedure Terminate;
    procedure SetExecDelay(const Value: Integer);
    procedure SetActive(const Value: Bool);
    procedure SetRepeatExec(const Value: Bool);
    procedure SetUsesActiveX(const Value: Bool);
  protected
    procedure Run; virtual; abstract;
    procedure Initialize; virtual;
    procedure Uninitialize; virtual;
    procedure SYNC_OnStart;
    procedure SYNC_OnStop;
    procedure SYNC_OnBeforeRun;
    procedure SYNC_OnAfterRun;
    procedure SYNC_OnInit;
    procedure SYNC_OnUninit;
  public
    constructor Create(CreateSuspended: Bool);
    destructor Destroy; override;
    procedure Start;
    procedure Stop;
    property Active: Bool read FActive write SetActive default False;
    property ExecDelay: Integer read FExecDelay write SetExecDelay default 0;
    property RepeatExec: Bool read FRepeatExec write SetRepeatExec default False;
    property UsesActiveX: Bool read FUsesActiveX write SetUsesActiveX default False;
    property OnStart: TJDThreadEvent read FOnStart write FOnStart;
    property OnStop: TJDThreadEvent read FOnStop write FOnStop;
    property OnBeforeRun: TJDThreadEvent read FOnBeforeRun write FOnBeforeRun;
    property OnAfterRun: TJDThreadEvent read FOnAfterRun write FOnAfterRun;
    property OnInitialize: TJDThreadEvent read FOnInitialize write FOnInitialize;
    property OnUninitialize: TJDThreadEvent read FOnUninitialize write FOnUninitialize;
  end;

implementation

{ TJDThread }

constructor TJDThread.Create(CreateSuspended: Bool);
begin
  inherited Create(True);
  FActive:= False;
  FExecDelay:= 0;
  FRepeatExec:= False;
  FUsesActiveX:= False;
  FActive:= not CreateSuspended;
  Resume;
end;

destructor TJDThread.Destroy;
begin
  FActive:= False;
  Terminate;
  WaitFor;
  inherited;
end;

procedure TJDThread.Startup;
begin
  Initialize;
end;

procedure TJDThread.Cleanup;
begin
  Uninitialize;
end;

procedure TJDThread.Start;
begin
  if not FActive then begin
    FActive:= True;
    Synchronize(SYNC_OnStart);
  end;
end;

procedure TJDThread.Stop;
begin
  if FActive then begin
    FActive:= False;
    Synchronize(SYNC_OnStop);
  end;
end;

procedure TJDThread.SYNC_OnAfterRun;
begin
  if assigned(FOnAfterRun) then
    FOnAfterRun(Self);
end;

procedure TJDThread.SYNC_OnBeforeRun;
begin
  if assigned(FOnBeforeRun) then
    FOnBeforeRun(Self);
end;

procedure TJDThread.SYNC_OnInit;
begin
  if assigned(FOnInitialize) then
    FOnInitialize(Self);
end;

procedure TJDThread.SYNC_OnStart;
begin
  if assigned(FOnStart) then
    FOnStart(Self);
end;

procedure TJDThread.SYNC_OnStop;
begin
  if assigned(FOnStop) then
    FOnStop(Self);
end;

procedure TJDThread.SYNC_OnUninit;
begin
  if assigned(FOnUninitialize) then
    FOnUninitialize(Self);
end;

procedure TJDThread.Execute;
begin
  Startup;
  try
    while not Terminated do begin
      if FActive then begin
        Synchronize(SYNC_OnBeforeRun);
        Run;
        Synchronize(SYNC_OnAfterRun);
        if Terminated then Break;        
        if not FRepeatExec then
          Stop
        else
          if FExecDelay > 0 then
            Sleep(FExecDelay);
      end else begin
        Sleep(1);
      end;
    end;
    Terminate;
  finally
    Cleanup;
  end;
end;

procedure TJDThread.Initialize;
begin
  Synchronize(SYNC_OnInit);
  if FUsesActiveX then
    CoInitialize(nil);
end;

procedure TJDThread.Uninitialize;
begin
  if FUsesActiveX then
    CoUninitialize;
  Synchronize(SYNC_OnUninit);
end;

procedure TJDThread.Resume;
begin
  inherited Resume;
end;

procedure TJDThread.SetActive(const Value: Bool);
begin
  if Value then begin
    Start;
  end else begin
    Stop;
  end;
end;

procedure TJDThread.SetExecDelay(const Value: Integer);
begin
  FExecDelay := Value;
end;

procedure TJDThread.SetRepeatExec(const Value: Bool);
begin
  FRepeatExec := Value;
end;

procedure TJDThread.SetUsesActiveX(const Value: Bool);
begin
  if not FActive then
    FUsesActiveX := Value;
end;

procedure TJDThread.Terminate;
begin
  inherited Terminate;
end;

end.

uMain.pas
Sample Implementation

unit uMain;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics, DB, ADODB,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Buttons,
  JD.Thread, Vcl.ExtCtrls;

type
  TMyThread = class(TJDThread)
  private
    FDB: TADOConnection;
  protected
    procedure Run; override;
    procedure Initialize; override;
    procedure Uninitialize; override;
  end;

  TfrmMain = class(TForm)
    Log: TMemo;
    Panel1: TPanel;
    cmdControl: TBitBtn;
    procedure cmdControlClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
  private
    FThread: TMyThread;
    procedure ThreadStart(Sender: TJDThread);
    procedure ThreadStop(Sender: TJDThread);
    procedure ThreadBeforeRun(Sender: TJDThread);
    procedure ThreadAfterRun(Sender: TJDThread);
    procedure ThreadInit(Sender: TJDThread);
    procedure ThreadUninit(Sender: TJDThread);
  public
    procedure PostLog(const Msg: String);
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.dfm}

{ TfrmMain }

procedure TfrmMain.cmdControlClick(Sender: TObject);
begin
  if FThread.Active then begin
    FThread.Stop;
    cmdControl.Caption:= 'Start';
  end else begin
    FThread.Start;
    cmdControl.Caption:= 'Stop';
  end;
end;

procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  FThread.Stop;
  FThread.Free;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  FThread:= TMyThread.Create(True);
  FThread.OnStart:= ThreadStart;
  FThread.OnStop:= ThreadStop;
  FThread.OnBeforeRun:= ThreadBeforeRun;
  FThread.OnAfterRun:= ThreadAfterRun;
  FThread.OnInitialize:= ThreadInit;
  FThread.OnUninitialize:= ThreadUninit;
  FThread.ExecDelay:= 200;
  FThread.RepeatExec:= True;
  FThread.UsesActiveX:= True;
end;

procedure TfrmMain.PostLog(const Msg: String);
begin
  Log.Lines.Append(Msg);
end;

procedure TfrmMain.ThreadAfterRun(Sender: TJDThread);
begin
  PostLog(' - Executed.');
end;

procedure TfrmMain.ThreadBeforeRun(Sender: TJDThread);
begin
  PostLog(' - Executing...');
end;

procedure TfrmMain.ThreadInit(Sender: TJDThread);
begin
  PostLog(' - Initialized.');
end;

procedure TfrmMain.ThreadStart(Sender: TJDThread);
begin
  PostLog(' - Started');
end;

procedure TfrmMain.ThreadStop(Sender: TJDThread);
begin
  PostLog(' - Stopped');
end;

procedure TfrmMain.ThreadUninit(Sender: TJDThread);
begin
  PostLog(' - Uninitialized.');
end;

{ TMyThread }

procedure TMyThread.Initialize;
begin
  inherited;
  FDB:= TADOConnection.Create(nil);
  FDB.LoginPrompt:= False;
  FDB.ConnectionString:= [REPLACE WITH CONNECTION STRING];
  try
    FDB.Connected:= True;
  except
    on e: exception do begin
      FDB.Connected:= False;
    end;
  end;
end;

procedure TMyThread.Uninitialize;
begin
  FDB.Connected:= False;
  FDB.Free;
  inherited;
end;

procedure TMyThread.Run;
var
  Q: TADOQuery;
begin
  Q:= TADOQuery.Create(nil);
  try
    Q.Connection:= FDB;
    Q.SQL.Text:= 'select ID, Rug_No from invent';
    try
      Q.Open;
      //Do some random heavy task with results
    finally
      Q.Close;
    end;
  finally
    Q.Free;
  end;
end;

end.

uMain.dfm

object frmMain: TfrmMain
  Left = 569
  Top = 239
  Caption = 'JD Thread Test'
  ClientHeight = 336
  ClientWidth = 489
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnClose = FormClose
  OnCreate = FormCreate
  DesignSize = (
    489
    336)
  PixelsPerInch = 96
  TextHeight = 13
  object Log: TMemo
    Left = 8
    Top = 47
    Width = 433
    Height = 281
    Anchors = [akLeft, akTop, akRight, akBottom]
    ScrollBars = ssVertical
    TabOrder = 0
  end
  object Panel1: TPanel
    Left = 0
    Top = 0
    Width = 489
    Height = 41
    Align = alTop
    TabOrder = 1
    ExplicitWidth = 481
    object cmdControl: TBitBtn
      Left = 8
      Top = 8
      Width = 129
      Height = 25
      Caption = 'Start'
      TabOrder = 0
      OnClick = cmdControlClick
    end
  end
end

JD Solutions

 

[Griffyn]

Some feedback:
[ul]
[li]In your Destroy destructor, you call Terminate and WaitFor, neither of which should be there. Terminate simply sets a flag in the thread, and you cannot use WaitFor in it's own thread. Waitfor is used by any other thread that will suspend that thread until your thread object terminates. Regardless, there's simply no point to either of these in the Destroy destructor, as the thread is already terminating.[/il]
[li]Your Terminate method does nothing. There's no need to override a virtual method if all you do is call it's inherited method.[/il]

Otherwise - looks handy.