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高。