VB多线程序有关问题,定时器

VB多线程序问题,定时器在VB中怎么实现多线程,如我在数据备份这个事件中要让定时器TIMER同时响应,可以实现

VB多线程序问题,定时器
在VB中怎么实现多线程,如我在数据备份这个事件中要让定时器TIMER同时响应,可以实现吗?

[解决办法]
功能:创建多线程类,用于初始化线程。 类名: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 its 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
[解决办法]
不想程序莫名其妙的挂,就别玩多线程.

[解决办法]
关注