多线程编程(17)

根据 WaitableTimer 的主要功用, 现在再把它放在 "线程同步" 的话题中讨论有点不合适了, 就要结束它.

//重新看看那个 APC 回调函数的格式:
procedure TimerAPCProc(
　lpArgToCompletionRoutine: Pointer;
　dwTimerLowValue, dwTimerHighValue: DWORD
); stdcall;

TimerAPCProc 的后两个参数其实是在传递一个值, 使用时要把它们合并为一个 TFileTime 类型的时间.

这个时间是 APC 函数被调用的时间, 稍稍修改上面一个例子看一下:

代码文件:

unit Unit1;
interface
uses
　Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
　Dialogs, StdCtrls;
type
　TForm1 = class(TForm)
　　Button1: TButton;
　　Button2: TButton;
　　procedure Button1Click(Sender: TObject);
　　procedure Button2Click(Sender: TObject);
　　procedure FormDestroy(Sender: TObject);
　end;
var
　Form1: TForm1;
implementation
{$R *.dfm}
var
　hTimer: THandle;
{APC 函数}
procedure TimerAPCProc(lpArgToCompletionRoutine: Pointer; dwTimerLowValue: DWORD;
　dwTimerHighValue: DWORD); stdcall;
var
　UTCFileTime,LocalFileTime: TFileTime;
　SystemTime: TSystemTime;
　DateTime: TDateTime;
begin
　{把 dwTimerLowValue 与 dwTimerHighValue 和并为一个 TFileTime 格式的时间}
　UTCFileTime.dwLowDateTime := dwTimerLowValue;
　UTCFileTime.dwHighDateTime := dwTimerHighValue;
　FileTimeToLocalFileTime(UTCFileTime, LocalFileTime); {从世界标准计时到本地时间}
　FileTimeToSystemTime(LocalFileTime, SystemTime);　　 {转到系统格式时间}
　DateTime := SystemTimeToDateTime(SystemTime);　　　　{再转到 TDateTime}
　Form1.Text := DateTimeToStr(DateTime);
　SleepEx(INFINITE, True);
end;
{线程入口函数}
function MyThreadFun(p: Pointer): Integer; stdcall;
var
　DueTime: Int64;
begin
　DueTime := 0;
　if SetWaitableTimer(hTimer, DueTime, 1000, @TimerAPCProc, nil, False) then
　begin
　　SleepEx(INFINITE, True);
　end;
　Result := 0;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
　ID: DWORD;
begin
　if hTimer = 0 then　hTimer := CreateWaitableTimer(nil, True, nil);
　CreateThread(nil, 0, @MyThreadFun, nil, 0, ID);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
　CancelWaitableTimer(hTimer);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
　CloseHandle(hTimer);
end;
end.

窗体文件:

object Form1: TForm1
　Left = 0
　Top = 0
　Caption = 'Form1'
　ClientHeight = 86
　ClientWidth = 256
　Color = clBtnFace
　Font.Charset = DEFAULT_CHARSET
　Font.Color = clWindowText
　Font.Height = -11
　Font.Name = 'Tahoma'
　Font.Style = []
　OldCreateOrder = False
　PixelsPerInch = 96
　TextHeight = 13
　object Button1: TButton
　　Left = 23
　　Top = 32
　　Width = 97
　　Height = 25
　　Caption = #21551#21160#23450#26102#22120
　　TabOrder = 0
　　OnClick = Button1Click
　end
　object Button2: TButton
　　Left = 134
　　Top = 32
　　Width = 97
　　Height = 25
　　Caption = #21462#28040#23450#26102#22120
　　TabOrder = 1
　　OnClick = Button2Click
　end
end