有关自写窗口函式处理窗口消息的问题

Question

在有需要处理一些VB窗口事件未提供的窗口消息时,就需要自已写窗口函数并用SetWindowLong&GetWindowLong来替换,虽然可以满足要求但是调试期是很麻烦的,设了断点很容易就当掉整个程式.想请问说VB中有没有什么方法可以不用重写窗口函式的方法来处理一些特殊的窗口消息呢.

Answer 1

建个From,消息控件都是自建。

Answer 2

处理一些特殊的窗口消息？你要处理什么消息？
向修改重写消息处理，必须要用SubClass

Answer 3

求教高手：
我的RichTextBox中不同的行高度有可能都不同，而且也有些图片，行间距也有不同。请问我如果定位到某一行后，如何获取本行的行高呢？？？解决奉献自己全部积分（110分），决不失言！！！http://community.csdn.net/Expert/topic/4447/4447163.xml?temp=.2219965

Answer 4

//想请问说VB中有没有什么方法可以不用重写窗口函式的方法来处理一些特殊的窗口消息呢.那就要处理消息循环了，像下面这样：
窗体上有一个按钮
Option Explicit
Private Const PM_REMOVE = &H1
Private Type POINTAPI
    x As Long
    y As Long
End Type
Private Type Msg
    hWnd As Long
    Message As Long
    wParam As Long
    lParam As Long
    time As Long
    pt As POINTAPI
End Type
Private Const WM_LBUTTONDOWN = &H201Private Declare Function PeekMessage Lib "user32" Alias "PeekMessageA" (lpMsg As Msg, ByVal hWnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long
Private Declare Function WaitMessage Lib "user32" () As Long
Private bCancel As Boolean
Private Sub ProcessMessages()
    Dim Message As Msg
    'loop until bCancel is set to True
    Do While Not bCancel
        'wait for a message
        WaitMessage
        'check if it's a WM_LBUTTONDOWN message
        If PeekMessage(Message, Command1.hWnd, WM_LBUTTONDOWN, WM_LBUTTONDOWN, PM_REMOVE) Then
           MsgBox "haha"
        End If
        'let the operating system process other events
        DoEvents
    Loop
End SubPrivate Sub Form_Load()
    Dim ret As Long
    bCancel = False
    Show
    ProcessMessages
End Sub
Private Sub Form_Unload(Cancel As Integer)
    bCancel = True
End Sub

Answer 5

谢谢暴风雨提供的方法,很好的解决了我所说的问题,可是有一点不明白,我把PeekMessage最后的参数改成PM_NOREMOVE后,VB窗口本身的事件还是不能被触发,比如我Peek Form1的WM_LBUTTONDOWN,用PM_NOREMOVE,又同时处理Form_MouseDown事件,这时发现后者未能被执行,这要怎么处理呢,我不是没有把队列里的消息移除吗

Answer 6

这样，可以检查进程的所有消息，然后进行处理：
Option Explicit
Private Const PM_NOREMOVE = &H0
Private Const PM_NOYIELD = &H2
Private Const PM_REMOVE = &H1Private Type POINTAPI
X As Long
Y As Long
End Type
Private Type Msg
hwnd As Long
Message As Long
wParam As Long
lParam As Long
time As Long
pt As POINTAPI
End Type
Private Const WM_MOUSEMOVE = &H200
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Private Const WM_SETTEXT = &HC
Private Declare Function TranslateMessage Lib "user32" (lpMsg As Msg) As Long
Private Declare Function DispatchMessage Lib "user32" Alias "DispatchMessageA" (lpMsg As Msg) As LongPrivate Declare Function PeekMessage Lib "user32" Alias "PeekMessageA" (lpMsg As Msg, ByVal hwnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long
Private Declare Function WaitMessage Lib "user32" () As Long
Private Declare Function GetMessage Lib "user32" Alias "GetMessageA" (lpMsg As Msg, ByVal hwnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long) As Long
Private bCancel As Boolean
Private Sub ProcessMessages()
    Dim Message As Msg
    'loop until bCancel is set to True
    Do While Not bCancel
        'wait for a message
        WaitMessage
        'check all message
        If PeekMessage(Message, 0, 0, 0, PM_REMOVE) Then
            Select Case Message.hwnd
            Case Me.hwnd
                Select Case Message.Message
                Case WM_LBUTTONDOWN
                    Debug.Print "me Mousedown"
                Case WM_LBUTTONUP
                    Debug.Print "me mouseup"
                Case WM_MOUSEMOVE
                    Debug.Print "x:" + CStr(Message.pt.X) + " y:" + CStr(Message.pt.Y)
                Case Else
                    TranslateMessage Message
                    DispatchMessage Message
                End Select
            Case Else
                TranslateMessage Message
                DispatchMessage Message
            End Select
        End If
        'let the operating system process other events
        DoEvents
    Loop
End SubPrivate Sub Form_Load()
Dim ret As Long
bCancel = False
Show
ProcessMessages
End Sub
Private Sub Form_Unload(Cancel As Integer)
bCancel = True
End Sub