Delphi多线程编程 - 编程技巧文章

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

代码文件:

unit Unit1;
interface
uses
　Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
　Dialogs, ExtCtrls, StdCtrls;
type
　TForm1 = class(TForm)
　　Button1: TButton;
　　procedure Button1Click(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;
begin
　Form1.Text := IntToStr(StrToIntDef(Form1.Text, 0) + 1); {标题 + 1}
end;
procedure TForm1.Button1Click(Sender: TObject);
var
　DueTime: Int64;
begin
　hTimer := CreateWaitableTimer(nil, True, nil);
　DueTime := 0;
　if SetWaitableTimer(hTimer, DueTime, 0, @TimerAPCProc, nil, False) then
　begin
　　SleepEx(INFINITE, True); {INFINITE 表示一直等}
　end;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
　CloseHandle(hTimer);
end;
end.

窗体文件:

object Form1: TForm1
　Left = 0
　Top = 0
　Caption = 'Form1'
　ClientHeight = 113
　ClientWidth = 203
　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 = 64
　　Top = 48
　　Width = 75
　　Height = 25
　　Caption = 'Button1'
　　TabOrder = 0
　　OnClick = Button1Click
　end
end

　　在上面例子中, 每点一次鼠标, 那个回调函数才执行一次; 作为定时器, 如果想让它每秒执行一次怎么弄?

　　但每一次执行那个 APC 函数, 都得有 SleepEx(当然不止它)给送进去, 那这样得反复调用 SleepEx 才可以.

　　怎么调用, 用循环吗? 别说网上能找到的例子我没见到不用循环的(太笨了), 就在那个 APC 函数里调用不就完了.

　　当然这时一般要设时间间隔的, 下面我们将设间隔为 1000(1秒).

　　但接着问题又来了, 譬如把代码修改成:

var
　hTimer: THandle;
procedure TimerAPCProc(lpArgToCompletionRoutine: Pointer; dwTimerLowValue: DWORD;
　dwTimerHighValue: DWORD); stdcall;
begin
　Form1.Text := IntToStr(StrToIntDef(Form1.Text, 0) + 1);
　SleepEx(INFINITE, True); {这里再次调用 SleepEx}
end;
procedure TForm1.Button1Click(Sender: TObject);
var
　DueTime: Int64;
begin
　hTimer := CreateWaitableTimer(nil, True, nil);
　DueTime := 0;
　{下面的参数 1000 表示间隔 1秒}
　if SetWaitableTimer(hTimer, DueTime, 1000, @TimerAPCProc, nil, False) then
　begin
　　SleepEx(INFINITE, True);
　end;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
　CloseHandle(hTimer);
end;

任务能完成, 但窗体"死"了... 怎么办? 嘿, 现在学的不是多线程吗?

　　下面例子中, 同时使用了 CancelWaitableTimer 来取消定时器, 很好理解; 效果图:

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

　　代码文件:

unit Unit1;
interface
uses
　Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
　Dialogs, ExtCtrls, 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;
begin
　Form1.Text := IntToStr(StrToIntDef(Form1.Text, 0) + 1);
　SleepEx(INFINITE, True);
end;
{线程入口函数}
function MyThreadFun(p: Pointer): Integer; stdcall;
var
　DueTime: Int64;
begin
　DueTime := 0;
　{SetWaitableTimer 必须与 SleepEx 在同一线程}
　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
　{建立 WaitableTimer 对象}
　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.

本站仅提供存储服务，所有内容均由用户发布，如发现有害或侵权内容，请点击举报。