BMDThread多线程控件

unit BMDThread;

interface

uses
  Windows, Messages, SysUtils, Classes, Controls, Forms, Syncobjs, ExtCtrls;

type
  { Forward class declarations }
  TBMDThread = class;
  TBMDExecuteThread = class;
  TBMDThreadGroup = class;

  { Thread events }
  TBMDThreadNotifyEvent = procedure(Sender: TObject; Thread: TBMDExecuteThread) of object;
  TBMDThreadDataNotifyEvent = procedure(Sender: TObject; Thread: TBMDExecuteThread; var Data: Pointer) of object;
  TBMDThreadUpdateNotifyEvent = procedure(Sender: TObject; Thread: TBMDExecuteThread; var Data: Pointer; Percent: Integer) of object;
  TBMDThreadSynchroNotifyEvent = procedure(Sender: TBMDThread; Thread: TBMDExecuteThread) of object;
  TBMDThreadSynchroDataNotifyEvent = procedure(Sender: TBMDThread; Thread: TBMDExecuteThread; var Data: Pointer) of object;

  { TBMDExecuteThread class }
  TBMDExecuteThread = class(TThread)
  private
    { Private declarations }
  protected
    { Protected declarations }
    ThreadOwner: TBMDThread;
    FData: Pointer;
    FNotifyEvent: TNotifyEvent;
    FThreadNotifyEvent: TBMDThreadSynchroNotifyEvent;
    FThreadDataNotifyEvent: TBMDThreadSynchroDataNotifyEvent;
    UpdateData: Pointer;
    procedure Execute(); override;
  public
    { Public declarations }
    PercentProgress: Integer;
    constructor Create(AThreadOwner: TBMDThread; AUpdateData: Pointer); virtual;
    procedure DoNotifySynchro;
    procedure DoThreadNotifySynchro;
    procedure DoThreadNotifySynchroData;
    procedure Synchronize(SynchroEvent: TNotifyEvent); overload;
    procedure Synchronize(SynchroEvent: TBMDThreadSynchroNotifyEvent); overload;
    procedure Synchronize(SynchroEvent: TBMDThreadSynchroDataNotifyEvent; Data: Pointer); overload;
    // The folowing two functions are obsolete and should not be used in future !!!
    // Obsolete !!! Don‘t use any more !!! >>>>
    procedure Synchronize(SynchroEvent: TBMDThreadNotifyEvent); overload;
    procedure Synchronize(SynchroEvent: TBMDThreadDataNotifyEvent; Data: Pointer); overload;
    // <<< Obsolete !!! Don‘t use any more !!!
    property Terminated;
  end;

  { TBMDThread class }
  TBMDThreadBase = class(TComponent)
  private
    FOnUpdate: TBMDThreadUpdateNotifyEvent;
    FOnStart: TBMDThreadDataNotifyEvent;
    FOnTerminate: TBMDThreadDataNotifyEvent;
    FThreadGroup: TBMDThreadGroup;
    FUpdatePriority: Integer;
  protected
    UpdateCriticalSection: TCriticalSection;
    function GetRuning(): Boolean; virtual; abstract;
    procedure SetThreadGroup(AThreadGroup: TBMDThreadGroup);
    procedure ReportStarted(ThreadGroup: TBMDThreadGroup); virtual; abstract;
    procedure ReportTerminated(ThreadGroup: TBMDThreadGroup); virtual; abstract;
    function  AddMe(AThreadGroup: TBMDThreadGroup) : Boolean; virtual; abstract;
    procedure RemoveMe(AThreadGroup: TBMDThreadGroup); virtual; abstract;
  public
    constructor Create(Owner: TComponent); override;
    destructor Destroy; override;
    procedure Start(); overload; virtual; abstract;
    procedure Start(Data: Pointer); overload; virtual; abstract;
    procedure Stop(); virtual; abstract;
    procedure Suspend(); virtual; abstract;
    procedure Resume(); virtual; abstract;
  public
    property Runing: Boolean read GetRuning;
    property ThreadGroup: TBMDThreadGroup read FThreadGroup write SetThreadGroup;
    property UpdatePriority: Integer read FUpdatePriority write FUpdatePriority default 0;
    property OnUpdate: TBMDThreadUpdateNotifyEvent read FOnUpdate write FOnUpdate;
    property OnStart: TBMDThreadDataNotifyEvent read FOnStart write FOnStart;
    property OnTerminate: TBMDThreadDataNotifyEvent read FOnTerminate write FOnTerminate;
  end;

  { TBMDThread class }
  TBMDThread = class(TBMDThreadBase)
  protected
    FUpdateTimer: TTimer;
    FOnExecute: TBMDThreadDataNotifyEvent;
    FExecuteThread: TBMDExecuteThread;
    FPriority: TThreadPriority;
    FUpdateEnabled: Boolean;
    FInterrupted: Boolean;
    procedure OnUpdateTimer(Sender: TObject); virtual;
    procedure Execute(); virtual;
    procedure OnThreadTerminate(Sender: TObject); virtual;
    procedure OnThreadTerminateClose(Sender: TObject); virtual;
    procedure ReportStarted(ThreadGroup: TBMDThreadGroup); override;
    procedure ReportTerminated(ThreadGroup: TBMDThreadGroup); override;
    function  AddMe(AThreadGroup: TBMDThreadGroup) : Boolean; override;
    procedure RemoveMe(AThreadGroup: TBMDThreadGroup); override;
    procedure SetTimeInterval(TimeInterval: Cardinal);
    function GetTimeInterval(): Cardinal;
    procedure SetPriority(Value: TThreadPriority);
    function GetPriority(): TThreadPriority;
    function GetRuning(): Boolean; override;
    function GetEmptyEntry(): TPersistent;
    procedure SetUpdateEnabled(Value: Boolean);
  public
    constructor Create(Owner: TComponent); override;
    destructor Destroy; override;
    procedure Start(); overload; override;
    procedure Start(Data: Pointer); overload; override;
    procedure Stop(); override;
    procedure Suspend(); override;
    procedure Resume(); override;
    property Runing;
    property Interrupted: Boolean read FInterrupted;
    property Thread: TBMDExecuteThread read FExecuteThread;
  published
    property RefreshInterval: Cardinal read GetTimeInterval write SetTimeInterval default 100;
    property Priority: TThreadPriority read GetPriority write SetPriority default tpNormal;
    property ThreadGroup;
    property UpdatePriority;
    property UpdateEnabled : Boolean read FUpdateEnabled write SetUpdateEnabled; 
    property SynchroMethods: TPersistent read GetEmptyEntry;
    property OnExecute: TBMDThreadDataNotifyEvent read FOnExecute write FOnExecute;
    property OnUpdate;
    property OnStart;
    property OnTerminate;
  end;

  TBMDThreadGroup = class(TBMDThreadBase)
  protected
    ThreadItemsList: TList;
    ThreadsList: TList;
    FOnThreadUpdate: TBMDThreadUpdateNotifyEvent;
    FOnThreadStart: TBMDThreadDataNotifyEvent;
    FOnThreadTerminate: TBMDThreadDataNotifyEvent;
    // Protected by CriticalSection
    FCountRuning: Integer;
    function GetRuning(): Boolean; override;
    function GetCountRuning(): Integer; virtual;
    function GetThreadItemsCount(): Integer;
    function GetThreadItems(Index: Integer): TBMDThreadBase;
    function GetThreadsCount(): Integer;
    function GetThreads(Index: Integer): TBMDThread;
    procedure ReportStarted(ThreadGroup: TBMDThreadGroup); override;
    procedure ReportTerminated(ThreadGroup: TBMDThreadGroup); override;
    function  AddMe(AThreadGroup: TBMDThreadGroup) : Boolean; override;
    procedure RemoveMe(AThreadGroup: TBMDThreadGroup); override;
    function LinkedToMe( ThreadBase : TBMDThreadBase ) : Boolean;
  public
    constructor Create(Owner: TComponent); override;
    destructor Destroy; override;
    procedure Start(); overload; override;
    procedure Start(Data: Pointer); overload; override;
    procedure Stop(); override;
    procedure Suspend(); override;
    procedure Resume(); override;
    function  AddThread(AThread: TBMDThread) : Boolean;
    procedure RemoveThread(AThread: TBMDThread);
    function  AddThreadGroup(AThreadGroup: TBMDThreadGroup) : Boolean;
    procedure RemoveThreadGroup(AThreadGroup: TBMDThreadGroup);
    procedure ThreadStarted(Sender: TObject; Thread: TBMDExecuteThread; var Data: Pointer);
    procedure ThreadUpdate(Sender: TObject; Thread: TBMDExecuteThread; var Data: Pointer; AUpdatePriority: Integer; PercentProgres: Integer);
    procedure ThreadTerminated(Sender: TObject; Thread: TBMDExecuteThread; var Data: Pointer);
    
  public
    property Runing;
    property CountRuning: Integer read GetCountRuning;
    property ThreadItemsCount: Integer read GetThreadItemsCount;
    property ThreadItems[Index: Integer]: TBMDThreadBase read GetThreadItems;
    property ThreadsCount: Integer read GetThreadsCount;
    property Threads[Index: Integer]: TBMDThread read GetThreads;

  published
    property ThreadGroup;
    property UpdatePriority;
    property OnUpdate;
    property OnStart;
    property OnTerminate;
    property OnThreadUpdate: TBMDThreadUpdateNotifyEvent read FOnThreadUpdate write FOnThreadUpdate;
    property OnThreadStart: TBMDThreadDataNotifyEvent read FOnThreadStart write FOnThreadStart;
    property OnThreadTerminate: TBMDThreadDataNotifyEvent read FOnThreadTerminate write FOnThreadTerminate;
  end;

implementation