为啥不能发送滚轮消息

2013-01-07

为何不能发送滚轮消息？本帖最后由 penguinhzf 于 2011-09-16 11:32:38 编辑请看以下代码：Private Function

为何不能发送滚轮消息？
本帖最后由 penguinhzf 于 2011-09-16 11:32:38 编辑请看以下代码：

Private Function wndproc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

    Select Case Msg

        Case WM_MOUSEWHEEL '发送滚轮消息
            Dim re As Long
                re = SendMessage(fmHwnd, WM_MOUSEWHEEL, wParam, lParam)
                Debug.Print fmHwnd & "***" & re'理论上re不可能是0的，但经测试，re确实是0，而且fmHwnd是一个外部窗口，已经获取到窗口的HWND，是不是我发送信息的这一代码错误呢？
    End Select

    wndproc = CallWindowProc(preWinProc, hwnd, Msg, wParam, lParam) '将之送往原来的Window Procedure

End Function
[解决办法]

Option Explicit
Private Const WM_MOUSEWHEEL = &H20A
Private Const WM_KEYDOWN = &H100
Private Const WM_KEYUP = &H101
Private Const VK_DOWN = &H28
Private Const VK_UP = &H26
Const VK_MBUTTON = &H4
Private Const WM_VSCROLL = &H115
Private Const SB_LINEDOWN = 1
Private Const SB_LINEUP = 0

Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Sub Form_Load()
    Text1.Text = "djlfjlsdjflsdjflksadjkfjskljfklsdjfl" & _
                 "sjdlkfjdslkjflksdjflsdjfljsdlfjsdljf" & _
                 "lsadjflsdjlfsdajlfjsdjflsdjflsdjflsd" & _
                 "jflsddjlfjlsdjflsdjflksadjkfjskljfkl" & _
                 "sdjflsjdlkfjdslkjflksdjflsdjfljsdlfj" & _
                 "djlfjlsdjflsdjflksadjkfjskljfklsdjfl" & _
                 "sjdlkfjdslkjflksdjflsdjfljsdlfjsdljf" & _
                 "lsadjflsdjlfsdajlfjsdjflsdjflsdjflsd" & _
                 "jflsddjlfjlsdjflsdjflksadjkfjskljfkl" & _
                 "sdjflsjdlkfjdslkjflksdjflsdjfljsdlfj" & _

                 "djlfjlsdjflsdjflksadjkfjskljfklsdjfl" & _
                 "sjdlkfjdslkjflksdjflsdjfljsdlfjsdljf" & _
                 "lsadjflsdjlfsdajlfjsdjflsdjflsdjflsd" & _
                 "jflsddjlfjlsdjflsdjflksadjkfjskljfkl" & _
                 "sdjflsjdlkfjdslkjflksdjflsdjfljsdlfj" & _
                 "sdljflsadjflsdjlfsdajlfjsdjflsdjflsdjflsdjflsd"
'    Text1.MultiLine = True
    Text1.Height = 1000
'    Text1.ScrollBars = 2
    Timer1.Interval = 1000
End Sub
Private Sub Timer1_Timer()
    Dim lngP As Long
    '向下翻
    lngP = PostMessage(Text1.hwnd, WM_VSCROLL, SB_LINEDOWN, &H0)
    '向上翻
    lngP = PostMessage(Text1.hwnd, WM_VSCROLL, SB_LINEUP, &H0)
    Me.Caption = lngP
End Sub

热点排行

VB

为啥不能发送滚轮消息