独立线程实现消息循环的Delphi定时器类

独立线程实现消息循环的Delphi定时器类 收藏

Delphi的定时器类TTimer内部是创建不可见的窗口，调用SetTimer这个Win32 API 来实现的。TTimer要求使用它的线程实现了消息循环。所以，除非控制台程序中实现消息循环，否则TTimer在控制台程序中是无效的。不过为了使用方便，可以我们写一个线程类来实现消息循环，并且不必创建隐藏窗口便可以使用定时器。下面面的TSfTimerThread就是这样的类，它可以在不终止线程的情况下改变定时间隔和定时触发的函数。不过目前Enable属性是利用是否进行回调来实现的，也就是Enable设置为False时，定时器依然有效，并且线程会收到WM_TIMER消息，只是收到消息后不进行回调。由于关闭定时测试没有通过，所以暂时这样实现。

{ Timer Utility Library ,Copyright (c) Zhou Zuoji }      

unit SfTimerThread
interface
uses
    Classes,
    SysUtils,
    Windows,
    SfException;
type
    TWin32TimerProc = procedure( WndHandle: THandle; uMsg: UINT; idEvent: UINT_PTR; dwTime: DWORD ); stdcall;
    TSfTimerProc = procedure(Param:Integer;ATimerID: Cardinal; dwTickCount: Cardinal ) of object;
    TSfTimerThread = class( TThread )
    private
        FTimerID: Cardinal;
        FTimerProc: TSfTimerProc;
        FInterval: Cardinal;
        FTimerProcSyncExec: Boolean;
        FUpdateRequired: Boolean;
        FKillRequired: Boolean;
        FMessage: TMsg;
        FEnabled: Boolean;
        FParam: Integer;
        function CreateTimer: Boolean;
        procedure DestroyTimer;
        function AdjustTimerInterval( AInterval: Cardinal ): Cardinal;
    protected
        procedure SetInterval( const Value: Cardinal );
        procedure SetTimerProc( const Value: TSfTimerProc );
        procedure SetEnabled( const Value: Boolean );
        procedure Timer; dynamic;
        procedure Execute; override;
    public
        constructor Create( ATimerProc: TSfTimerProc; AParam: Integer = 0;AInterval: Cardinal = 1000;
            CreateSuspend: Boolean = False );
        destructor Destroy; override;
        property Interval: Cardinal read FInterval write SetInterval;
        property TimerID: Cardinal read FTimerID;
        property TimerProc: TSfTimerProc read FTimerProc write SetTimerProc;
        property TimerProcSyncExec: Boolean read FTimerProcSyncExec write FTimerProcSyncExec;
        property Enabled: Boolean read FEnabled write SetEnabled;
    end;
implementation
{ TSfTimerThread }
procedure DefaultTimerProc( WndHandle: THandle; uMsg: UINT; idEvent: UINT_PTR; dwTime: DWORD ); stdcall;
begin
end;
function TSfTimerThread.AdjustTimerInterval( AInterval: Cardinal ): Cardinal;
begin
    if AInterval = 0 then
        Result := 1000
    else Result := AInterval;
end;
constructor TSfTimerThread.Create( ATimerProc: TSfTimerProc;AParam: Integer ;AInterval: Cardinal; CreateSuspend: Boolean );
begin
    inherited Create( CreateSuspend );
    FInterval := AdjustTimerInterval( AInterval );
    @FTimerProc := @ATimerProc;
    FTimerID := 0;
    FTimerProcSyncExec := False;
    FUpdateRequired := False;
    FKillRequired := False;
    FEnabled:=True;
    FParam:=AParam;
end;
function TSfTimerThread.CreateTimer: Boolean;
begin
    DestroyTimer;
    FTimerID := Windows.SetTimer( 0, 0, FInterval, @DefaultTimerProc );
    Result := FTimerID > 0;
    //FEnabled := Result;
    if not Result then
        SfRaiseException(nil,'create timer failed');
end;
destructor TSfTimerThread.Destroy;
begin
    DestroyTimer;
    inherited;
end;
procedure TSfTimerThread.DestroyTimer;
begin
    if FTimerID > 0 then
    begin
        Windows.KillTimer( 0, FTimerID );
        FTimerID := 0;
        //FEnabled := False;
    end;
end;
procedure TSfTimerThread.Execute;
const
    WM_TIMER = $0113;
begin
    inherited;
    CreateTimer;
        while not Terminated and GetMessage( FMessage, 0, 0, 0 ) do
        begin
            TranslateMessage( FMessage );
            if ( FMessage.message = WM_TIMER ) and ( Cardinal(FMessage.wParam) = FTimerID )
              and FEnabled then
                if FTimerProcSyncExec then
                    Synchronize( Timer )
                else
                    Timer;
            if FUpdateRequired then
            begin
                CreateTimer;
                FUpdateRequired := False;
            end;
            {if FKillRequired then
            begin
                DestroyTimer;
                FKillRequired:=False;
            end;}
        end;
    DestroyTimer;
end;
procedure TSfTimerThread.SetEnabled( const Value: Boolean );
begin
    if FEnabled <> Value then
    begin
        {if Value then
            FUpdateRequired := True
        else
            FKillRequired := True;}
        FEnabled:=Value;
    end;
end;
procedure TSfTimerThread.SetInterval( const Value: Cardinal );
begin
    if ( FInterval <> AdjustTimerInterval( Value ) ) then
    begin
        FInterval := AdjustTimerInterval( Value );
        FUpdateRequired := True;
    end;
end;
procedure TSfTimerThread.SetTimerProc( const Value: TSfTimerProc );
begin
    if not Terminated and ( @FTimerProc <> nil ) then
        FTimerProc := Value;
end;
procedure TSfTimerThread.Timer;
begin
    try
        if @FTimerProc <> nil then
            FTimerProc(FParam ,FMessage.wParam, FMessage.time );
    except
    end;
end;
end.