DELPHI 多线程（API实现）

DELPHI 多线程（API实现）：

首先看下构造函数：（会自动销毁）

function CreateThread(

lpThreadAttributes: Pointer; {安全设置} {一般为Nil}

dwStackSize: DWORD; {堆栈大小} {0为默认大小}

lpStartAddress: TFNThreadStartRoutine; {入口函数} { 例：@MyFun}

lpParameter: Pointer; {函数参数}｛入口函数的参数｝{@参数}

dwCreationFlags: DWORD; {启动选项} {有两个值，0时立即执行入口函数，CREATE_SUSPENDED，挂起等待。可用 ResumeThread（句柄）函数是恢复线程的运行; 可用 SuspendThread（句柄）再次挂起线程.}

var lpThreadId: DWORD {输出线程 ID } {输入你的接收句柄变量}

): THandle; stdcall; {返回线程句柄}

例子：

 1 unit Unit1;
 2 
 3 interface
 4 
 5 uses
 6   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 7   Dialogs, StdCtrls;
 8 
 9 type
10   TForm1 = class(TForm)
11     btn1: TButton;
12     btn2: TButton;
13     procedure btn1Click(Sender: TObject);
14     procedure btn2Click(Sender: TObject);
15   private
16     { Private declarations }
17   public
18     { Public declarations }
19   end;
20 
21 var
22   Form1: TForm1;
23 
24 implementation
25 
26 {$R *.dfm}
27 
28 function MyFun(p:Pointer):integer;stdcall; {工作线程调入函数，stdcall用于多个线程排序以及系统级别调用加此关键字}
29 var
30   i:integer;
31 begin
32   for i := 0 to 500000 do    
33   begin
34     with Form1.Canvas do
35     begin
36       Lock;
37       TextOut(50,10,IntToStr(i)); {50和10是坐标X和Y}
38       Unlock;
39       Application.ProcessMessages;
40     end;
41   end;
42 end;
43 
44 procedure TForm1.btn1Click(Sender: TObject);{主线程}
45 var
46   i:integer;
47 begin
48   for i := 0 to 500000 do  
49   begin
50     with Form1.Canvas do
51     begin
52       Lock;
53       TextOut(10,10,IntToStr(i)); {10和10是坐标X和Y}
54       Unlock;
55       Application.ProcessMessages;{加上去才在计数时不会卡住，拖动窗体时，计数会有停顿}
56     end;
57   end;
58 
59 end;
60 
61 procedure TForm1.btn2Click(Sender: TObject);{工作线程，拖动窗口时计数不会停顿，因为和主线程分开工作了}
62 var
63   ID:THandle; {用于接收线程返回句柄，也可以用DWORD}
64 begin
65   CreateThread(nil,0,@MyFun,nil,0,ID);  {API创建线程}
66 end;
67 
68 end.

CriticalSection(临界区)：

 1 unit Unit1;
 2 
 3 interface
 4 
 5 uses
 6   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 7   Dialogs, StdCtrls;
 8 
 9 type
10   TForm1 = class(TForm)
11     lst1: TListBox;
12     btn1: TButton;
13     procedure btn1Click(Sender: TObject);
14     procedure FormDestroy(Sender: TObject);
15   private
16     { Private declarations }
17   public
18     { Public declarations }
19   end;
20 
21 var
22   Form1: TForm1;
23 
24 implementation
25 
26 {$R *.dfm}
27 
28 var
29   CS:TRTLCriticalSection; {声明临界}
30 
31 function MyFun(p:Pointer):integer;stdcall;
32 var
33   i:integer;
34 begin
35   EnterCriticalSection(CS);  {我要用了，别人先别用}
36   for i := 0 to 100 - 1 do
37   begin
38     Form1.lst1.Items.Add(IntToStr(i));
39   end;
40   LeaveCriticalSection(CS);  {我用完了，别可以用了}
41 
42 end;
43 
44 procedure TForm1.btn1Click(Sender: TObject);
45 var
46   ID:THandle;
47 begin
48   InitializeCriticalSection(CS); {初始化临界}
49   CreateThread(nil,0,@MyFun,nil,0,ID);
50   CreateThread(nil,0,@MyFun,nil,0,ID);
51   CreateThread(nil,0,@MyFun,nil,0,ID);
52 end;
53 
54 procedure TForm1.FormDestroy(Sender: TObject);
55 begin
56   DeleteCriticalSection(CS);  {删除临界}
57 end;
58 
59 end.

------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------

先说明等待函数(后面要配套使用)：

function WaitForSingleObject(
hHandle: THandle; {要等待的对象句柄}
dwMilliseconds: DWORD {等待的时间, 单位是毫秒}
): DWORD; stdcall; {返回值如下:}

WAIT_OBJECT_0 {等着了, 本例中是: 等的那个进程终于结束了}
WAIT_TIMEOUT {等过了点(你指定的时间), 也没等着}
WAIT_ABANDONED {好不容易等着了, 但人家还是不让咱执行; 这一般是互斥对象}

//WaitForSingleObject 的第二个参数一般给常数值 INFINITE, 表示一直等下去, 死等.

Mutex (互斥对象)

要理解的函数有：

 1 unit Unit1;
 2 
 3 interface
 4 
 5 uses
 6   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 7   Dialogs, StdCtrls;
 8 
 9 type
10   TForm1 = class(TForm)
11     btn1: TButton;
12     procedure btn1Click(Sender: TObject);
13     procedure FormDestroy(Sender: TObject);
14   private
15     { Private declarations }
16   public
17     { Public declarations }
18   end;
19 
20 var
21   Form1: TForm1;
22 
23 implementation
24 
25 {$R *.dfm}
26 
27 var
28   hMutex:THandle; {声明互斥变量句柄}
29   f:Integer;      {用于协调输出位置的变量}
30 
31 function MyFun(p:Pointer):Integer;stdcall;
32 var
33   i,y:integer;
34 begin
35   Inc(f);  {步进f}
36   y:=20*f;
37   if WaitForSingleObject(hMutex,INFINITE)=WAIT_OBJECT_0 then   {等待函数}
38   begin
39     for i := 0 to 500 do
40     begin
41       with Form1.Canvas do
42       begin
43         Lock;
44         TextOut(10,Y,IntToStr(i));
45         Unlock;
46         sleep(1); {太快怕忙不过来}
47       end;
48     end;
49     ReleaseMutex(hMutex);
50   end;
51 end;  
52 
53 
54 procedure TForm1.btn1Click(Sender: TObject);
55 var
56   ID:THandle;
57 begin
58   f:=0; {初始化f为0}
59   Repaint; {重画}
60   CloseHandle(hMutex); {先关闭句柄}
61   hMutex:=CreateMutex(nil,False,nil);  {创建互斥体}
62   CreateThread(nil,0,@MyFun,nil,0,ID);
63   CreateThread(nil,0,@MyFun,nil,0,ID);
64   CreateThread(nil,0,@MyFun,nil,0,ID);
65   CreateThread(nil,0,@MyFun,nil,0,ID);
66 end;
67 
68 procedure TForm1.FormDestroy(Sender: TObject);
69 begin
70   CloseHandle(hMutex);  {关闭句柄}
71 end;
72 
73 end.

Semaphore(信号或叫信号量)

要理解的函数：

CreateSemaphore(安全设置, 初始信号数, 信号总数, 信号名称) 建立信号对象;
参数四: 和 Mutex 一样, 它可以有个名称, 也可以没有, 本例就没有要名称(nil); 有名称的一般用于跨进程.
参数三: 信号总数, 是 Semaphore 最大处理能力, 就像银行一共有多少个业务窗口一样;
参数二: 初始信号数, 这就像银行的业务窗口很多, 但打开了几个可不一定, 如果没打开和没有一样;{本例用个EDIT输入数量，每次释放后又进行同样数量}
参数一: 安全设置和前面一样, 使用默认(nil)即可.

ReleaseSemaphore(接受信号量句柄,1[接收多少个信号] , nil[一般为空，如果是指针可以接受到此时共闲置了多少个信号量])；

 1 unit Unit1;
 2 
 3 interface
 4 
 5 uses
 6   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 7   Dialogs, StdCtrls;
 8 
 9 type
10   TForm1 = class(TForm)
11     btn1: TButton;
12     edt1: TEdit;
13     procedure btn1Click(Sender: TObject);
14     procedure FormDestroy(Sender: TObject);
15     procedure btn1KeyPress(Sender: TObject; var Key: Char);
16   private
17     { Private declarations }
18   public
19     { Public declarations }
20   end;
21 
22 var
23   Form1: TForm1;
24 
25 implementation
26 
27 {$R *.dfm}
28 
29 var
30   hsmaphore:THandle; {信号量句柄}
31   f:Integer;         {协调输出的变量}
32 
33 function MyFun(p:Pointer):integer;
34 var
35   i,y:integer;
36 begin
37   Inc(f);
38   y:=20*f;
39   if WaitForSingleObject(hsmaphore,INFINITE)=WAIT_OBJECT_0 then
40   begin
41     for i := 0 to 500 do
42     begin
43       with Form1,Canvas do
44       begin
45         Lock;
46         TextOut(10,y,IntToStr(i));
47         Unlock;
48         Sleep(1);
49       end;
50     end;
51     ReleaseSemaphore(hsmaphore,1,nil); {释放函数}
52   end;
53   Result:=0;
54 end;
55 
56 procedure TForm1.btn1Click(Sender: TObject);
57 var
58   ID:DWORD;
59 begin
60   CloseHandle(hsmaphore);  {先关闭句柄}
61   hsmaphore:=CreateSemaphore(nil,StrToInt(edt1.Text),5,nil); {创建句柄}
62   CreateThread(nil,0,@MyFun,nil,0,ID);   {创建线程}
63   CreateThread(nil,0,@MyFun,nil,0,ID);
64   CreateThread(nil,0,@MyFun,nil,0,ID);
65   CreateThread(nil,0,@MyFun,nil,0,ID);
66   CreateThread(nil,0,@MyFun,nil,0,ID);
67 end;
68 
69 procedure TForm1.btn1KeyPress(Sender: TObject; var Key: Char);
70 begin
71   if not (Key in ['1'..'5']) then Key:=#0;  {设置只能输入1到5，并且在控件属性设置宽度为1}
72   
73 end;
74 
75 procedure TForm1.FormDestroy(Sender: TObject);
76 begin
77   CloseHandle(hsmaphore);  {关闭句柄}
78 end;
79 
80 end.

Event (事件对象)

//第一个布尔为 False 时, 事件对象控制一次后将立即重置(暂停); 为 True 时可手动暂停.
//第二个布尔为 False 时, 对象建立后控制为暂停状态; True 是可运行状态.

  1 unit Unit1;
  2 
  3 interface
  4 
  5 uses
  6   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  7   Dialogs, StdCtrls;
  8 
  9 type
 10   TForm1 = class(TForm)
 11     btn1: TButton;
 12     btn2: TButton;
 13     btn3: TButton;
 14     btn4: TButton;
 15     btn5: TButton;
 16     procedure btn1Click(Sender: TObject);
 17     procedure btn2Click(Sender: TObject);
 18     procedure btn3Click(Sender: TObject);
 19     procedure btn4Click(Sender: TObject);
 20     procedure btn5Click(Sender: TObject);
 21     procedure FormCreate(Sender: TObject);
 22     procedure FormDestroy(Sender: TObject);
 23   private
 24     { Private declarations }
 25   public
 26     { Public declarations }
 27   end;
 28 
 29 var
 30   Form1: TForm1;
 31 
 32 implementation
 33 
 34 {$R *.dfm}
 35 
 36 var
 37   hEvent:THandle;
 38   f:integer;
 39 
 40 function MyFun (p:Pointer):Integer;
 41 var
 42   i,y:integer;
 43 begin
 44   Inc(f);
 45   y:=20*f;
 46   for i := 0 to 200000 do
 47   begin
 48     if WaitForSingleObject(hEvent,INFINITE)=WAIT_OBJECT_0 then
 49     begin
 50       Form1.Canvas.Lock;
 51       Form1.Canvas.TextOut(10,y,IntToStr(i));
 52       Form1.Canvas.Unlock;
 53       
 54     end;
 55   end;
 56   Result:=0;
 57 end;
 58 
 59 procedure TForm1.btn1Click(Sender: TObject);
 60 var
 61   ID:DWORD;
 62 begin
 63   Repaint;  {重画}
 64   f:=0;
 65   CloseHandle(hEvent);{先关闭线程}
 66   hEvent:=CreateEvent(nil,True,True,nil)  {创建事件}
 67 end;
 68 
 69 procedure TForm1.btn2Click(Sender: TObject);
 70 var
 71   ID:DWORD;
 72 begin
 73   CreateThread(nil,0,@MyFun,nil,0,ID);  {创建线程}
 74 
 75 end;
 76 
 77 procedure TForm1.btn3Click(Sender: TObject);
 78 begin
 79   ResetEvent(hEvent); {暂停,可对当前所有事件相关线程暂停}
 80 end;
 81 
 82 procedure TForm1.btn4Click(Sender: TObject);
 83 begin
 84   SetEvent(hEvent);  {启动，可对当前所有事件相关线程启动}
 85 end;
 86 
 87 procedure TForm1.btn5Click(Sender: TObject);
 88 begin
 89   PulseEvent(hEvent); {启动一次再暂停，可对当前所有事件相关线程}
 90 end;
 91 
 92 procedure TForm1.FormCreate(Sender: TObject);
 93 begin
 94   btn1.Caption := '创建 Event 对象';
 95   btn2.Caption := '创建线程';
 96   btn3.Caption := 'ResetEvent';
 97   btn4.Caption := 'SetEvent';
 98   btn5.Caption := 'PulseEvent';
 99 end;
100 
101 procedure TForm1.FormDestroy(Sender: TObject);
102 begin
103   CloseHandle(hEvent); {关闭事件句柄}
104 end;
105 
106 end.

等待记时器对象：WaitableTimer{比较复杂，可不记，需要使用时查阅}

{它的主要功用类似 TTimer 类,既然有了方便的 TTimer, 何必再使用 WaitableTimer 呢?
因为 WaitableTimer 比 TTimer 精确的多, 它的间隔时间可以精确到毫秒、它的指定时间甚至是精确到 0.1 毫秒;
而 TTimer 驱动的 WM_TIMER 消息, 是消息队列中优先级最低的, 也就是再同一时刻 WM_TIMER 消息总是被最后处理.
还有重要的一点 WaitableTimer 可以跨线程、跨进程使用.}

需要了解的函数：

例1：指定多少秒后运行(相对时间)：

 1 unit Unit1;
 2 
 3 interface
 4 
 5 uses
 6   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 7   Dialogs, StdCtrls;
 8 
 9 type
10   TForm1 = class(TForm)
11     btn1: TButton;
12     procedure btn1Click(Sender: TObject);
13     procedure FormDestroy(Sender: TObject);
14   private
15     { Private declarations }
16   public
17     { Public declarations }
18   end;
19 
20 var
21   Form1: TForm1;
22 
23 implementation
24 
25 {$R *.dfm}
26 
27 var
28   hWaitableTimer:THandle;
29   f:integer;
30 
31 function MyFun(p:Pointer):integer;
32 var
33   i,y:integer;
34 begin
35   inc(f);
36   y:=20*f;
37 
38   if WaitForSingleObject(hWaitableTimer,INFINITE)=WAIT_OBJECT_0 then
39   begin
40     for I := 0 to 1000 do
41     begin
42       Form1.Canvas.Lock;
43       Form1.Canvas.TextOut(10,Y,IntToStr(I));
44       Form1.Canvas.Unlock;
45       Sleep(1);
46     end;
47   end;
48   Result:=0;
49 end;
50 
51 
52 
53 procedure TForm1.btn1Click(Sender: TObject);
54 var
55   DueTimer:Int64;
56   ID:DWORD;
57 begin
58   hWaitableTimer:=CreateWaitableTimer(nil,True,nil); {创建等待计时器，允许多线程同时进行}
59   DueTimer:=-3*10000000; {三秒后执行}
60   SetWaitableTimer(hWaitableTimer,DueTimer,0,nil,nil,False);  {设置计时器开始运行时间}
61 
62   Repaint;
63   f:=0;
64   CreateThread(nil,0,@MyFun,nil,0,ID);
65   CreateThread(nil,0,@MyFun,nil,0,ID);
66   CreateThread(nil,0,@MyFun,nil,0,ID);
67 end;
68 
69 procedure TForm1.FormDestroy(Sender: TObject);
70 begin
71   CloseHandle(hWaitableTimer); {句柄}
72 end;
73 
74 end.

例2：指定一个时间里运行(绝对时间)：

//StrToDateTime -> DateTimeToSystemTime -> SystemTimeToFileTime -> LocalFileTimeToFileTime 时间转换

 1 unit Unit1;
 2 
 3 interface
 4 
 5 uses
 6   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 7   Dialogs, StdCtrls;
 8 
 9 type
10   TForm1 = class(TForm)
11     btn1: TButton;
12     procedure btn1Click(Sender: TObject);
13     procedure FormDestroy(Sender: TObject);
14   private
15     { Private declarations }
16   public
17     { Public declarations }
18   end;
19 
20 var
21   Form1: TForm1;
22 
23 implementation
24 
25 {$R *.dfm}
26 
27 var
28   hWaitableTimer:THandle;
29   f:integer;
30 
31 function MyFun(p:Pointer):integer;
32 var
33   i,y:integer;
34 begin
35   inc(f);
36   y:=20*f;
37 
38   if WaitForSingleObject(hWaitableTimer,INFINITE)=WAIT_OBJECT_0 then
39   begin
40     for I := 0 to 1000 do
41     begin
42       Form1.Canvas.Lock;
43       Form1.Canvas.TextOut(10,Y,IntToStr(I));
44       Form1.Canvas.Unlock;
45       Sleep(1);
46     end;
47   end;
48   Result:=0;
49 end;
50 
51 
52 
53 procedure TForm1.btn1Click(Sender: TObject);
54 const
55   strTime='2016-8-29 14:41:30';
56 var
57   DueTimer:Int64;
58   ID:DWORD;
59   st:TSystemTime;
60   ft,Utc:TFileTime;
61   dt:TDateTime;
62 begin
63   DateTimeToSystemTime(StrToDateTime(strTime), st); {从 TDateTime 到 TSystemTime}
64   SystemTimeToFileTime(st, ft);                     {从 TSystemTime 到 TFileTime}
65   LocalFileTimeToFileTime(ft, UTC);                 {从本地时间到国际标准时间 UTC}
66   DueTimer:= Int64(UTC);                            {函数需要的是 Int64}
67 
68   hWaitableTimer:=CreateWaitableTimer(nil,True,nil); {创建等待计时器，允许多线程同时进行}
69   SetWaitableTimer(hWaitableTimer,DueTimer,0,nil,nil,False);  {设置计时器开始运行时间}
70 
71   Repaint;
72   f:=0;
73   CreateThread(nil,0,@MyFun,nil,0,ID);
74   CreateThread(nil,0,@MyFun,nil,0,ID);
75   CreateThread(nil,0,@MyFun,nil,0,ID);
76 end;
77 
78 procedure TForm1.FormDestroy(Sender: TObject);
79 begin
80   CloseHandle(hWaitableTimer); {关闭句柄}
81 end;
82 
83 end.

下面例子需要了解以下函数：

function SleepEx(
dwMilliseconds: DWORD; {毫秒数} {INFINITE 表示一直等}
bAlertable: BOOL {布尔值}
): DWORD; stdcall;

//第一个参数和 Sleep 的那个参数是一样的, 是线程等待(或叫挂起)的时间, 时间一到不管后面参数如何都会返回.

//第二个参数如果是 False, SleepEx 将不会关照 APC 函数是否入列;
//若是 True, 只要有 APC 函数申请, SleepEx 不管第一个参数如何都会把 APC 推入队列并随 APC 函数一起返回.

//注意: SetWaitableTimer 和 SleepEx 必须在同一个线程才可以.

procedure TimerAPCProc(lpArgToCompletionRoutine: Pointer;dwTimerLowValue: DWORD;dwTimerHighValue: DWORD); stdcall;
//系统定义给SetWaitableTimer第一个回调函数指针的格式函数｛名字可以变，格式和类型不能变。｝

例3：窗口标题自增数字

本例在SetWaitableTimer使用TimerAPCProc回调函数，但不使用回调函数的参数

 1 unit Unit1;
 2 
 3 interface
 4 
 5 uses
 6   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 7   Dialogs, StdCtrls;
 8 
 9 type
10   TForm1 = class(TForm)
11     btn1: TButton;
12     btn2: TButton;
13     procedure btn1Click(Sender: TObject);
14     procedure btn2Click(Sender: TObject);
15     procedure FormDestroy(Sender: TObject);
16   private
17     { Private declarations }
18   public
19     { Public declarations }
20   end;
21 
22 var
23   Form1: TForm1;
24 
25 implementation
26 
27 {$R *.dfm}
28 
29 var
30   hTimer:THandle;
31 
32 procedure TimerAPCProc(APointer:Pointer;dwTimerLowValue:DWORD;dwTimerHighValue:DWORD);stdcall;
33 begin
34   Form1.Text:=IntToStr(StrToIntDef(Form1.Text,0)+1);
35   SleepEx(INFINITE,True);     {在回调参数里加这一句，会不断的循环}
36 end;
37 
38 function MyFun(p:Pointer):integer;stdcall;
39 var
40   DueTime:Int64;
41 begin
42   DueTime:=0;
43   {SetWaitableTimer 必须与 SleepEx 在同一线程}
44   if SetWaitableTimer(hTimer,DueTime,1000,@TimerAPCProc,nil,False) then  //使用了APC回调函数，回调函数的参数此例没有
45   begin
46     SleepEx(INFINITE,True);
47   end;
48   Result:=0;
49 end;
50 
51 procedure TForm1.btn1Click(Sender: TObject);
52 var
53   ID:DWORD;
54 begin
55   CloseHandle(hTimer);
56   hTimer:=CreateWaitableTimer(nil,True,nil); {建立定时器}
57   CreateThread(nil,0,@MyFun,nil,0,ID);    {创建线程}
58 end;
59 
60 procedure TForm1.btn2Click(Sender: TObject);
61 begin
62   CancelWaitableTimer(hTimer);{取消定时器}
63 end;
64 
65 procedure TForm1.FormDestroy(Sender: TObject);
66 begin
67   CloseHandle(hTimer);  {关闭句柄}
68 end;
69 
70 end.

例4：在窗口标题上显示时间并自增计时

本例利用APC回调参数的第二个，第三个参数值获得时间并转换输出

//参数高低位时间>>合并成TFileTime(世界标准计时)>>LocalFileTime本地时间>>SystemTime系统时间>>Datetime

 1 unit Unit1;
 2 
 3 interface
 4 
 5 uses
 6   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 7   Dialogs, StdCtrls;
 8 
 9 type
10   TForm1 = class(TForm)
11     btn1: TButton;
12     btn2: TButton;
13     procedure btn1Click(Sender: TObject);
14     procedure btn2Click(Sender: TObject);
15     procedure FormDestroy(Sender: TObject);
16   private
17     { Private declarations }
18   public
19     { Public declarations }
20   end;
21 
22 var
23   Form1: TForm1;
24 
25 implementation
26 
27 {$R *.dfm}
28 
29 var
30   hTimer:THandle;
31 
32 procedure TimerAPCProc(APointer:Pointer;dwTimerLowValue:DWORD;dwTimerHighValue:DWORD);stdcall;
33 var
34   UTCFileTime,LocalFileTime:TFileTime;
35   SystemTime:TSystemTime;
36   DateTime:TDateTime;
37 begin
38    {把 dwTimerLowValue 与 dwTimerHighValue 和并为一个 TFileTime 格式的时间}
39   UTCFileTime.dwLowDateTime := dwTimerLowValue;
40   UTCFileTime.dwHighDateTime := dwTimerHighValue;
41 
42   FileTimeToLocalFileTime(UTCFileTime, LocalFileTime); {从世界标准计时到本地时间}
43   FileTimeToSystemTime(LocalFileTime, SystemTime);     {转到系统格式时间}
44   DateTime := SystemTimeToDateTime(SystemTime);        {再转到 TDateTime}
45 
46   Form1.Text:=DateTimeToStr(DateTime);
47   SleepEx(INFINITE,True);     {在回调参数里加这一句，会不断的循环}
48 end;
49 
50 function MyFun(p:Pointer):integer;stdcall;
51 var
52   DueTime:Int64;
53 begin
54   DueTime:=0;
55   {SetWaitableTimer 必须与 SleepEx 在同一线程}
56   if SetWaitableTimer(hTimer,DueTime,1000,@TimerAPCProc,nil,False) then  //使用了APC回调函数
57   begin
58     SleepEx(INFINITE,True);
59   end;
60   Result:=0;
61 end;
62 
63 procedure TForm1.btn1Click(Sender: TObject);
64 var
65   ID:DWORD;
66 begin
67   CloseHandle(hTimer);
68   hTimer:=CreateWaitableTimer(nil,True,nil); {建立定时器}
69   CreateThread(nil,0,@MyFun,nil,0,ID);    {创建线程}
70 end;
71 
72 procedure TForm1.btn2Click(Sender: TObject);
73 begin
74   CancelWaitableTimer(hTimer);{取消定时器}
75 end;
76 
77 procedure TForm1.FormDestroy(Sender: TObject);
78 begin
79   CloseHandle(hTimer);  {关闭句柄}
80 end;
81 
82 end.

例5：根据鼠标移动事件得到坐票在窗体上出现若干个时间计时

本例利用APC回调参数的第一个指针传递坐标

 1 unit Unit1;
 2 
 3 interface
 4 
 5 uses
 6   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 7   Dialogs, StdCtrls;
 8 
 9 type
10   TForm1 = class(TForm)
11     procedure FormDestroy(Sender: TObject);
12     procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
13       Shift: TShiftState; X, Y: Integer);
14   private
15     { Private declarations }
16   public
17     { Public declarations }
18   end;
19 
20 var
21   Form1: TForm1;
22 
23 implementation
24 
25 {$R *.dfm}
26 
27 var
28   hTimer:THandle; {等待计时器句柄}
29   pt:TPoint;      {用来传递坐标}
30 
31 procedure TimerAPCProc(APointer:Pointer;dwTimerLowValue:DWORD;dwTimerHighValue:DWORD);stdcall;
32 var
33   UTCFileTime,LocalFileTime:TFileTime;
34   SystemTime:TSystemTime;
35   DateTime:TDateTime;
36   pt2:TPoint;
37 begin
38    {把 dwTimerLowValue 与 dwTimerHighValue 和并为一个 TFileTime 格式的时间}
39   UTCFileTime.dwLowDateTime := dwTimerLowValue;
40   UTCFileTime.dwHighDateTime := dwTimerHighValue;
41 
42   FileTimeToLocalFileTime(UTCFileTime, LocalFileTime); {从世界标准计时到本地时间}
43   FileTimeToSystemTime(LocalFileTime, SystemTime);     {转到系统格式时间}
44   DateTime := SystemTimeToDateTime(SystemTime);        {再转到 TDateTime}
45 
46   pt2:=PPoint(APointer)^; {接受第一个指针参数坐标 }
47   Form1.Canvas.Lock;
48   Form1.Canvas.TextOut(pt2.x,pt2.Y,DateTimeToStr(DateTime)); {取XY为坐标}
49   Form1.Canvas.Unlock;
50 
51   SleepEx(INFINITE,True);  {此句可做循环}
52 end;
53 
54 function MyFun(p:Pointer):integer;stdcall;
55 var
56   DueTime:Int64;
57 begin
58   DueTime:=0;
59   {SetWaitableTimer 必须与 SleepEx 在同一线程}
60   if SetWaitableTimer(hTimer,DueTime,1000,@TimerAPCProc,@pt,False) then  //使用了APC回调函数
61   begin
62     SleepEx(INFINITE,True);  {此句用做循环}
63   end;
64   Result:=0;
65 end;
66 
67 
68 procedure TForm1.FormDestroy(Sender: TObject);
69 begin
70   CloseHandle(hTimer);  {关闭句柄}
71 end;
72 
73 
74 
75 procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
76   Shift: TShiftState; X, Y: Integer);
77 var
78   ID:DWORD;
79 begin
80   pt:=Point(x,y); {把XY坐票给pt}
81   if hTimer = 0 then hTimer:=CreateWaitableTimer(nil,True,nil);
82   CreateThread(nil,0,@MyFun,nil,0,ID);
83 end;
84 
85 end.

总结：

1.主线程做类似循环输出占用资源会容易卡住，使用Application.ProcessMessages虽然可以解决卡顿，可是却会让循环停下。

2.当需要用多线程安排时，就要用到临界，互斥，信号量，事件，等待计时器（较复杂），以下根据需求作说明：

临界：多个线程，一个一个进，用完一个再继续下一个。

互斥：接力棒，谁拿到是谁的。(看等待函数放哪和释放语句放哪，可多个抢着进行，也可一个个运行。)

信号量：可设置线程总数和先运行的数量。

事件：可对事件相关的线程进行暂停，开始，步进后暂停。

等待计时器：可根据需要设定为马上（0），相对时间，绝对时间运行；另外APC队伍调度级别高，时间精确度也比TTimer高。

posted on 2016-08-29 11:06 冰火（BH）阅读(3386) 评论(0) 编辑收藏举报