Delphi多线程编程(14)--多线程同步之WaitableTimer（等待定时器对象）

转载自：万一的博客

function CreateWaitableTimer(
    lpTimerAttributes: PSecurityAttributes;    //安全
    bManualReset: BOOL;        //True：可调度多个线程；False：只调度一个线程
    lpTimerName: PWideChar        //名称
):THandle; stdcall;    //返回句柄

function SetWaitableTimer(
    hTime: THandle;        //句柄
    var lpDueTime: TLargeInteger;    //起始时间
    lPeriod: Longint;        //间隔时间
    pfnCompletionRoutine: TFNTimerAPCRoutine;    //回调函数的指针
    lpArgToCompletionRoutine: Pointer;    //给回调函数的参数
    fResume: BOOL;    //是否唤醒系统
): BOOL; stdcall;

　　WaitableTimer 对象比较复杂，其基本的理念是让等待的线程在指定的时间运行

　　像其他同类对象一样，要先建立（CreateWaitableTimer），建立函数的第二个参数决定是调度一个线程还是所有等待的线程；这一点和信号对象（Semaphore）有些类似，不过Semaphore可以指定可驱动线程的具体数目

　　和其他同类对象不同的是：在CreateWaitableTimer 以后，WaitableTimer 对象并没有马上开始工作

　　再调度SetWaitableTimer函数之后才能让它发挥作用，这又有点像Event 对象

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.FormDestory(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

　　本例效果图

　　代码文件

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.