Delphi線程定時器

(*

自己編寫的線程計時器，沒有采用消息機制，很有效

Cobbler續寫

不用 TTimer 的原因:

要說TTimer類的使用問題，先要說一下它響應用戶定義的回調函數(OnTimer)的方法。
TTimer擁有一個HWnd類型的成員變量FWindowHandle，用於捕捉系統消息。
TTimer在Enable的情況下，每隔Interval時間，就拋一個系統消息WM_TIMER,FWindowHandle捕捉到這個消息后，
就會執行用戶的回調函數，實現用戶需要的功能。就是這個消息機制引發了下面兩個問題：

問題1: 還不算嚴重，TTimer與系統共用一個消息隊列，也就是說，在用戶回調函數處理完之前，
所有的系統消息都處於阻塞狀態，包括界面的更新的消息。
如果你的回調函數瞬間執行完畢那就一切看着還正常，如果你要執行一個復雜耗時的操作，
比如數據庫查詢什么的（萬一遇到數據庫聯接不正常，等待20秒），
那你的界面就必死無疑，直到回調函數執行完。如果是后台系統還好，
要是給用戶使用的就沒法交待了。即使你在子線程里面使用也不會解決的。

問題2: 一般系統定義消息的優先級比用戶定義消息的優先級要低。
在子線程中使用TTimer時，如果線程間通信也大量使用自定義消息，
並且用戶定義自己的消息處理函數，那WM_TIMER經常就會被丟棄了，
計時器就徹底失效了。

摘抄自網絡

*)

unit UntThreadTimer;

interface

uses
Windows, Classes,Winapi.Messages;

type
TTimerStatus = (TS_ENABLE, TS_CHANGEINTERVAL, TS_DISABLE, TS_SETONTIMER);
TThreadedTimer = class;
TTimerThread = class;
PTimerThread = ^TTimerThread;

TTimerThread = class(TThread)
OwnerTimer: TThreadedTimer;
Interval: DWord;
Enabled : Boolean;
Status : TTimerStatus;
constructor Create(CreateSuspended: Boolean);
destructor Destroy; override;
procedure Execute; override;
procedure DoTimer;
end;

TThreadedTimer = class(TComponent)
private
FHandle: THandle;
FEnabled: Boolean;
FInterval: DWord;
FOnTimer: TNotifyEvent;
FTimerThread: TTimerThread;
FThreadPriority: TThreadPriority;
protected
procedure UpdateTimer;
procedure SetEnabled(Value: Boolean);
procedure SetInterval(Value: DWord);
procedure SetOnTimer(Value: TNotifyEvent);
procedure Timer; dynamic;
public
constructor Create(AHandle: THandle; AOwner: TComponent);
destructor Destroy; override;
published
property Enabled: Boolean read FEnabled write SetEnabled default True;
property Interval: DWord read FInterval write SetInterval default 1000;
property OnTimer: TNotifyEvent read FOnTimer write SetOnTimer;
end;

implementation

procedure WakeupDownThrdproc(const evenFlag: Integer); stdcall;
begin

end;
{TTimerThread}
constructor TTimerThread.Create(CreateSuspended: Boolean);
begin
inherited Create(CreateSuspended);
Interval := 1000;
Enabled := False;
Status := TS_DISABLE;
end;

destructor TTimerThread.Destroy;
begin
inherited;
end;

procedure TTimerThread.Execute;
begin
inherited;
while not Terminated do
begin
//SleepEx(Interval, True);
if (not Terminated) and (Status = TS_ENABLE) then Synchronize(DoTimer);
if Status <> TS_ENABLE then
begin
case Status of
TS_CHANGEINTERVAL:
begin
Status := TS_ENABLE;
SleepEx(0,True);
end;
TS_DISABLE:
begin
Status := TS_ENABLE;
SleepEx(0, True);
if not Terminated then Suspend;
end;
TS_SETONTIMER:
begin
Status := TS_ENABLE;
end else
Status := TS_ENABLE;
end;
end;
SleepEx(Interval, True);
end;
end;

procedure TTimerThread.DoTimer;
begin
OwnerTimer.Timer;
end;
{TThreadedTimer}
constructor TThreadedTimer.Create(AHandle: THandle; AOwner: TComponent);
begin
inherited Create(AOwner);
FHandle := AHandle;
FInterval := 1000;
FThreadPriority := tpNormal;
FTimerThread := TTimerThread.Create(true);
FTimerThread.OwnerTimer := self;
end;

destructor TThreadedTimer.Destroy;
begin
inherited Destroy;
FTimerThread.Terminate;
QueueUserAPC(@WakeupDownThrdproc, FTimerThread.Handle, DWORD(FTimerThread));
FTimerThread.Free;
end;

procedure TThreadedTimer.UpdateTimer;
begin
if (FEnabled = False) then
begin
FTimerThread.OwnerTimer := Self;
FTimerThread.Interval := FInterval;
FTimerThread.Priority := FThreadPriority;
FTimerThread.Resume;
end;
if (FEnabled = True) then
begin
QueueUserAPC(@WakeupDownThrdproc, FTimerThread.Handle, DWORD(FTimerThread));
end;
end;

procedure TThreadedTimer.SetEnabled(Value: Boolean);
begin
if Value <> FEnabled then
begin
FEnabled := Value;
if Value then
begin
FTimerThread.Status := TS_ENABLE;
FTimerThread.Resume;
end
else
begin
FTimerThread.Status := TS_DISABLE;
QueueUserAPC(@WakeupDownThrdproc, FTimerThread.Handle, DWORD(FTimerThread));
end;
end;
end;

procedure TThreadedTimer.SetInterval(Value: DWord);
begin
if Value <> FInterval then
begin
if (not Enabled) then
begin
FInterval := Value;
FTimerThread.Interval := FInterval;
end
else
begin
FInterval := Value;
FTimerThread.Interval := FInterval;
FTimerThread.Status := TS_CHANGEINTERVAL;
QueueUserAPC(@WakeupDownThrdproc, FTimerThread.Handle, DWORD(FTimerThread));
end;
end;
end;

procedure TThreadedTimer.SetOnTimer(Value: TNotifyEvent);
begin
FOnTimer := Value;
end;

procedure TThreadedTimer.Timer;
var
Msg: TMessage;
begin
Msg.Msg := WM_USER+100;
//if Assigned(FOnTimer) then FOnTimer(Self);
SendMessage(FHandle,msg.Msg,0,0);
end;

end.