Question

VB6 有什么方法解决:当按住下拉框滑动杠时while语句还能继续执行?

在下编写了一个编程,用while...wend语句控制一些东西,画面中有一个ComboBox(下拉选择控件),问题是当用鼠标左健按住下拉选择控件右边的滑动杠时,while语句就不执行了,要等到按开鼠标左健才继续执行,对这个问题有点头痛,还望知道的大大指点一下，谢谢！！
程序如下（用于实时显示当前时间，只是一个例子）：
Private Sub DoRun()

While 1
DateTimeText.Caption = Format$(Date$, "yyyy-mm-dd") & " " & Format$(Time$, "HH:nn:ss")

DoEvents
Wend

End Sub

以上这个程序：当用鼠标左健按住下拉选择控件右边的滑动杠时,while语句就不执行了（不继续显示当前时间了）,要等到按开鼠标左健才继续执行
对了,我不想用Timer控件(因为Timer控件对于ms级时不准确且执行速度不快)

Answer 1

这段代码在我的机子上运行没有出现 While 不执行的情况
但是如果鼠标按着标题栏上的按钮不放，倒会出现这种情况，如果换成 Timer 也一样。
但我觉得最好还是用 Timer 控件。
>主要是由于循环 + DoEvents 这种模式会浪费大量 CPU 资源。

你说的 Timer控件对于ms级时不准确 可以使用 API 来解决：
Declare Function GetTickCount Lib "kernel32" Alias "GetTickCount" () As Long
其执行结果就是计算机自开机以来以毫秒为单位的时间长度，只与系统有关，与观测者无关。
还有，当 Timer 控件的 Interval 属性为 10 时，其 Timer 事件触发周期为 15.625 毫秒（在我的机子上，如果你要试，在 Timer 控件的 Timer 事件的处理程序中写入：
Static X As Single, I As Long
I = I + 1
If I = 2 Then Cls: I = 0
Print (Timer - X) * 1000; "ms"
X = Timer
然后运行即可
）
如果你使用循环，还需要判断窗体是否已经关闭，否则会出现窗口关闭但程序仍在运行的情况。

Answer 2

不用Timer控件，也可以解决上述问题，具体做法是：
一、把while...wend语句之间的语句单独做成一个过程函数(如sub Test())，以便调用，那么DoRun修改如下：

Private Sub DoRun()

While 1
call test()

DoEvents
Wend

End Sub
二、建立一个模块，复制下面代码：
Option Explicit
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Const GWL_WNDPROC = (-4)
Private lPrevWndProc As Long

Public Sub SubClassForm(ByVal hWnd As Long)
lPrevWndProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf SubClassedForm)
End Sub

Public Sub RemoveSubClassing(ByVal hWnd As Long)
Call SetWindowLong(hWnd, GWL_WNDPROC, lPrevWndProc)
End Sub

Public Function SubClassedForm(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim sItem As String
Dim lBackBrush As Long
Debug.Print hWnd, Msg

If Msg = 308 Then
'在此插入while...wend语句即可或把这些语句单独做成模块进行调用也行
'Form1.Caption = Format$(Date$, "yyyy-mm-dd") & " " & Format$(Time$, "HH:nn:ss")
Call test
End If
SubClassedForm = CallWindowProc(lPrevWndProc, hWnd, Msg, wParam, lParam)
End Function
三、调用方法：
在Private Sub Form_Load()内加入SubClassForm Combo1.hWnd语句
在Private Sub Form_UnLoad()内加入RemoveSubClassing Combo1.hWnd语句
然后运行程序，即可实现你的愿望。

Answer 3

设为后台运行就可以了。