文章探索:   分类:    关键字:  
  + 栏目导航
  + 相关文章
文本框中光标位置的获得
用VB导入导出你的IE收藏夹
VB应用程序访问SQL Server方法探讨
VB访问SQL Server数据库技术全揭密
自动上网抓数据的机器人
自己的IE——用VB制作浏览器
VB中如何保存Webbrowser中的整个页面..
在VB中该如何控制其它程序的弹出窗口..
保存webbrowser中的HTML内容
破译动网验证码的简单方法
轻松获取QQ密码
VB.NET获取硬盘序列号的方法
WEBBROWSER 技巧一(收藏)
VB自动登陆网络站点详解(二):Inet..
获取webbrowser控件网页的源码
WebBrowser控件说明
关于用VB做更漂亮的窗体的思考
VB中访问存储过程的几种办法
VB6中改变屏幕的分辨率和刷新频率
VB编写一个能显示百分比的自定义进度..
公农历转换VB类
VB.NET窗口渐淡关闭
使用VB实现邮箱自动注册(二):修改..
VB.NET轻松实现任务栏程序
VB.NET启动外部程序
利用vb实现图片上传
VB实现局域网内的文件传输
VB 一个Function传回多个值
在VB中实现多线程
VB 手机号码编码程序


技术教程 -> VB教程 ->  
在VB中实现多线程
来源:转载   人气:1579   录入时间:2007-11-8
     ''功能:创建多线程类,用于初始化线程。 类名:cls_Thread
   
   ''参数:LongPointFunction 用于接收主调过程传递过来的函数地址值
   
   ''调用方法:1.声明线程类对象变量 Dim mythread as cls_Thread
   
   '' 2.调用形式:With mythread
   
   '' .Initialize AddressOf 自定义过程或函数名 ''(初始化线程) .
   
   '' .ThreadEnabled = True ''(设置线程是否激活)
   
   '' End With
   
   '' 3.终止调用: Set mythread = Nothing
   
   '' Email:lixun007@163.net
   
   '' Test On: VB6.0+Win2000 AND VB6.0+WinXP It''s Pass !
   
   
   
   Option Explicit
   
   ''创建线程API
   
   ''此API经过改造,lpThreadAttributes改为Any型,lpStartAddress改为传值引用:
   
   ''因为函数的入口地址由形参变量传递,如果用传址那将传递形参变量的地址而不是函数的入口地址
   
   Private Declare Function CreateThread Lib "kernel32" (ByVal lpThreadAttributes As Any, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, lpParameter As Any, ByVal dwCreationFlags As Long, LpthreadId As Long) As Long
   
   ''终止线程API
   
   Private Declare Function TerminateThread Lib "kernel32" (ByVal hThread As Long, ByVal dwExitCode As Long) As Long
   
   ''激活线程API
   
   Private Declare Function ResumeThread Lib "kernel32" (ByVal hThread As Long) As Long
   
   ''挂起线程API
   
   Private Declare Function SuspendThread Lib "kernel32" (ByVal hThread As Long) As Long
   
   
   
   Private Const CREATE_SUSPENDED = &H4 ''线程挂起常量
   
   
   
   ''自定义线程结构类型
   
   Private Type udtThread
   
   Handle As Long
   
   Enabled As Boolean
   
   End Type
   
   
   
   Private meTheard As udtThread
   
   ''初始化线程
   
   Public Sub Initialize(ByVal LongPointFunction As Long)
   
   Dim LongStackSize As Long, LongCreationFlags As Long, LpthreadId As Long, LongNull As Long
   
   On Error Resume Next
   
   LongNull = 0
   
   LongStackSize = 0
   
   LongCreationFlags = CREATE_SUSPENDED ''创建线程后先挂起,由程序激活线程
   
   
   
   ''创建线程并返线程句柄
   
   meTheard.Handle = CreateThread(LongNull, LongStackSize, ByVal LongPointFunction, LongNull, LongCreationFlags, LpthreadId)
   
   
   
   If meTheard.Handle = LongNull Then
   
   MsgBox "线程创建失败!", 48, "错误"
   
   End If
   
   End Sub
   
   
   
   ''获取线程是否激活属性
   
   Public Property Get ThreadEnabled() As Boolean
   
   On Error Resume Next
   
   Enabled = meTheard.Enabled
   
   End Property
   
   
   
   ''设置线程是否激活属性
   
   Public Property Let ThreadEnabled(ByVal Newvalue As Boolean)
   
   On Error Resume Next
   
   ''若激活线程(Newvalue为真)设为TRUE且此线程原来没有激活时激活此线程
   
   If Newvalue And (Not meTheard.Enabled) Then
   
   ResumeThread meTheard.Handle
   
   meTheard.Enabled = True
   
   Else ''若激活线程(Newvalue为真)且此线程原来已激活则挂起此线程
   
   If meTheard.Enabled Then
   
   SuspendThread meTheard.Handle
   
   meTheard.Enabled = False
   
   End If
   
   End If
   
   End Property
   
   
   
   ''终止线程事件
   
   Private Sub Class_Terminate()
   
   On Error Resume Next
   
   Call TerminateThread(meTheard.Handle, 0)
   
   End Sub
   
   




Copyright(C)2007-2021 广州市佳沛数码科技有限公司 版权所有
公司地址: 广州市荔湾区东漖北路560号511室
电话:020-81803473 传真:020-81544987