多線程編程(14) - 多線程同步之WaitableTimer(等待定時器對象)

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.