Easy
助理工程师
帖子
365
精华
2
无忧币 1770
积分 1609
阅读权限 40
|
发表于:2007-11-9 14:35
标题：用vb创建多线程程序
＜上一帖 |
下一帖＞
问题背景：
有时候我们做程序时有这样的需求：有一个需要运行时间很长的循环，那么程序只有等待循环运行结束后才执行别的程序代码，这样机器一直处于循环之中，而不能响应别的事情，对cpu资源来说是一种浪费，那么可不可以既让循环执行，又可以执行程序另外的一部分代码呢？答案是可以的，那就要用到多线程了。
相关知识：
进程：是指程序在一个数据集合上运行的过程，是操作系统进行资源分配和调度运行的一个独立单位，简单来说进程就是程序的一次执行。
进程的两个基本属性：
1.进程是一个可拥有资源的独立单位；
2. 进程同时又是一个可以独立调度和分配的基本单位。
操作系统中引入进程的目的是为了使多个程序并发执行，以改善资源利用率及提高系统的吞吐量。
线程：线是进程中的一个实体，是被系统独立调度和分配的基本单位。线程自己基本上不拥有系统资源，只拥有一些在运行中必不可少的资源，但它可与同属一个进程的其他线程共享进程所拥有的全部资源。同一个进程中的多个线程之间可以并发执行。
问题实现：
vb可不可以创建多线程呢？答案：vb本身不可以，但用api函数vb可以实现。
在vb中创建线程用到以下几个api函数：
'创建线程api
'此api经过改造，lpthreadattributes改为any型，lpstartaddress改为传值引用：
'因为函数入口地址是由形参变量传递，如果用传址那将传递形参变量的地址而不是函数的入口地址
' 参数dwstacksize为应用程序堆栈大小，lpstartaddress为函数入口地址
** 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
** declare function terminatethread lib "kernel32" (byval hthread as long, byval dwexitcode as long) as long
'激活线程api,参数hthread为createthread创建的线程句柄
** declare function resumethread lib "kernel32" (byval hthread as long) as long
'挂起线程api
** declare function suspendthread lib "kernel32" (byval hthread as long) as long
了解完上面的api函数后请看下面的实例：
实例效果：此实例实现三个图片框的背景色一起变色。
实例的窗体布局见图：
程序的工程窗口：
源代码如下
窗体中的代码：
option explicit
'开始
** sub command1_click()
on error resume next
with mythreadleft
.initialize addressof fillleft '传递过程地址给线程
.threadenabled = true
end with
with mythreadright
.initialize addressof fillright
.threadenabled = true
end with
with mythreadbottom
.initialize addressof fillbottom
.threadenabled = true
end with
msgbox "多线程正在运行...，看看图片框控件的变色效果！", 64, "信息"
'终止线程运行
set mythreadleft = nothing
set mythreadright = nothing
set mythreadbottom = nothing
end sub
'结束
** sub command2_click()
unload me
end sub
模块中的代码：
option explicit
'时间计数api
** declare function gettickcount lib "kernel32" () as long
'声明cls_thread类的对象变量
public mythreadleft as new cls_thread, mythreadright as new cls_thread, mythreadbottom as new cls_thread
sub main()
load form1
form1.show
end sub
public sub fillleft()
static bkgcolor as long
dim longtick as long, longcounter as long
on error resume next
for longcounter = 0 to 3000
doevents
bkgcolor = longcounter mod 256
form1.picture1.backcolor = rgb(bkgcolor, 0, 0)
longtick = gettickcount
while gettickcount - longtick
public sub fillright()
static bkgcolor as long
dim longtickvalue as long, longcounter as long
on error resume next
for longcounter = 0 to 3000
doevents
bkgcolor = longcounter mod 256
form1.picture2.backcolor = rgb(0, bkgcolor, 0)
longtickvalue = gettickcount
while gettickcount - longtickvalue
public sub fillbottom()
static bkgcolor as long
dim longtick as long, longcounter as long
on error resume next
for longcounter = 0 to 3000
doevents
bkgcolor = longcounter mod 256
form1.picture3.backcolor = rgb(0, 0, bkgcolor)
longtick = gettickcount
while gettickcount - longtick
类模块中的代码：
'功能：创建多线程类，用于初始化线程。 类名：cls_thread
'参数：longpointfunction 用于接收主调过程传递过来的函数地址值
'调用方法：1.声明线程类对象变量 dim mythread as cls_thread
' 2.调用形式：with mythread
' .initialize addressof 自定义过程或函数名 '(初始化线程) .
' .threadenabled = true '(设置线程是否激活)
' end with
' 3.终止调用： set mythread = nothing
' crate by : 陈宇 on 2004.5.10 copyright(c).ldt by cy-soft 2001--2004
' email:4y4ycoco@163.com
' test on： vb6.0+win98 and vb6.0+winxp it's pass ！
option explicit
'创建线程api
'此api经过改造，lpthreadattributes改为any型，lpstartaddress改为传值引用：
'因为函数的入口地址由形参变量传递，如果用传址那将传递形参变量的地址而不是函数的入口地址
** 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
** declare function terminatethread lib "kernel32" (byval hthread as long, byval dwexitcode as long) as long
'激活线程api
** declare function resumethread lib "kernel32" (byval hthread as long) as long
'挂起线程api
** declare function suspendthread lib "kernel32" (byval hthread as long) as long
** const create_suspended = &h4 '线程挂起常量
'自定义线程结构类型
** type udtthread
handle as long
enabled as boolean
end type
** 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
'终止线程事件
** sub class_terminate()
on error resume next
call terminatethread(metheard.handle, 0)
end sub
总结：
本程序的缺点是程序运行时cpu占用率高。
至此全部源代码结束，在实例的基础上可以根据个人需要做出不同的多线程应用程序，可以用此类模块创建activex dll，然后引用这个dll来进行调用
|
网络工程师到底该不该去考CCIE认证？ |
|
| 诚征版主 | 版主堂 | 意见建议 | 大史记 | 论坛地图