一个窗体 两个按钮 Private Sub Command1_Click() Dim i As Long Do i = i + 1 Command1.Caption = i DoEvents Loop Until False
End SubPrivate Sub Command2_Click() Dim i As Long Do i = i + 1 Command2.Caption = i DoEvents Loop Until False End Sub 先按第一个,再按第二,第一个循环停止了
哈哈,特性啊特性。想同时运行确实可以用多线程,不过可以参考一下我下面的代码,也不是不可以解决的,标准的交替处理哦,就象CPU干活一样。 楼主问为什么一个开始了另一个就停了,其实呢,你可以把一个单线程程序(VB那种就是了,一个程序默认只有一个线程)看成一个人,某一时刻他只能在水里洗澡或者是在岸上晒太阳。就象我们的CPU,某一时刻它只能处理一个应用程序的请求,也就是所谓把CPU时间分配给某程序,而多个程序同时运行是怎么回事呢,是交替运行。 其实啊,说多了都麻烦,就一个坐便,能两个人同时坐麻!测试代码请向窗体里添加一个COMMAND1 Option Explicit Dim mBoolean As Boolean Dim i As Long, j As LongPrivate Sub Command1_Click() Do While i < 100 mBoolean = Not mBoolean If mBoolean Then Command2_Click i = i + 1 Print "cmd1do", i DoEvents Loop End Sub Private Sub Command2_Click() Do While j < 100 DoEvents mBoolean = Not mBoolean If mBoolean Then Command1_Click j = j + 1 Print "cmd2do", j Loop End Sub 嘎嘎。我只是演示一下,两个循环怎么“一起”运行的,但是实际上啊,是个假象啦。如果做程序还是别这样,用多线程比较好,就是把操作写到函数里,用启动线程API来运行就好了。
给一段代码:(多线程),测试时点一下窗体 '以下在模块 Option Explicit'该API与浏览器中略有不同,是用来启动线程的Public Declare Function CreateThread Lib "kernel32" (lpThreadAttributes As Any, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, lpParameter As Any, ByVal dwCreationFlags As Long, lpThreadID As Long) As Long'参数一,lpThreadAttributes 线程安全属性,传递为null '参数二,dwStackSize ,线程堆栈大小,可以为0,表示堆栈和此应用堆栈相同 '参数三,lpStartAddress ,执行函数地址,用addressof 获取 '参数四,lpParameter ,执行函数的参数地址,可以是一个记录或者是别的类型,用varptr获取参数地址(varptr为未公开函数)!!'参数五,dwCreationFlags ,表示线程创建后的状态!,0表示立即运行,create_suspended表示线程挂起 '参数六,lpThreadID 表示分配给线程的线程号'以下只是演示效果用API Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)Function do1() Dim i As Long Dim dc As Long Dim s As Stringdc = GetDC(Form1.hwnd) '获取窗体句柄的dc Call TextOut(dc, 0, 10, "1", 1) '输出文本 For i = 1 To 100 s = CStr(i) Call SetBkColor(dc, &HF0F0F0) '清除区域 Call TextOut(dc, 10, 10, s, Len(s)) '输出文本 Call Sleep(20) '等待 Next Call ReleaseDC(Form1.hwnd, dc) '释放DC资源 End FunctionFunction do2() Dim i As Long Dim dc As Long Dim s As Stringdc = GetDC(Form1.hwnd) '获取窗体句柄的dc Call TextOut(dc, 0, 40, "2", 1) '输出文本 For i = 1 To 100 s = CStr(i) Call SetBkColor(dc, &HF0F0F0) '清除区域 Call TextOut(dc, 10, 40, s, Len(s)) '输出文本 Call Sleep(40) '等待 Next Call ReleaseDC(Form1.hwnd, dc) '释放DC资源 End FunctionFunction do3() Dim i As Long Dim dc As Long Dim s As Stringdc = GetDC(Form1.hwnd) '获取窗体句柄的dc Call TextOut(dc, 0, 70, "3", 1) '输出文本 For i = 1 To 100 s = CStr(i) Call SetBkColor(dc, &HF0F0F0) '清除区域 Call TextOut(dc, 10, 70, s, Len(s)) '输出文本 Call Sleep(30) '等待 Next Call ReleaseDC(Form1.hwnd, dc) '释放DC资源 End Function '以下在窗体 Private Sub Form_Click() '以下启动了2个线程 Dim threadid1 As Long Dim threadid2 As Long Call CreateThread(Null, ByVal 0&, AddressOf do1, VarPtr(0), ByVal 0&, threadid1) Call CreateThread(Null, ByVal 0&, AddressOf do2, VarPtr(0), ByVal 0&, threadid2) '下面这个运行于主线程 do1 End Sub
为什么VB中只允许一个Do Loop循环正在运行?
Private Sub Command1_Click()
Dim i As Long
Do
i = i + 1
Command1.Caption = i
DoEvents
Loop Until False
End SubPrivate Sub Command2_Click()
Dim i As Long
Do
i = i + 1
Command2.Caption = i
DoEvents
Loop Until False
End Sub
先按第一个,再按第二,第一个循环停止了
楼主问为什么一个开始了另一个就停了,其实呢,你可以把一个单线程程序(VB那种就是了,一个程序默认只有一个线程)看成一个人,某一时刻他只能在水里洗澡或者是在岸上晒太阳。就象我们的CPU,某一时刻它只能处理一个应用程序的请求,也就是所谓把CPU时间分配给某程序,而多个程序同时运行是怎么回事呢,是交替运行。
其实啊,说多了都麻烦,就一个坐便,能两个人同时坐麻!测试代码请向窗体里添加一个COMMAND1
Option Explicit
Dim mBoolean As Boolean
Dim i As Long, j As LongPrivate Sub Command1_Click()
Do While i < 100
mBoolean = Not mBoolean
If mBoolean Then Command2_Click
i = i + 1
Print "cmd1do", i
DoEvents
Loop
End Sub
Private Sub Command2_Click()
Do While j < 100
DoEvents
mBoolean = Not mBoolean
If mBoolean Then Command1_Click
j = j + 1
Print "cmd2do", j
Loop
End Sub
嘎嘎。我只是演示一下,两个循环怎么“一起”运行的,但是实际上啊,是个假象啦。如果做程序还是别这样,用多线程比较好,就是把操作写到函数里,用启动线程API来运行就好了。
'以下在模块
Option Explicit'该API与浏览器中略有不同,是用来启动线程的Public Declare Function CreateThread Lib "kernel32" (lpThreadAttributes As Any, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, lpParameter As Any, ByVal dwCreationFlags As Long, lpThreadID As Long) As Long'参数一,lpThreadAttributes 线程安全属性,传递为null
'参数二,dwStackSize ,线程堆栈大小,可以为0,表示堆栈和此应用堆栈相同
'参数三,lpStartAddress ,执行函数地址,用addressof 获取
'参数四,lpParameter ,执行函数的参数地址,可以是一个记录或者是别的类型,用varptr获取参数地址(varptr为未公开函数)!!'参数五,dwCreationFlags ,表示线程创建后的状态!,0表示立即运行,create_suspended表示线程挂起
'参数六,lpThreadID 表示分配给线程的线程号'以下只是演示效果用API
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)Function do1()
Dim i As Long
Dim dc As Long
Dim s As Stringdc = GetDC(Form1.hwnd) '获取窗体句柄的dc
Call TextOut(dc, 0, 10, "1", 1) '输出文本
For i = 1 To 100
s = CStr(i)
Call SetBkColor(dc, &HF0F0F0) '清除区域
Call TextOut(dc, 10, 10, s, Len(s)) '输出文本
Call Sleep(20) '等待
Next
Call ReleaseDC(Form1.hwnd, dc) '释放DC资源
End FunctionFunction do2()
Dim i As Long
Dim dc As Long
Dim s As Stringdc = GetDC(Form1.hwnd) '获取窗体句柄的dc
Call TextOut(dc, 0, 40, "2", 1) '输出文本
For i = 1 To 100
s = CStr(i)
Call SetBkColor(dc, &HF0F0F0) '清除区域
Call TextOut(dc, 10, 40, s, Len(s)) '输出文本
Call Sleep(40) '等待
Next
Call ReleaseDC(Form1.hwnd, dc) '释放DC资源
End FunctionFunction do3()
Dim i As Long
Dim dc As Long
Dim s As Stringdc = GetDC(Form1.hwnd) '获取窗体句柄的dc
Call TextOut(dc, 0, 70, "3", 1) '输出文本
For i = 1 To 100
s = CStr(i)
Call SetBkColor(dc, &HF0F0F0) '清除区域
Call TextOut(dc, 10, 70, s, Len(s)) '输出文本
Call Sleep(30) '等待
Next
Call ReleaseDC(Form1.hwnd, dc) '释放DC资源
End Function
'以下在窗体
Private Sub Form_Click()
'以下启动了2个线程
Dim threadid1 As Long
Dim threadid2 As Long
Call CreateThread(Null, ByVal 0&, AddressOf do1, VarPtr(0), ByVal 0&, threadid1)
Call CreateThread(Null, ByVal 0&, AddressOf do2, VarPtr(0), ByVal 0&, threadid2)
'下面这个运行于主线程
do1
End Sub
不过如果很多循环都这么做的话,每一个循环都很慢。
我的,不释放系统,才知道这个线程挂起(SPEED挂的),那个还在运行。闹了,穿那么多裤衩还骗人