多线程编程(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.