• 设为首页
  • 点击收藏
  • 手机版
    手机扫一扫访问
    迪恩网络手机版
  • 关注官方公众号
    微信扫一扫关注
    公众号
登陆 注册

DELPHI多线程（API实现）

原作者: [db:作者] 来自: [db:来源] 收藏 邀请

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  
                       
                    
                    
 
                      





鲜花




握手




雷人




路过




鸡蛋
该文章已有0人参与评论

请发表评论

全部评论

专题导读
More+
上一篇：
Delphi使用FireBird嵌入式版本发布方法发布时间：2022-07-18
下一篇：
DELPHI新版本WEBSERVICE的变化发布时间：2022-07-18
热门推荐
More+
热门话题
More+
阅读排行榜

扫描微信二维码

查看手机版网站

随时了解更新最新资讯

139-2527-9053

在线客服（服务时间 9:00～18:00）

在线QQ客服
地址：深圳市南山区西丽大学城创智工业园
电邮：jeky_zhao#qq.com
移动电话：139-2527-9053

Powered by 互联科技 X3.4© 2001-2213 极客世界.|Sitemap