临海永丰镇书记是谁:用vb6可不可以设计多线程序的应用程序，如何实现

VB6天生在这方面是欠缺的,只有通过不断调用系统API来实现部分的线程控制,或者调用其他语言编写的多线程组件来实现多线程的应用程序,其实很多多线程的程序如果需要用VB6来实现你完全可以使用单进程单线程来模拟

源代码如下：

窗体中的代码：

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

多线程是可以啊，只是不太安全，容易非法操作，
源代码如下：

窗体中的代码：

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