Delphi - 闲来无事,自己写个Timer玩玩（多线程Timer）

明天去坐火车,回家,今天就没有事做,本来在弄一个跨进程获取其他程序里面组件,如ListView,ListBox,Button等的信息,突然有个想法自己写个Timer,不用SetTimer函数,我们自己用个多线程也正好实现这个.反正前段时间多线程也弄得比较多,本来想单独讲讲的,现在就用个例子来说明吧.
写成一个控件:utTimer.pas

unit  utTimer;

interface
uses
  Windows,SysUtils,Classes;

type
  THuangJackyTimerThread = class ;
  THuangJackyTimer = class (TComponent)
  private
    FTimeInterval: Integer ;
    FOnTimerDo:TNotifyEvent;
    FTimerThread:THuangJackyTimerThread;
    FEnable: Boolean ;
    procedure  SetEnable(bBool: Boolean );
    procedure  SetTimeInterval(aValue: Integer );

    procedure  StopThread;
    procedure  StartThread;
  public
    constructor  Create(AOwner: TComponent); override;
    destructor  Destroy; override;
  published
    property  TimeInterval: Integer   read FTimeInterval write  SetTimeInterval;
    property  OnTimerDo:TNotifyEvent  read FOnTimerDo write  FOnTimerDo;
    property  Enable: Boolean   read FEnable write  SetEnable;
  end ;

  THuangJackyTimerThread = class (TThread)
  private
    FTimer:THuangJackyTimer;
    FTerminateHandle,FExitHandle,FStartHandle,FStopHandle: Cardinal ;

    procedure  DoTimerEvent;
  protected
    procedure  Execute;override;
  public
    constructor  Create(AOwner: THuangJackyTimer);
    destructor  Destroy; override;
  end ;

procedure  Register;


implementation

procedure  Register;
begin
  RegisterComponents( 'HuangJacky' ,[THuangJackyTimer]);
end ;

{ THuangJackyTimer }

constructor  THuangJackyTimer . Create(AOwner: TComponent);
begin
  inherited ;
  FTimeInterval:= 1000 ;
  FTimerThread:=THuangJackyTimerThread . Create(Self);
  FTimerThread . Resume;
end ;

destructor  THuangJackyTimer . Destroy;
begin
  SetEvent(FTimerThread . FTerminateHandle);
  WaitForSingleObject(FTimerThread . FExitHandle, 5000 );
  FTimerThread . Free;
  inherited ;
end ;

procedure  THuangJackyTimer . SetEnable(bBool: Boolean );
begin
  if  Enable = bBool then
    Exit;
  if  csDesigning in  ComponentState then
    Exit;
  if  Enable then
  begin
    StopThread;
    FEnable:= False ;
  end
  else
  begin
    StartThread;
    FEnable:= True ;
  end ;
end ;

procedure  THuangJackyTimer . SetTimeInterval(aValue: Integer );
begin
  if  FTimeInterval = aValue then
    Exit;
  InterlockedExchange(FTimeInterval,aValue);
end ;

procedure  THuangJackyTimer . StartThread;
begin
  SetEvent(FTimerThread . FStartHandle);
end ;

procedure  THuangJackyTimer . StopThread;
begin
  SetEvent(FTimerThread . FStopHandle)
end ;

{ THuangJackyTimerThread }

constructor  THuangJackyTimerThread . Create(AOwner: THuangJackyTimer);
var
  sTmp,sTmp1: string ;
begin
  inherited  Create( True );
  Assert(Assigned(AOwner));
  //自己创建,自己释放,这样能保证100%不内存泄露,个人习惯
  FreeOnTerminate:= False ;
  FTimer:=AOwner;
  sTmp:=FTimer . Name;
  sTmp1:=DateTimeToStr(Now());
  FTerminateHandle:=CreateEvent( nil , True , False , PChar (sTmp + sTmp1 + 'T' ));
  Assert(FTerminateHandle<> 0 );
  //用这个Event来通知主线程:Timer线程已经执行完了
  FExitHandle:=CreateEvent( nil , True , False , PChar (sTmp + sTmp1 + 'E' ));
  Assert(FExitHandle<> 0 );
  FStartHandle:=CreateEvent( nil , True , False , PChar (sTmp + sTmp1 + 'Sa' ));
  Assert(FStartHandle<> 0 );
  FStopHandle:=CreateEvent( nil , True , False , PChar (sTmp + sTmp1 + 'So' ));
  Assert(FStopHandle<> 0 );
end ;

destructor  THuangJackyTimerThread . Destroy;
begin
   CloseHandle(FStopHandle);
   CloseHandle(FStartHandle);
   CloseHandle(FExitHandle);
   CloseHandle(FTerminateHandle);
  inherited ;
end ;

procedure  THuangJackyTimerThread . DoTimerEvent;
begin
  if  Assigned(FTimer . OnTimerDo) then
    FTimer . OnTimerDo(FTimer);
end ;

procedure  THuangJackyTimerThread . Execute;
var
  Waits1: array [ 0..2 ] of  Cardinal ;
  Waits2: array [ 0..1 ] of  Cardinal ;

  procedure  DoTerminate;
  begin
    ResetEvent(FTerminateHandle);
    Terminate;
  end ;

begin
  Waits1[ 0 ]:=FStartHandle;
  Waits1[ 1 ]:=FTerminateHandle;
  Waits1[ 2 ]:=FStopHandle;
  Waits2[ 0 ]:=FStopHandle;
  Waits2[ 1 ]:=FTerminateHandle;
  //循环等待.
  while  not  Terminated do
    //每一次Wait后我们都需要判断下Terminate,不然在你等待的时候,线程就被Terminate了.
    //不过不判断也不要紧
    //因为Terminate只是将Terminated设置成True.
    //也就是如果不判断,就多运行一次.
    //但是这个例子里面因为内层也有一个While循环,所以必须判断
    case  WaitForMultipleObjects( 3 ,@Waits1, False ,INFINITE) of
      WAIT_OBJECT_0 + 0 :
        begin
          ResetEvent(FStartHandle);
          if  Terminated then
            Break;
          while  True  do
          begin
            case  WaitForMultipleObjects( 2 ,@Waits2, False ,FTimer . TimeInterval) of
              WAIT_OBJECT_0 + 0 :
                begin
                  ResetEvent(FStopHandle);
                  Break
                end ;
              WAIT_OBJECT_0 + 1 :
                begin
                  DoTerminate;
                  Break;
                end ;
            end ;
            if  Terminated then
              Break;
            //执行Timer事件.
            Synchronize(DoTimerEvent);
          end ;
        end ;
      WAIT_OBJECT_0 + 1 :
        DoTerminate;
      WAIT_OBJECT_0 + 2 :
        ResetEvent(FStopHandle);
    end ;
  SetEvent(FExitHandle);
end ;

end .

两百行的代码,比较简单,就是一个线程在循环等待事件,然后相应的事件做相应的事.
其实主要是想说如何使用线程,我不喜欢将线程的FreeOnTerminate设置为True,因为感觉不安全,心里不踏实呀.
测试例子:Unit1.pas

unit  Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,utTimer;

type
  TForm1 = class (TForm)
    procedure  FormCreate(Sender: TObject);
  private
    { Private declarations }
    Timer:THuangJackyTimer;
    III: Integer ;
    procedure  DoTimer(S:TObject);
  public
    { Public declarations }
  end ;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure  TForm1 . DoTimer(S: TObject);
begin
//这个Timer不存在重入的情况,所以不需要先设置Enable为True
  Caption:=IntToStr(III);
  Inc(III);
end ;

procedure  TForm1 . FormCreate(Sender: TObject);
begin
  Timer:=THuangJackyTimer . Create(Self);
  Timer . TimeInterval:= 2000 ;
  Timer . OnTimerDo:=DoTimer;
  Timer . Enable:= True ;
end ;

end .

D7和D2010上面都测试了一下,米有发现问题.
如果有什么问题欢迎拍砖.哈哈

http://www.cnblogs.com/huangjacky/archive/2010/02/10/1667217.html