求救！ 消息循环的困惑！

Question

为了在变量值被修改时刷新数据，所以在主窗体中用API加入了消息循环，可是加入之后源程序不能运行，在VB6.0环境下，直接退出程序，并关闭VB6，而不加入消息循环程序运行正常。请教各位，这是什么原因？如何解决？具体代码如下：声明部分：
   public Declare Function SetWindowLong Lib "user32" Alias _
                "SetWindowLongW" (ByVal hwnd As Long, _
                ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
   Public Declare Function GetWindowLong Lib "user32" Alias _
                "GetWindowLongW" (ByVal hwnd As Long, _
                ByVal nIndex As Long) As Long
   Public Declare Function CallWindowProc Lib "user32" Alias _
                "CallWindowProcW" (ByVal lpPrevWndFunc As Long, _
                ByVal hwnd As Long, ByVal Msg As Long, _
                ByVal wParam As Long, ByVal lParam As Long) As Long
                
   Public Declare Function PostMessage Lib "user32" Alias _
                "PostMessageW" (ByVal hwnd As Long, _
                ByVal wMsg As Long, ByVal wParam As Long, _
                ByVal lParam As Long) As Long
   Public Declare Function SendMessage Lib "user32" Alias _
                "SendMessageW" (ByVal hwnd As Long, _
                ByVal wMsg As Long, ByVal wParam As Long, _
                lParam As Any) As Long在主窗体的Form_Load()函数中加入：
    '记录原来的Window Procedure的位址
    'preWinProc = GetWindowLong(mainWindow.hwnd, GWL_WNDPROC)
    '设定form的window Procedure到wndproc
    'Dim ret
    'ret = SetWindowLong(mainWindow.hwnd, GWL_WNDPROC, AddressOf wndproc)
其中wndproc是我声明的一个消息处理函数，如下：
    Public Function wndproc(ByVal hwnd As Long, ByVal Msg As Long,  ByVal wParam As Long, ByVal lParam As Long) As Long
    On Error Resume Next
    Dim i, j As Integer
    Dim cnt As Integer
    For cnt = 0 To mainWindow.subpic.count - 1
        If mainWindow.subpic(cnt).Checked Then Exit For
    Next
    Select Case Msg
        Case WM_LINE
            DoEvents
            Call Draw(cnt + 1, wParam)
        Case WM_ROUND
            DoEvents
            Call Draw(cnt + 1, wParam)
        Case WM_ROUNDARC
            DoEvents
            Call Draw(cnt + 1, wParam)
        Case WM_ROUNDRECTANGLE
            DoEvents
            Call Draw(cnt + 1, wParam)
        Case WM_ELLIPSE
            DoEvents
            Draw cnt + 1, wParam
        Case WM_ELLIPSEARC
            DoEvents
            Call Draw(cnt + 1, wParam)
        Case WM_LIELLIPSE
            DoEvents
            Call Draw(cnt + 1, wParam)
        Case WM_CURVE
            DoEvents
            Call Draw(cnt + 1, wParam)
        Case WM_POLYGON
            DoEvents
            Call Draw(cnt + 1, wParam)
        Case WM_POLYBEZIER
            DoEvents
            Call Draw(cnt + 1, wParam)
        Case WM_RECTANGLE
            DoEvents
            Call Draw(cnt + 1, wParam)
        Case WM_TEXT
            DoEvents
            Call Draw(cnt + 1, wParam)
        Case WM_BMP
            DoEvents
            Call Draw(cnt + 1, wParam)
        Case WM_LED
            DoEvents
            Call Draw(cnt + 1, wParam)
        '2003.6.13
        '重新起动在程序运行期间周期运行的脚本
        Case WM_PROGRAMSCRIPTSTOPED
            DoEvents
            If ProgramStatu.Running Then
                ProgramStatu.ScriptStoped = False
                mainWindow.ScriptControl1.Run "System_RunningProgram"
            End If
        '启动在窗体运行期间周期运行的脚本
        Case WM_FORMSCRIPTSTOPED
            DoEvents
            If ProgramStatu.Running Then
                FormStatu.ScriptStoped = False
                mainWindow.ScriptControl1.Run "System_RunningForm"
            End If
        '2003.6.13
        Case Else
            '将之送往原来的Window Procedure
            wndproc = CallWindowProc(preWinProc, hwnd, Msg, wParam, lParam)
            
    End Select
    
End Function
     
在主窗体的Form_Unload()中使用：
        SetWindowLong(Me.hwnd, GWL_WNDPROC, preWinProc)

Answer 1

处理完消息之后要给Windows返回一个值,表明你已处理过
wndProc = ?

Answer 2

问题好像不是这里，我添加了wndpro=1 但问题没有解决

Answer 3

问题出在你的wndproc中
因为很多你自定义的东西我们也不知道所以也不好判断
WM_LINE
之类的东西是你定义的吗,应该就是他们的问题,你他它屏蔽掉运行就正常了

Answer 4

Windows系统的用户自定义消息的常量值
Public Const WM_USER = &H400'定义图形刷新消息（以用户自定义消息为基础）
Public Const WM_LINE = WM_USER + 100
Public Const WM_ROUND = WM_USER + 101
Public Const WM_ROUNDARC = WM_USER + 102
Public Const WM_ROUNDRECTANGLE = WM_USER + 103
Public Const WM_ELLIPSE = WM_USER + 104
Public Const WM_ELLIPSEARC = WM_USER + 105
Public Const WM_LIELLIPSE = WM_USER + 106
Public Const WM_CURVE = WM_USER + 107
Public Const WM_POLYGON = WM_USER + 108
Public Const WM_POLYBEZIER = WM_USER + 109
Public Const WM_RECTANGLE = WM_USER + 110
Public Const WM_TEXT = WM_USER + 111
Public Const WM_BMP = WM_USER + 112
Public Const WM_LED = WM_USER + 113

Answer 5

Draw函数是怎么写的，cnt + 1如果是作为mainWindow.subpic的下标传递的，好像已经超出mainWindow.subpic数组的范围了

Answer 6

Draw 是由VC编写的绘图控件的绘图函数，他的工作过程是取得主窗体的设备上下文，并在其上绘图

Answer 7

在的窗体过程设置断点，看是不是运行到Draw过程出错，估计是Draw函数引起的。在VB中引起VB都异常退出，大部分情况都是不恰当的调用外部的函数或外部函数执行错误引起的

Answer 8

不是Draw的问题，我已经把Draw屏蔽掉了，不行.
再有，在VB下，假如消息处理函数之后，不能进入调试状态

Answer 9

在窗口函数里，你敢用DoEvents。服了你了。

Answer 10

屏蔽掉了DoEvents，可是还不行

Answer 11

你保存的窗口地址不对啊!!!
改为:
  preWinProc = SetWindowLong(mainWindow.hwnd, GWL_WNDPROC, AddressOf wndproc)

Answer 12

x8bits(舍得)：我按照你说明的改了，可是程序还是被强行退出 ，我要急死了 ：（

Answer 13

这些代码在我的机器上可运行,你试看能否帮你找到问题
'**************************
'* Put these code in module
'**************************
Option Explicit   Public Declare Function SetWindowLong Lib "user32" Alias _
                "SetWindowLongW" (ByVal hwnd As Long, _
                ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
   Public Declare Function GetWindowLong Lib "user32" Alias _
                "GetWindowLongW" (ByVal hwnd As Long, _
                ByVal nIndex As Long) As Long
   Public Declare Function CallWindowProc Lib "user32" Alias _
                "CallWindowProcW" (ByVal lpPrevWndFunc As Long, _
                ByVal hwnd As Long, ByVal Msg As Long, _
                ByVal wParam As Long, ByVal lParam As Long) As Long
                
   Public Declare Function PostMessage Lib "user32" Alias _
                "PostMessageW" (ByVal hwnd As Long, _
                ByVal wMsg As Long, ByVal wParam As Long, _
                ByVal lParam As Long) As Long
   Public Declare Function SendMessage Lib "user32" Alias _
                "SendMessageW" (ByVal hwnd As Long, _
                ByVal wMsg As Long, ByVal wParam As Long, _
                lParam As Any) As Long
Public preWinProc As LongPublic Const GWL_WNDPROC As Long = -4'Windows系统的用户自定义消息的常量值
Public Const WM_USER = &H400'定义图形刷新消息（以用户自定义消息为基础）
Public Const WM_LINE = WM_USER + 100
Public Const WM_ROUND = WM_USER + 101
Public Const WM_ROUNDARC = WM_USER + 102
Public Const WM_ROUNDRECTANGLE = WM_USER + 103
Public Const WM_ELLIPSE = WM_USER + 104
Public Const WM_ELLIPSEARC = WM_USER + 105
Public Const WM_LIELLIPSE = WM_USER + 106
Public Const WM_CURVE = WM_USER + 107
Public Const WM_POLYGON = WM_USER + 108
Public Const WM_POLYBEZIER = WM_USER + 109
Public Const WM_RECTANGLE = WM_USER + 110
Public Const WM_TEXT = WM_USER + 111
Public Const WM_BMP = WM_USER + 112
Public Const WM_LED = WM_USER + 113'其中wndproc是我声明的一个消息处理函数，如下：
    Public Function wndproc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    On Error Resume Next
    Dim i, j As Integer
    Dim cnt As Integer
'    For cnt = 0 To mainWindow.subpic.Count - 1
'        If mainWindow.subpic(cnt).Checked Then Exit For
'    Next
    Debug.Print "Msg = " & Hex(Msg)
    Select Case Msg
        Case WM_LINE
            DoEvents
            Call Draw(cnt + 1, wParam)
        Case WM_ROUND
            'DoEvents
            Call Draw(cnt + 1, wParam)
        Case WM_ROUNDARC
            'DoEvents
            Call Draw(cnt + 1, wParam)
        Case WM_ROUNDRECTANGLE
            'DoEvents
            Call Draw(cnt + 1, wParam)
        Case WM_ELLIPSE
            'DoEvents
            Draw cnt + 1, wParam
        Case WM_ELLIPSEARC
            'DoEvents
            Call Draw(cnt + 1, wParam)
        Case WM_LIELLIPSE
            'DoEvents
            Call Draw(cnt + 1, wParam)
        Case WM_CURVE
            'DoEvents
            Call Draw(cnt + 1, wParam)
        Case WM_POLYGON
            'DoEvents
            Call Draw(cnt + 1, wParam)
        Case WM_POLYBEZIER
            'DoEvents
            Call Draw(cnt + 1, wParam)
        Case WM_RECTANGLE
            'DoEvents
            Call Draw(cnt + 1, wParam)
        Case WM_TEXT
            'DoEvents
            Call Draw(cnt + 1, wParam)
        Case WM_BMP
            'DoEvents
            Call Draw(cnt + 1, wParam)
        Case WM_LED
            'DoEvents
            Call Draw(cnt + 1, wParam)
        '2003.6.13
        '重新起动在程序运行期间周期运行的脚本
'        Case WM_PROGRAMSCRIPTSTOPED
'            'DoEvents
'            If ProgramStatu.Running Then
'                ProgramStatu.ScriptStoped = False
'                mainWindow.ScriptControl1.Run "System_RunningProgram"
'            End If
'        '启动在窗体运行期间周期运行的脚本
'        Case WM_FORMSCRIPTSTOPED
'            'DoEvents
'            If ProgramStatu.Running Then
'                FormStatu.ScriptStoped = False
'                mainWindow.ScriptControl1.Run "System_RunningForm"
'            End If
        '2003.6.13
        Case Else
            '将之送往原来的Window Procedure
            wndproc = CallWindowProc(preWinProc, hwnd, Msg, wParam, lParam)
            
    End Select
'    wndproc = 0
End FunctionPublic Sub Draw(ByVal lParam As Long, ByVal wParam As Long)
  Debug.Print "lParam = " & Hex(lParam), "wParam = " & Hex(wParam)
End Sub
'******************************
'* Put this code in mainWindow
'******************************
Option Explicit
'在主窗体的Form_Unload()中使用：'在主窗体的Form_Load()函数中加入：Private Sub Form_Load()
    '记录原来的Window Procedure的位址
    'preWinProc = GetWindowLong(mainWindow.hwnd, GWL_WNDPROC)
    '设定form的window Procedure到wndproc
    'Dim ret
    preWinProc = SetWindowLong(mainWindow.hwnd, GWL_WNDPROC, AddressOf wndproc)End SubPrivate Sub Form_Unload(Cancel As Integer)
      Call SetWindowLong(Me.hwnd, GWL_WNDPROC, preWinProc)
End Sub

Answer 14

DoEvents可能导致函数重入，堆栈溢出。