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 (互斥对象)
要理解的函数有：
function CreateMutex(
lpMutexAttributes: PSecurityAttributes; {安全参数，默认真nil}
bInitialOwner: BOOL; {是否让创建者(此例中是主线程)拥有该互斥对象}{一般为False}
lpName: PWideChar {可以给此互斥对象取个名字, 如果不要名字可赋值为 nil}
): THandle;
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 (事件对象)
function CreateEvent(
lpEventAttributes: PSecurityAttributes; {安全设置}
bManualReset: BOOL; {第一个布尔}
bInitialState: BOOL; {第二个布尔}
lpName: PWideChar {对象名称}
): THandle; stdcall; {返回对象句柄}
//第一个布尔为 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 可以跨线程、跨进程使用.}
需要了解的函数：
function CreateWaitableTimer(
lpTimerAttributes: PSecurityAttributes; {安全}
bManualReset: BOOL; {True: 可调度多个线程; False: 只调度一个线程}
lpTimerName: PWideChar {名称}
): THandle; stdcall; {返回句柄}
function SetWaitableTimer(
hTimer: THandle; {句柄} {WaitableTimer 对象的句柄}
var lpDueTime: TLargeInteger; {起始时间} //0为马上，另有相对时间如:-3*10000000; {3秒钟后执行}，绝对时间：如：'2016-08-26 10:06:00' 需要转换
lPeriod: Longint; {间隔时间}
pfnCompletionRoutine: TFNTimerAPCRoutine;{回调函数的指针，不用时为空}
lpArgToCompletionRoutine: Pointer; {给回调函数的参数，不用时为空}
fResume: BOOL {是否唤醒系统}{此值若是 True, 即使系统在屏保或待机状态, 时间一到线程和系统将都被唤醒!}
): BOOL; stdcall; {}
例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高。
- 上一篇 »【转】Delphi多线程编程
- 下一篇 »DELPHI 多线程，TThread类的实现