为什么不能发送滚轮消息

为何不能发送滚轮消息？本帖最后由 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

[其他解释]
中间键就是滚轮滑动吧？我觉得是你的SendMessage有问题，参数不全。因为滚轮还有方向之分的。

试一试这个：
re = SendMessage(fmHwnd, WM_MOUSEWHEEL, byval 512&, lParam)

[其他解释]


re = SendMessage(fmHwnd, WM_MOUSEWHEEL, 512&, 0&)

[其他解释]

引用:

中间键就是滚轮滑动吧？我觉得是你的SendMessage有问题，参数不全。因为滚轮还有方向之分的。

试一试这个：
re = SendMessage(fmHwnd, WM_MOUSEWHEEL, byval 512&, lParam)

不行，一样返回是0，而且我上面的那两个参数wParam和lParam都是通过截取本窗口的滚轮消息，然后再把它发送到另外那个窗口，估计那两个参数没问题吧？
[其他解释]
换一个思路？
使用mouse_event来实现？
[其他解释]

引用:

换一个思路？
使用mouse_event来实现？

但问题是外部窗口啊，mouse_event怎么发送到外部窗口啊？
[其他解释]

Option Explicit

Public Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Public Const MOUSEEVENTF_ABSOLUTE = &H8000 ' absolute move
Public Const MOUSEEVENTF_LEFTDOWN = &H2 ' left button down
Public Const MOUSEEVENTF_LEFTUP = &H4 ' left button up
Public Const MOUSEEVENTF_MIDDLEDOWN = &H20 ' middle button down
Public Const MOUSEEVENTF_MIDDLEUP = &H40 ' middle button up
Public Const MOUSEEVENTF_MOVE = &H1 ' mouse move
Public Const MOUSEEVENTF_RIGHTDOWN = &H8 ' right button down

Public Const MOUSEEVENTF_RIGHTUP = &H10 ' right button up
Public Const MOUSEEVENTF_WHEEL = &H800

Private Sub Command1_Click()
Timer1.Interval = 5000
Timer1.Enabled = True
End Sub

Private Sub Timer1_Timer()
Dim i As Integer
For i = 0 To 100
DoEvents
mouse_event MOUSEEVENTF_WHEEL, 0, 0, 10, 0
Next
For i = 0 To 100
DoEvents
mouse_event MOUSEEVENTF_WHEEL, 0, 0, -10, 0
Next
End Sub

[其他解释]
先使外部窗口获得焦点，然后使用mouse_event
[其他解释]

'    Text1.MultiLine = True

    Timer1.Interval = 1000
End Sub

Private Sub Timer1_Timer()
    Dim lngP As Long
    lngP = PostMessage(Text1.hwnd, WM_MOUSEWHEEL, &H0, &H0)
'    lngP = PostMessage(lngButton_1_Hwnd, &H20A, &H0, &H0)   '松开鼠标左键
    Me.Caption = lngP
End Sub

[其他解释]
这个OK

 
'    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_KEYDOWN, VK_DOWN, &H0)
    Sleep 100
    lngP = PostMessage(Text1.hwnd, WM_KEYUP, VK_DOWN, &H0)
    '向上翻
'    lngP = PostMessage(Text1.hwnd, WM_KEYDOWN, VK_UP, &H0)
'    Sleep 100
'    lngP = PostMessage(Text1.hwnd, WM_KEYUP, VK_UP, &H0)
    Me.Caption = lngP
End Sub

[其他解释]

引用:

看看这个，我初调成功
VB code

Option Explicit
Private Const WM_MOUSEWHEEL = &H20A
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wPa……

那就奇怪了。我这里完全没有任何反映，虽然lngP还是返回1。
[其他解释]
先实现了再说，至于优化效果，可以慢慢来。
[其他解释]

引用:

这个OK
VB code

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 = ……

效果不如理想啊，是可以，但问题就是我刚说的那种，幅度没变化啊。
[其他解释]

引用:

先实现了再说，至于优化效果，可以慢慢来。

不过也是，好，先谢谢你。看看明天还有没有更好的方法，没有就结贴。
[其他解释]
既然没人有好方法,好了,结贴.