定时器的使用之 SetWaitableTimer

最新推荐文章于 2019-10-06 12:59:08 发布

原创最新推荐文章于 2019-10-06 12:59:08 发布 · 1.9k 阅读

1 ·

CC 4.0 BY-SA版权

文章标签：

#button #function #destructor #string #timer #constructor

Delphi 专栏收录该内容

1 篇文章

订阅专栏

本文介绍了一种使用SetWaitableTimer实现的高精度定时器封装方法，并提供了Delphi类实现及示例代码。该定时器支持纳秒级别的定时精度，且能够在独立线程中执行回调函数。

使用SetWaitableTimer做定时器，可以精确到100纳秒，关键是可以线程执行，简单的封装了个Delphi类，方便使用，源代码如下

{******************************************************************************} { @UnitName : uWaitableTimer.pas } { @Project : Waitable Timer Objects } { @Copyright : Budded Software Studio } { @Author : Budded } { @Description : Description } { @FileVersion : 1.0.0.0 } { @CreateDate : 2009-04-22 } { @Comment : Waitable Timer Objects } { @LastUpdate : Budded, 2009-04-22 } { @History : Created By Budded, 2009-04-22 13:00 } {******************************************************************************} unit uWaitableTimer; interface uses SysUtils, Classes, Windows; type TTimerAPCProc = procedure (const Param: Pointer; const TimerLowValue, TimerHighValue: DWord); stdcall; TWaitableTimer = class private FHandle: THandle; FList: TList; procedure QueueUserAPCInner(const Data: Pointer); procedure FreeListMem(); public constructor Create(const AName: String = ''; const ManualReset: Boolean = True); destructor Destroy(); override; function SetTimer(var lpDueTime: TLargeInteger; const lPeriod: Cardinal; pfnCompletionRoutine: TTimerAPCProc; lpArgToCompletionRoutine: Pointer): Boolean; overload; function SetTimer(var lpDueTime: TLargeInteger; const lPeriod: Cardinal; pfnCompletionRoutine: TNotifyEvent; lpArgToCompletionRoutine: TObject): Boolean; overload; function CancelTimer(): Boolean; property Handle: THandle read FHandle; end; implementation type TCallbackType = (ctFarProc, ctNotifyEvent); TAccessType = (atGet, atFree); TWorkThread = class(TThread) protected procedure Execute; override; public class function ThreadHandle(const AccType: TAccessType = atGet): THandle; end; PCallbackParam = ^TCallbackParam; TCallbackParam = packed record Timer: THandle; AType: TCallbackType; lpDueTime: TLargeInteger; lPeriod: Cardinal; case TCallbackType of ctFarProc: ( pfnCompletionRoutine: TTimerAPCProc; lpArgToCompletionRoutine: Pointer; ); ctNotifyEvent: ( pfnNotifyEnevt: TNotifyEvent; lpSender: TObject; ); end; procedure Debug(const Msg: String); var FData: String; begin FData := Format('Curr: %d; Main: %d; Msg: %s', [GetCurrentThreadID, MainThreadID, Msg]); OutputDebugString(PChar(FData)); end; procedure TimerAPCProc(const Param: Pointer; const TimerLowValue, TimerHighValue: DWord); stdcall; var FData: PCallbackParam; begin FData := Param; if Assigned(FData) then try case FData.AType of ctFarProc: if Assigned(FData.pfnCompletionRoutine) then FData.pfnCompletionRoutine(FData.lpArgToCompletionRoutine, TimerLowValue, TimerHighValue); ctNotifyEvent: if Assigned(FData.pfnNotifyEnevt)then FData.pfnNotifyEnevt(FData.lpSender); end; finally // do not dispose FData pointer end; end; procedure TimerQueueAPCProc(const Param: Pointer); stdcall; var FData: PCallbackParam; lpDueTime: TLargeInteger; FRtn: Boolean; begin FData := Param; if Assigned(FData) and (FData.Timer > 0) then begin lpDueTime := -10000 * FData.lpDueTime; // 纳秒级 FRtn := SetWaitableTimer(FData.Timer, lpDueTime, FData.lPeriod, @TimerAPCProc, FData, False); if not FRtn then Debug('SetWaitableTimer ' + IntToStr(GetLastError)); end; end; { TWaitableTimer } function TWaitableTimer.CancelTimer: Boolean; begin Result := CancelWaitableTimer(FHandle) end; constructor TWaitableTimer.Create(const AName: String; const ManualReset: Boolean); begin inherited Create(); FList := TList.Create; FHandle := CreateWaitableTimer(nil, ManualReset, PChar(AName)); end; destructor TWaitableTimer.Destroy; begin CancelTimer; CloseHandle(FHandle); FreeListMem(); if Assigned(FList) then FreeAndNil(FList); inherited; end; procedure TWaitableTimer.FreeListMem; var I: Integer; begin if Assigned(FList) then for I := 0 to FList.Count - 1 do Dispose(FList[I]); end; procedure TWaitableTimer.QueueUserAPCInner(const Data: Pointer); begin QueueUserAPC(@TimerQueueAPCProc, TWorkThread.ThreadHandle(), Cardinal(Data)); end; function TWaitableTimer.SetTimer(var lpDueTime: TLargeInteger; const lPeriod: Cardinal; pfnCompletionRoutine: TTimerAPCProc; lpArgToCompletionRoutine: Pointer): Boolean; var FData: PCallbackParam; begin New(FData); ZeroMemory(FData, SizeOf(TCallbackParam)); FData.Timer := Handle; FData.AType := ctFarProc; FData.lpDueTime := lpDueTime; FData.lPeriod := lPeriod; FData.pfnCompletionRoutine := pfnCompletionRoutine; FData.lpArgToCompletionRoutine := lpArgToCompletionRoutine; QueueUserAPCInner(FData); FList.Add(FData); end; function TWaitableTimer.SetTimer(var lpDueTime: TLargeInteger; const lPeriod: Cardinal; pfnCompletionRoutine: TNotifyEvent; lpArgToCompletionRoutine: TObject): Boolean; var FData: PCallbackParam; begin New(FData); ZeroMemory(FData, SizeOf(TCallbackParam)); FData.Timer := Handle; FData.AType := ctNotifyEvent; FData.lpDueTime := lpDueTime; FData.lPeriod := lPeriod; FData.pfnNotifyEnevt := pfnCompletionRoutine; FData.lpSender := lpArgToCompletionRoutine; QueueUserAPCInner(FData); FList.Add(FData); end; { TWorkThread } procedure TWorkThread.Execute; begin while not Terminated do SleepEx(INFINITE, True); end; class function TWorkThread.ThreadHandle( const AccType: TAccessType): THandle; {$J+} const FHandle: THandle = 0; {$J-} begin Result := 0; case AccType of atGet: begin if FHandle = 0 then FHandle := TWorkThread.Create(False).Handle; Result := FHandle; end; atFree: begin TerminateThread(FHandle, 0); FHandle := 0; end; end; end; initialization // TWorkThread.ThreadHandle(); finalization TWorkThread.ThreadHandle(atFree); end.

使用实例如下：

unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, uWaitableTimer, StdCtrls; type TForm1 = class(TForm) Button1: TButton; Button2: TButton; ListBox1: TListBox; Button3: TButton; Button4: TButton; procedure Button1Click(Sender: TObject); procedure ListBox1Click(Sender: TObject); procedure Button3Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure Button4Click(Sender: TObject); private { Private declarations } FTimer: TWaitableTimer; procedure SetTimerAPC(const Inner: Boolean = True); public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} procedure TimerAPCProc(const Param: Pointer; const TimerLowValue, TimerHighValue: DWord); stdcall; var FData: String; FTime: Int64; begin QueryPerformanceCounter(FTime); FData := Format('Curr: %d; Main: %d; Low: %d; High: %d; Time: %d', [GetCurrentThreadID, MainThreadID, TimerLowValue, TimerHighValue, FTime]); if Assigned(Param) then TListBox(Param).Items.Add(FData); end; procedure TForm1.Button1Click(Sender: TObject); begin SetTimerAPC(False); end; procedure TForm1.ListBox1Click(Sender: TObject); var FData: String; begin FData := Format('Curr: %d; Main: %d; Time: %d', [GetCurrentThreadID, MainThreadID, GetTickCount]); if Assigned(Sender) then TListBox(Sender).Items.Add(FData); end; procedure TForm1.SetTimerAPC(const Inner: Boolean); var FTime: TLargeInteger; FPerid: Cardinal; begin FPerid := 1 * 10; FTime := 1 * FPerid; FTimer.SetTimer(FTime, FPerid, TimerAPCProc, ListBox1); end; procedure TForm1.Button2Click(Sender: TObject); begin FTimer.CancelTimer; end; procedure TForm1.Button3Click(Sender: TObject); begin FTimer := TWaitableTimer.Create(); end; procedure TForm1.Button4Click(Sender: TObject); begin FTimer.Free; end; end.