VB创建多线程

    xiaoxiao2021-12-14  19

    相关知识:

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

    进程的两个基本属性: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

    源代码如下:

    窗体中的代码:

    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

    转载请注明原文地址: https://ju.6miu.com/read-963069.html

    最新回复(0)