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

本次专门研究下 SetWaitableTimer 的第二个参数(起始时间).
它有正值、负值、0值三种情况, 前面已用过 0值.
先学习负值(相对时间), 也就是从当前算起隔多长时间开始执行.

这个相对时间是以 1/100 纳秒为单位的, 譬如赋值 3*10000000 相当于 3 秒.

1 s(秒) = 1,000             ms(毫秒);
1 s(秒) = 1,000,000         µs(微妙);
1 s(秒) = 1,000,000,000     ns(纳秒);
1 s(秒) = 1,000,000,000,000 ps(皮秒);

本例效果图:

---

代码文件:

---

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 := -3*10000000; {3秒钟后执行}
  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

当我们需要一个绝对时间时, 譬如 2009-2-18 13:10:5, 函数需要的 Int64 值应该是个 TFileTime 格式的时间.

先看三种相关时间类型(TFileTime、TSystemTime、TDateTime)的定义:

---

TFileTime(又名 FILETIME 或 _FILETIME)
_FILETIME = record
  dwLowDateTime: DWORD;
  dwHighDateTime: DWORD;
end;

TSystemTime(又名 SYSTEMTIME 或 _SYSTEMTIME)
_SYSTEMTIME = record
  wYear: Word;
  wMonth: Word;
  wDayOfWeek: Word;
  wDay: Word;
  wHour: Word;
  wMinute: Word;
  wSecond: Word;
  wMilliseconds: Word;
end;

TDateTime = type Double;

//TFileTime 相当于一个 Int64, 一般要通过给 TSystemTime 或 TDateTime 赋值, 然后转换过去.
//在例子中我是通过下面过程转过去的:
StrToDateTime -> DateTimeToSystemTime -> SystemTimeToFileTime -> LocalFileTimeToFileTime

下面程序指定在 2009年2月18号下午1点10分5秒时运行三个线程(窗体同上, 我已找了个合适的时间测试成功).

---

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);
const
  strTime = '2009-2-18 13:10:5';
var
  ThreadID: DWORD;
  DueTime: Int64;
  st: TSystemTime;
  ft,UTC: TFileTime;
  dt: TDateTime;
begin
  DateTimeToSystemTime(StrToDateTime(strTime), st); {从 TDateTime 到 TSystemTime}
  SystemTimeToFileTime(st, ft);                     {从 TSystemTime 到 TFileTime}
  LocalFileTimeToFileTime(ft, UTC);                 {从本地时间到国际标准时间 UTC}
  DueTime := Int64(UTC);                            {函数需要的是 Int64}

  hWaitableTimer := CreateWaitableTimer(nil, True, nil);
  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.

接下来该是 WaitableTimer 对象的回调函数了.

---