Delphi多线程编程 - 编程技巧文章 - 蓝鸟软件-18

多线程编程(17) - 多线程同步之 WaitableTimer (等待定时器对象)[续三]。

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

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

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

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

　　多线程编程(17) - 多线程同步之 WaitableTimer (等待定时器对象)[续三]

　　代码文件:

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

　　SetWaitableTimer 中回调函数后面的指针参数, 将被传递给 APC 函数的第一个参数;

　　作为指针它可以携带任何数据, 这里让它携带了一个坐标点(鼠标点击窗体的位置), 下例效果图:

　　多线程编程(17) - 多线程同步之 WaitableTimer (等待定时器对象)[续三]

　　代码文件:

unit Unit1;
interface
uses
　Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
　Dialogs, StdCtrls;
type
　TForm1 = class(TForm)
　　procedure FormDestroy(Sender: TObject);
　　procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
　　　Shift: TShiftState; X, Y: Integer);
　end;
var
　Form1: TForm1;
implementation
{$R *.dfm}
var
　hTimer: THandle;
　pt: TPoint;
{APC 函数}
procedure TimerAPCProc(lpArgToCompletionRoutine: Pointer; dwTimerLowValue: DWORD;
　dwTimerHighValue: DWORD); stdcall;
var
　UTCFileTime,LocalFileTime: TFileTime;
　SystemTime: TSystemTime;
　DateTime: TDateTime;
　pt2: TPoint;
begin
　UTCFileTime.dwLowDateTime := dwTimerLowValue;
　UTCFileTime.dwHighDateTime := dwTimerHighValue;
　FileTimeToLocalFileTime(UTCFileTime, LocalFileTime);
　FileTimeToSystemTime(LocalFileTime, SystemTime);
　DateTime := SystemTimeToDateTime(SystemTime);
　pt2 := PPoint(lpArgToCompletionRoutine)^; {接受指针参数}
　Form1.Canvas.Lock;
　Form1.Canvas.TextOut(pt2.X, pt2.Y, DateTimeToStr(DateTime));
　Form1.Canvas.Unlock;
　SleepEx(INFINITE, True);
end;
{线程入口函数}
function MyThreadFun(p: Pointer): Integer; stdcall;
var
　DueTime: Int64;
begin
　DueTime := 0;
　{参数 @pt 在这里是鼠标点击窗体时的坐标结构的指针, 它将传递给 APC 函数的第一个参数}
　if SetWaitableTimer(hTimer, DueTime, 1000, @TimerAPCProc, @pt, False) then
　begin
　　SleepEx(INFINITE, True);
　end;
　Result := 0;
end;
{建立 WaitableTimer 对象和线程}
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
　Shift: TShiftState; X, Y: Integer);
var
　ID: DWORD;
begin
　pt := Point(X,Y); {在这里个全局的坐标点赋值}
　if hTimer = 0 then　hTimer := CreateWaitableTimer(nil, True, nil);
　CreateThread(nil, 0, @MyThreadFun, nil, 0, ID);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
　CloseHandle(hTimer);
end;
end.

窗体文件:

object Form1: TForm1
　Left = 0
　Top = 0
　Caption = 'Form1'
　ClientHeight = 135
　ClientWidth = 195
　Color = clBtnFace
　Font.Charset = DEFAULT_CHARSET
　Font.Color = clWindowText
　Font.Height = -11
　Font.Name = 'Tahoma'
　Font.Style = []
　OldCreateOrder = False
　OnMouseDown = FormMouseDown
　PixelsPerInch = 96
　TextHeight = 13
end