分享
 
 
 

vb实现多线程!

王朝vb·作者佚名  2006-01-08
窄屏简体版  字體: |||超大  

昨晚2:30的时候还没睡着,觉得有必要把vb编写多线程程序再次写一次;主要是以前忽略的细节和重要的环节;今天在公司打开一年多没用的vb,写了如下的代码;想写多线程的朋友可以调试一下看看,关于多线程的任务模式,同步和互斥,临界资源和临界区(文中提到)欢迎跟帖讨论;

'请将该部分数据保存为 FORM1.frm 文件

VERSION 5.00

Begin VB.Form Form1

Caption = "多线程"

ClientHeight = 3195

ClientLeft = 60

ClientTop = 345

ClientWidth = 6450

LinkTopic = "Form1"

ScaleHeight = 3195

ScaleWidth = 6450

StartUpPosition = 3 '窗口缺省

Begin VB.TextBox Text1

Height = 270

Left = 960

TabIndex = 2

Text = "2"

Top = 2760

Width = 2415

End

Begin VB.CommandButton Command2

Caption = "返回"

Height = 255

Left = 3480

TabIndex = 1

Top = 2760

Width = 1455

End

Begin VB.CommandButton Command1

Caption = "Start Count"

Height = 255

Left = 3480

TabIndex = 0

Top = 240

Width = 1455

End

Begin VB.Label Label1

AutoSize = -1 'True

Caption = "主线程执行结果测试:"

Height = 180

Left = 600

TabIndex = 3

Top = 2400

Width = 1710

End

End

Attribute VB_Name = "Form1"

Attribute VB_GlobalNameSpace = False

Attribute VB_Creatable = False

Attribute VB_PredeclaredId = True

Attribute VB_Exposed = False

'下载地址:

http://www.bssoft.com.cn/vbThread.rar

Private Sub Command1_Click()

'声明了线程ID

Dim threadid1 As Long

Dim threadid2 As Long

'参数一,lpThreadAttributes 线程安全属性,传递为NULL

'参数二,dwStackSize ,线程堆栈大小,可以为0,表示堆栈和此应用堆栈相同

'参数三,lpstartAddress ,执行函数地址,用AddressOf 获取

'参数四,lpParameter ,执行函数的参数地址,可以是一个记录或者是别的类型,用VarPtr获取参数地址(varptr为未公开函数)!!

'参数五,dwCreationFlags ,表示线程创建后的状态!,0表示立即运行,create_SUSPENDED表示线程挂起

'参数六,lpThreadID 表示分配给线程的线程号

Call CreateThread(Null, ByVal O&, AddressOf Module1.OutText1, VarPtr(0), ByVal 0&, threadid1)

Call CreateThread(Null, ByVal 0&, AddressOf Module1.OutText2, VarPtr(0), ByVal 0&, threadid2)

End Sub

Private Sub Command2_Click()

'该事件运行于主线程!

Dim i As Long

i = CLng(Text1.Text)

Text1.Text = CStr(i * i) '不要点击次数太多,LONG 类型会溢出

End Sub

Private Sub Form_Load()

'保存窗体句柄全局变量,用于在form 上绘图

formhandle = Form1.hwnd

End Sub

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

'请将该部分数据保存为 Module1.bas 文件

Attribute VB_Name = "Module1"

'线程安全属性数据结构;

Public Type SECURITY_ATTRIBUTES

nLength As Long

lpSecurityDescriptor As Long

bInheritHandle As Long

End Type

'这个是用于多线程访问临界资源同步Api的数据结构

Public Type CRITICAL_SECTION

dummy As Long

End Type

'为什么用GDI 函数绘图?原因等下再讲

Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long

Public Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long

Public Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long

Public Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long

'请注意;createThread APi声明已被我修改过,修改的地方请自行参照APIView复制的内容

Public Declare Function CreateThread Lib "kernel32" (lpThreadAttributes As Any, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, ByVal lpParameter As Long, ByVal dwCreationFlags As Long, lpThreadId As Long) As Long

'这个是sleep,作用就是让两个线程绘图频率不一致,效果才明显。

Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Public Declare Sub EnterCriticalSection Lib "kernel32" (lpCriticalSection As CRITICAL_SECTION) '进入临界区

Public Declare Sub LeaveCriticalSection Lib "kernel32" (lpCriticalSection As CRITICAL_SECTION) '离开临界区

'几个重要的函数举例

'ObjPtr:返回对象实例私有域的地址。

'StrPtr:返回字符串第一个字的地址。

'VarPtr:返回变量的地址。

'全局的form的句柄!

Public formhandle As Long

'临界数据结构

Public sect As CRITICAL_SECTION

Sub OutText1() '过程一

Dim i As Long

Dim dc As Long

Dim s As String

dc = GetDC(formhandle) '获取窗体句柄的DC

For i = 1 To 100000

s = CStr(i)

Call SetBkColor(dc, &HF0F0F0) '设置绘制区域的背景色,也起清除作用

Call TextOut(dc, 10, 10, s, Len(s)) '输出文本!

Call Sleep(40) '等待

Next

Call ReleaseDC(formhandle, dc) '释放资源!

' Call EnterCriticalSection(sect)

' 上下表示该处为临界区,如果要对工程全局变量做操作,最好在该区域内

' 否则线程同步过程中,非常容易让程序崩溃

' Call LeaveCriticalSection(sect)

End Sub

Sub OutText2() '和过程一类似

Dim i As Long

Dim dc As Long

Dim s As String

dc = GetDC(formhandle)

For i = 1 To 100000

s = CStr(i)

Call SetBkColor(dc, &HF0F0F0)

Call TextOut(dc, 10, 80, s, Len(s)) '文本位置改变了

Call Sleep(20) '延时改变了

Next

Call ReleaseDC(formhandle, dc)

' Call EnterCriticalSection(sect)

' Call LeaveCriticalSection(sect)

End Sub

'关于为何使用gdi 函数输出文本,这是一个很重要的内容;

'程序在记数时用了难用的TextOut 函数,而没有使用标签控件,这是因为

'vb的组件不都是线程安全的,当多线程访问不是线程安全的组件,那么会

'产生严重错误。

'mailto:chinasf@Hotmail.com

'作者:萧寒(410000)

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
2023年上半年GDP全球前十五强
 百态   2023-10-24
美众议院议长启动对拜登的弹劾调查
 百态   2023-09-13
上海、济南、武汉等多地出现不明坠落物
 探索   2023-09-06
印度或要将国名改为“巴拉特”
 百态   2023-09-06
男子为女友送行,买票不登机被捕
 百态   2023-08-20
手机地震预警功能怎么开?
 干货   2023-08-06
女子4年卖2套房花700多万做美容:不但没变美脸,面部还出现变形
 百态   2023-08-04
住户一楼被水淹 还冲来8头猪
 百态   2023-07-31
女子体内爬出大量瓜子状活虫
 百态   2023-07-25
地球连续35年收到神秘规律性信号,网友:不要回答!
 探索   2023-07-21
全球镓价格本周大涨27%
 探索   2023-07-09
钱都流向了那些不缺钱的人,苦都留给了能吃苦的人
 探索   2023-07-02
倩女手游刀客魅者强控制(强混乱强眩晕强睡眠)和对应控制抗性的关系
 百态   2020-08-20
美国5月9日最新疫情:美国确诊人数突破131万
 百态   2020-05-09
荷兰政府宣布将集体辞职
 干货   2020-04-30
倩女幽魂手游师徒任务情义春秋猜成语答案逍遥观:鹏程万里
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案神机营:射石饮羽
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案昆仑山:拔刀相助
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案天工阁:鬼斧神工
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案丝路古道:单枪匹马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:与虎谋皮
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:李代桃僵
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:指鹿为马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:小鸟依人
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:千金买邻
 干货   2019-11-12
 
推荐阅读
 
 
 
>>返回首頁<<
 
靜靜地坐在廢墟上,四周的荒凉一望無際,忽然覺得,淒涼也很美
© 2005- 王朝網路 版權所有