function CreateWaitableTimer(
lpTimerAttributes: PSecurityAttributes; {安全}
bManualReset: BOOL; {True: 可調度多個線程; False: 只調度一個線程}
lpTimerName: PWideChar {名稱}
): THandle; stdcall; {返回句柄}
function SetWaitableTimer(
hTimer: THandle; {句柄}
var lpDueTime: TLargeInteger; {起始時間}
lPeriod: Longint; {間隔時間}
pfnCompletionRoutine: TFNTimerAPCRoutine;{回調函數的指針}
lpArgToCompletionRoutine: Pointer; {給回調函數的參數}
fResume: BOOL {是否喚醒系統}
): BOOL; stdcall; {}
WaitableTimer 對象較復雜, 其基本的理念是讓等候的線程在指定的時間運行.
像其他同類對象一樣, 先要建立(CreateWaitableTimer), 建立函數的第二個參數決定是調度一個線程還是所有等候的線程; 這一點和信號對象(Semaphore) 有些類似, 不過 Semaphore 可以指定可驅動線程的具體數目.
和其他同類對象不同的是: 在 CreateWaitableTimer 以後, WaitableTimer 對象並沒有馬上開始工作;
再調用 SetWaitableTimer 函數後才能讓它發揮作用. 這又有點像 Event 對象.
SetWaitableTimer 函數比較麻煩, 得慢慢來, 譬如這樣使用:
var
hWaitableTimer: THandle; {WaitableTimer 對象的句柄變量應該是全局的}
procedure TForm1.Button1Click(Sender: TObject);
var
DueTime: Int64;
begin
{建立 WaitableTimer 對象並返回句柄}
hWaitableTimer := CreateWaitableTimer(nil, True, nil); {中間的 True 表示可驅動多個線程}
DueTime := 0; {這將是 SetWaitableTimer 的第二個參數; 因為是 var 參數, 不能直接給常量}
SetWaitableTimer(hWaitableTimer, {WaitableTimer 對象的句柄}
DueTime, {起始時間, 這裡給的是 0}
0, {間隔時間, 這裡給的也是 0}
nil, {暫不用回調函數}
nil, {當然也不需要給回調函數參數了}
False {此值若是 True, 即使系統在屏保或待機狀態, 時間一到線程和系統將都被喚醒!}
);
end;
{再說明:
起始時間(第二個參數)有三種賦值方法:
1、> 0 時是絕對時間, 是一個 TFileTime 格式的時間(具體賦值方法後面詳解);
2、< 0 時是相對時間, 相對是相對於當前, 譬如 -50000000 表示 5 秒鐘後執行(單位是0.1毫秒, 後面詳述);
3、= 0 時, 立即執行, 不再等待; 上面的舉例和下面第一個例子我們先用 0.
間隔時間(第三個參數)有兩種情況:
1、譬如 5000 表示每隔 5 秒鐘執行一次, 其單位是毫秒; 本頁第二個例子使用了 500(半秒);
2、如果賦值為 0, 表示根據起始時間只執行一次, 不再重復執行.
回調函數及其參數(第四、五個參數), 這會牽扯出一個更復雜的話題(APC), 暫時不用它, 後面再說.
最後一個參數上面已經說清楚了, 我也測試了一下(分別在屏保和待機狀態下), 很有效!
}
第一個例子我們將盡量簡單的使用它(但這樣體現不出它的優勢):
CreateWaitableTimer 時我們就決定讓它可控制多個線程;
SetWaitableTimer 時先讓它立即參與控制, 只執行一次, 也不使用回調函數.
本例效果圖:
代碼文件:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
var
f: Integer;
hWaitableTimer: THandle; {等待定時器對象的句柄}
function MyThreadFun(p: Pointer): DWord; stdcall;
var
i,y: Integer;
begin
Inc(f);
y := 20 * f;
if WaitForSingleObject(hWaitableTimer, INFINITE) = WAIT_OBJECT_0 then
begin
for i := 0 to 1000 do
begin
Form1.Canvas.Lock;
Form1.Canvas.TextOut(20, y, IntToStr(i));
Form1.Canvas.Unlock;
Sleep(1);
end;
end;
Result := 0;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
ThreadID: DWord;
DueTime: Int64;
begin
hWaitableTimer := CreateWaitableTimer(nil, True, nil);
DueTime := 0;
SetWaitableTimer(hWaitableTimer, DueTime, 0, nil, nil, False);
Repaint; f := 0;
CreateThread(nil, 0, @MyThreadFun, nil, 0, ThreadID);
CreateThread(nil, 0, @MyThreadFun, nil, 0, ThreadID);
CreateThread(nil, 0, @MyThreadFun, nil, 0, ThreadID);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
CloseHandle(hWaitableTimer);
end;
end.
窗體文件:
object Form1: TForm1
Left = 0
Top = 0
Caption = 'Form1'
ClIEntHeight = 116
ClIEntWidth = 179
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
OnDestroy = FormDestroy
PixelsPerInch = 96
TextHeight = 13
object Button1: TButton
Left = 96
Top = 83
Width = 75
Height = 25
Caption = 'Button1'
TabOrder = 0
OnClick = Button1Click
end
end
下面是一個每隔半秒鐘(500ms)執行一次的例子(窗體文件同上):
本例效果圖:
代碼文件:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
var
f: Integer;
hWaitableTimer: THandle;
function MyThreadFun(p: Pointer): DWord; stdcall;
var
i,y: Integer;
begin
Inc(f);
y := 20 * f;
{這裡和上面不同, 把等待弄到循環裡面了}
for i := 0 to 1000 do
begin
if WaitForSingleObject(hWaitableTimer, INFINITE) = WAIT_OBJECT_0 then
begin
Form1.Canvas.Lock;
Form1.Canvas.TextOut(20, y, IntToStr(i));
Form1.Canvas.Unlock;
// Sleep(1);
end;
end;
Result := 0;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
ThreadID: DWord;
DueTime: Int64;
begin
hWaitableTimer := CreateWaitableTimer(nil, False, nil); {這裡的參數也和上面不一樣}
DueTime := 0;
SetWaitableTimer(hWaitableTimer, DueTime, 500, nil, nil, False); {500 ms}
Repaint; f := 0;
CreateThread(nil, 0, @MyThreadFun, nil, 0, ThreadID);
CreateThread(nil, 0, @MyThreadFun, nil, 0, ThreadID);
CreateThread(nil, 0, @MyThreadFun, nil, 0, ThreadID);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
CloseHandle(hWaitableTimer);
end;
end.
