用Visual Basic创建多线程应用程序-xxlinux.com




┊linux社区┊ 爱心援助 ┊ Linux认证┊系列教程 ┊ 业界动态┊ 站务新闻 ┊ 公司招聘┊网络学院┊网址大全 ┊LPI专题┊ CISCO专题

设为首页

加入收藏

管理团队

联盟首页	入门区	安装配置	使用技巧	桌面应用	开发区	WEB开发	数据库	内核研究	SHELL	软件开发
软件下载	网络区	服务器	网络应用	网络安全	UNIX区	UNIX入门	UNIX提高	C专题	JAVA专题	嵌入应用
开发语言	PHP	JSP	ASP	ASP.NET	JAVA	C/C++/C#	PERL	JavaScript	Basic	Delphi

		您的位置：首页 > 开发语言 > Basic >

栏目导栏

php

JSP

ASP

asp.net

JAVA

c/c++/c#

perl

JavaScript

Basic

Delphi

资料搜索

最新文章

·Visual Basic 安装程序的制作

·.NET和VB编程创建SQL Server

用Visual Basic创建多线程应用程序

[ 作者: 加入时间:2007-10-19 13:13:59 来自:Linux联盟收集整理 ]

有时候我们做程序时有这样的需求：有一个需要运行时间很长的循环，那么程序只有等待循环运行结束后才执行别的程序代码，这样机器一直处于循环之中，而不能响应别的事情，对CPU资源来说是一种浪费，那么可不可以既让循环执行，又可以执行程序另外的一部分代码呢？答案是可以的，那就要用到多线程了。

相关知识：

　　进程：是指程序在一个数据集合上运行的过程，是操作系统进行资源分配和调度运行的一个独立单位，简单来说进程就是程序的一次执行。

　　进程的两个基本属性：

　　 1.进程是一个可拥有资源的独立单位；

　　 2. 进程同时又是一个可以独立调度和分配的基本单位。

　　操作系统中引入进程的目的是为了使多个程序并发执行，以改善资源利用率及提高系统的吞吐量。

　　线程：线是进程中的一个实体，是被系统独立调度和分配的基本单位。线程自己基本上不拥有系统资源，只拥有一些在运行中必不可少的资源，但它可与同属一个进程的其他线程共享进程所拥有的全部资源。同一个进程中的多个线程之间可以并发执行。

问题实现：

　　 VB可不可以创建多线程呢？答案：VB本身不可以，但用API函数VB可以实现。

　　在VB中创建线程用到以下几个API函数：

'创建线程API

'此API经过改造，lpThreadAttributes改为Any型，lpStartAddress改为传值引用：

'因为函数入口地址是由形参变量传递，如果用传址那将传递形参变量的地址而不是函数的入口地址

' 参数dwStackSize为应用程序堆栈大小，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,参数hThread为CreateThread创建的线程句柄

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

　　了解完上面的API函数后请看下面的实例：

　　实例效果：此实例实现三个图片框的背景色一起变色。

　　实例的窗体布局见图：

　　程序的工程窗口：

源代码如下

　　窗体中的代码：

Option Explicit

'开始

Private 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

'结束

Private Sub Command2_Click()
　 Unload Me
End Sub

模块中的代码：

Option Explicit

'时间计数API

Private 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 < 10 '延时10毫秒,下同
　　 Wend
　 Next
　 Set myThreadleft = Nothing '如果循环结束则终止当前线程运行，下同
End Sub

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 < 10
　　 Wend
　 Next
　 Set myThreadright = Nothing
End Sub

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 < 10
　　 Wend
　 Next
　 Set myThreadright = Nothing
End Sub

类模块中的代码：

'功能：创建多线程类，用于初始化线程。类名：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改为传值引用：

'因为函数的入口地址由形参变量传递，如果用传址那将传递形参变量的地址而不是函数的入口地址

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

　　总结：

　　本程序的缺点是程序运行时CPU占用率高。

　　至此全部源代码结束，在实例的基础上可以根据个人需要做出不同的多线程应用程序，可以用此类模块创建ActiveX DLL，然后引用这个DLL来进行调用。

Linux联盟收集整理 ,转贴请标明原始链接,如有任何疑问欢迎来本站Linux论坛讨论

【评论】【加入收藏夹】【大中小】【打印】【关闭】

※ 相关链接

·Visual Basic 安装程序的制作 (2007-10-29 14:37:01)

·Visual Basic串口通信程序设计 (2007-10-29 14:33:03)

·Visual Basic6.0网络编程的五大散手 (2007-10-19 13:16:05)

·Visual Basic变态用法之函数指针 (2007-10-19 13:12:05)

·Visual Basic COM基础之兼容性 (2007-10-19 13:07:40)

·Visual Basic COM基础之事件 (2007-10-19 13:01:19)

·Visual Basic COM基础之更多属性 (2007-10-19 12:59:38)

·Visual Basic COM基础之属性 (2007-10-19 12:58:54)

·Visual Basic COM基础之类的建立 (2007-10-19 12:58:10)

·Visual Basic COM基础讲座 (2007-10-19 12:57:22)



	© CopyRight 2006-2009 xxlinux.com.Inc All Rights Reserved
	Powered by xxlinux.com