DELPHI多线程（API实现）

OGeek|极客世界-中国程序员成长平台 › 门户 › 编程›综合其他

原作者: [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 (互斥对象)

要理解的函数有：

 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  
                       
                    
                     
                      



鲜花




握手




雷人




路过




鸡蛋

该文章已有0人参与评论

请发表评论

全部评论

专题导读

More+

10-27 六六分期app的软件客服如何联系？(六六分期

11-06 可心卡盟:win10系统火狐flash插件崩溃怎么

11-06 亲亲特价:怎么删除回收站图标

11-06 济南大学虚拟社区:鲁大师节能降温的具体办

11-06 xlueops.exe:无线网络安装向导

11-06 女斗合众国:win7系统cf与主机连接不稳定怎

11-06 0xc000022-[cf烟雾头]cf怎么调烟雾头

11-06 qizideyouhuo:应用程序无法正常启动0xc0000

11-06 ipz-185:win7系统vcf文件怎么打开

11-06 傻哥蹦迪:win10系统s4怎么打开usb调试

11-06 八神浩树gtaste:回收站清空了怎么恢复

11-06 妖尾之黑色守护:win10系统电脑没有1440x900

11-06 校园至尊魔王小说:win7系统浏览网页时字体

11-06 女斗合众国:win10系统访问共享文件夹提示请

11-06 tokyo hot n0654:恢复win7系统默认字体一招

11-06 雨酷仙境:设置win7系统转移临时文件夹腾出

11-06 阿穆纳伊之杖:win7系统开始菜单在右边还原

11-06 tunespotting:win10系统火狐flash插件总是

11-06 甘尔葛分析师：计谋网站seo关键词暴涨有什

11-06 蔡贵霖: 计谋网站seo关键词暴涨有什么秘密

11-06 博益网首页:ao3网页版进入不了解决方法

11-06 漏斗子专栏: 网站数据分析小白易懂精华篇

11-06 见证双虹怎么做:win7系统开启telnet命令的

11-06 颾狐蝶蜋:系统资源不足无法完成请求的服务

11-06 国光中学校歌:提交网站到alexa查询详细步骤

11-06 西安有情天:静态网页和动态网页的区别

11-06 红木雅尚斋:外部链接构造对网站的好处

11-06 前官礼遇：防止域名劫持–增强域安全性的10

11-06 密传二转答案: 中文分词算法有哪些

11-06 金泉家园邮编:百度快照劫持的表现及应对方

Delphi使用FireBird嵌入式版本发布方法发布时间：2022-07-18

DELPHI新版本WEBSERVICE的变化发布时间：2022-07-18

剪的笔顺,诠释剪的笔画,认识剪的部首

1 六六分期app的软件客服如何联系？(六六分期

六六分期app的软件客服如何联系？不知道吗？加qq群【895510560】即可！标题：六六分期

阅读：18079|2023-10-27

2 可心卡盟:win10系统火狐flash插件崩溃怎么

今天小编告诉大家如何处理win10系统火狐flash插件总是崩溃的问题，可能很多用户都不知

阅读：9613|2022-11-06

3 亲亲特价:怎么删除回收站图标

今天小编告诉大家如何对win10系统删除桌面回收站图标进行设置，可能很多用户都不知道

阅读：8147|2022-11-06

4 济南大学虚拟社区:鲁大师节能降温的具体办

今天小编告诉大家如何对win10系统电脑设置节能降温的设置方法，想必大家都遇到过需要

阅读：8530|2022-11-06

5 xlueops.exe:无线网络安装向导

我们在使用xp系统的过程中,经常需要对xp系统无线网络安装向导设置进行设置，可能很多

阅读：8432|2022-11-06

6 女斗合众国:win7系统cf与主机连接不稳定怎

今天小编告诉大家如何处理win7系统玩cf老是与主机连接不稳定的问题，可能很多用户都不

阅读：9343|2022-11-06

7 0xc000022-[cf烟雾头]cf怎么调烟雾头

电脑对日常生活的重要性小编就不多说了，可是一旦碰到win7系统设置cf烟雾头的问题，很

阅读：8395|2022-11-06

8 qizideyouhuo:应用程序无法正常启动0xc0000

我们在日常使用电脑的时候，有的小伙伴们可能在打开应用的时候会遇见提示应用程序无法

阅读：7832|2022-11-06

9 ipz-185:win7系统vcf文件怎么打开

今天小编告诉大家如何对win7系统打开vcf文件进行设置，可能很多用户都不知道怎么对win

阅读：8385|2022-11-06

10 傻哥蹦迪:win10系统s4怎么打开usb调试

今天小编告诉大家如何对win10系统s4开启USB调试模式进行设置，可能很多用户都不知道怎

阅读：7380|2022-11-06

扫描微信二维码

查看手机版网站

随时了解更新最新资讯

139-2527-9053

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

在线QQ客服

地址：深圳市南山区西丽大学城创智工业园

电邮：jeky_zhao#qq.com

移动电话：139-2527-9053

客服电话

电子邮件

DELPHI多线程（API实现）

请发表评论

全部评论

上一篇：

下一篇：

librespeed/speedtest: Self-hosted Speedt

avehtari/BDA_m_demos: Bayesian Data Anal

四维彩超怎么看性别？四维看男孩女孩诀窍

TUNER88/iOSSystemSoundsLibrary: List of

medfreeman/markdown-it-toc-and-anchor: m

剪的笔顺,诠释剪的笔画,认识剪的部首

六六分期app的软件客服如何联系？(六六分期

florent37/ViewAnimator: A fluent Android

florent37/Shrine-MaterialDesign2: implem

CVE-2020-36276

SimpleSoftwareIO/simple-sms: Send and re

关于我们

产品与服务

解决方案

139-2527-9053