unit MaThread;

interface

Uses  Classes, SysUtils;

type
  {- Define an exception to use for this component -}
    EMaThreadException = class(Exception);
   {- Define a routine class for this component }
   TMaProcRoutine = procedure of object;
  {- Define THandle as an integer -}
   THandle = Word;
   {- Define the actual thread that will be used -}
  TMaRealThread = class(TThread)
    Private
      fVCLRoutine : TMaProcRoutine;    { users vcl routine }
       fUserProcedure : TMaProcRoutine;  { Users thread routine }
      Procedure SyncWithVCL;        { internal sync with vcl routine }
    Public
    Procedure VCLUpdate(Var VCLProc:TMaProcRoutine);  { my visual method }
     Procedure Execute; OverRide;    { my execute method }
    end;
  {- Define the non-visual component, that the user will use/see -}
  TMaThread = class(TComponent)
    private
    { Private declarations }
      fActualThread : TMaRealThread;
      fActualThreadCreated : Boolean;
      fPriority : TThreadPriority;
    fOnStart : TNotifyEvent;
       fOnTerminate : TNotifyEvent;
       fOnThread : TThreadMethod;
       fSuspended : Boolean;
    protected
    { Protected declarations }
      Constructor Create(AOwner : TComponent);Override;
      Destructor Destroy; Override;
       Procedure SetPriority(NewPriority:TThreadPriority);
       Procedure SetSuspended(NewValue:Boolean);
    public
    { Public declarations }
    Procedure VCLUpdate(UserProc:TMaProcRoutine);  { Update screen }
       Procedure Execute;              { Start the thread }
       Procedure Terminate;            { Kill thread }
       Procedure Suspend;              { Suspend thread - note you need to resume as many times }
       Procedure Resume;              { as you have suspended (nested) }
       Function GetThreadHandle : tHandle;      { allows you to get access to the actual thread handle }
       Function GetThreadID : tHandle;        { allows you access to the actual threads id }
    published
    { Published declarations }
      { your routine - called over and over again til terminated don't loop your routine internally !}
       Property OnBeforeThread : TNotifyEvent Read fOnStart Write fOnStart;
      { your routine - called over and over again til terminated don't loop your routine internally !}
       Property OnThread : TThreadMethod Read fOnThread Write fOnThread;
    { once the thread is completed (terminated) this is run if set }
       Property OnAfterThread : TNotifyEvent Read fOnTerminate Write fOnTerminate;
       { allows you to change the priority of the thread }
       Property Priority : TThreadPriority Read fPriority Write SetPriority Default tpNormal;
       { allows you to change it to suspended or not }
       Property Suspended : Boolean Read fSuspended Write SetSuspended Default False;
  end;

procedure Register;

implementation
{------------------------------------------------------------------------------}
{- tMAThreadClass                                                             -}
{------------------------------------------------------------------------------}
Procedure TMaRealThread.Execute;
begin
  While Not Terminated do fUserProcedure;
end;
{------------------------------------------------------------------------------}
Procedure TMaRealThread.VCLUpdate(Var VCLProc:TMaProcRoutine);
begin
  fVCLRoutine := VCLProc;
  Synchronize(SyncWithVCL);
end;
{------------------------------------------------------------------------------}
Procedure TMaRealThread.SyncWithVCL;
begin
  fVCLRoutine;
end;
{------------------------------------------------------------------------------}
{- tMAThread                                                                  -}
{------------------------------------------------------------------------------}
Constructor TMAThread.Create(AOwner:TComponent);
begin
  inherited Create(AOwner);
   fPriority := tpNormal;
   fSuspended := False;
end;
{------------------------------------------------------------------------------}
Destructor  TMaThread.Destroy;
begin
  If fActualThreadCreated then begin
     { Don't run event if form is being destroyed ! }
       OnAfterThread := Nil;
     Terminate;
       end;
  inherited Destroy;
end;
{------------------------------------------------------------------------------}
Procedure TMAThread.VCLUpdate(UserProc:TMaProcRoutine);
begin
  fActualThread.VCLUpdate(UserProc);
end;
{------------------------------------------------------------------------------}
Procedure TMAThread.SetPriority(NewPriority:TThreadPriority);
begin
  fPriority := NewPriority;
  If csDesigning in ComponentState then Exit;
  If not fActualThreadCreated then Exit;
   fActualThread.Priority := fPriority;
end;
{------------------------------------------------------------------------------}
Procedure TMAThread.Execute;
begin
  If Not Assigned(OnThread) then begin
     Raise EMaThreadException.Create('Nothing For The Thread To Run');
       Exit;
       end;
  If fActualThreadCreated then begin
     Raise EMaThreadException.Create('Thread Already Started');
       exit;
       end;
  If Assigned(OnBeforeThread) then fOnStart(self);
  fActualThread := TMaRealThread.Create(False);
  fActualThread.fUserProcedure := OnThread;
  fActualThread.FreeOnTerminate := True;
  fActualThreadCreated := True;
   fActualThread.Priority := Priority;
   fActualThread.Suspended := Suspended;
end;
{------------------------------------------------------------------------------}
Procedure TMAThread.Terminate;
begin
  If Not fActualThreadCreated then begin
     Raise EMaThreadException.Create('Thread Has Not Been Started');
       exit;
       end;
   { in case it is suspended remove all before terminate }
   While fActualThread.Suspended do fActualThread.Resume;
  FActualThread.Terminate;
  fActualThreadCreated := False;
   If Assigned(OnAfterThread) then OnAfterThread(Self);
end;
{------------------------------------------------------------------------------}
Procedure TMAThread.Suspend;
begin
  fSuspended := True;
  If not fActualThreadCreated then Exit;
  fActualThread.Suspend;
end;
{------------------------------------------------------------------------------}
Procedure TMAThread.Resume;
begin
  If not fActualThreadCreated then begin
     fSuspended := False;
     Exit;
       end;
  fActualThread.Resume;
   fSuspended := fActualThread.Suspended;
end;
{------------------------------------------------------------------------------}
Procedure TMAThread.SetSuspended(NewValue:Boolean);
begin
  fSuspended := NewValue;
  If csDesigning in ComponentState then Exit;
  If not fActualThreadCreated then Exit;
   Suspend;
end;
{------------------------------------------------------------------------------}
Function TMAThread.GetThreadHandle : THandle;
begin
  Result := 0;
  If not fActualThreadCreated then Exit;
  Result := fActualThread.Handle;
end;
{------------------------------------------------------------------------------}
Function TMaThread.GetThreadID : THandle;
begin
  Result := 0;
  If not fActualThreadCreated then Exit;
  Result := fActualThread.ThreadId;
end;
{------------------------------------------------------------------------------}
{- Registration Time                                                          -}
{------------------------------------------------------------------------------}
procedure Register;
begin
  RegisterComponents('Custom', [TMaThread]);
end;
{------------------------------------------------------------------------------}
end.

Here is some more information about this component:

Properties
Name   String, Standard component name.

Suspended  Boolean, Allows you to suspend or resume a thread whilst running, or before it has started (see also : Methods Suspend/Resume).

Priority  TThreadPriority, Allows you to change to level at which this thread will run at, the options are (in lowest to highest order) : tpIdle, tpLowest, tpLower, tpNormal (Default), tpHigher, tpHighest, tpTimeCritical.

Tag   Integer, Standard component tag.

Methods
Execute  Starts (and creates) the actual thread running, if the OnThread has not been assigned, an exception will occur, if the thread has already started then an exception will occur.

Terminate  Stops (and frees) the actual thread. If the thread is not running then an exception will occur.

Suspend  Temporarily Stops the thread , this is a nested call, so for each time you call suspend, you must call a resume (calling suspend twice, then calling resume 1 will leave the thread suspended, 2-1=1 !).

Resume  Starts a temporarily stopped thread, see Suspend.

GetThreadHandle Returns the actual threads handle (tHandle)

GetThreadId  Returns the actual thread Id (THandle)

VCLUpdate(UserProc:TProcRoutine);
   Users routine to update a vcl component, send with an update routine in it.

Events
OnAfterThread Optional, allows you to do something after the thread has finished (terminated), show results etc.

OnBeforeThread Optional, allows you to do something before the thread starts, so you can reset counters etc.

OnThread  The actual thread - Single cycle only... The thread will automatically call this routine, forever until you terminate,  or the thread terminates itself (see demo program)