MOUSE SCROLL COMO USAR ?

USUARIO.EXCLUIDOS 05/04/2004 13:21:15
#18906 Resposta escolhida

Scroll, Marcelo. Quase lá.
O Scroll (ou Wheel, ou rodinha, mesmo) é ativado pelo driver do mouse. O VB não dispõe de nenhum mecanismo que possa capturar esses eventos. Para tanto, seria necessário criar um gancho sobre o ponteiro do mouse e usar um temporizados e, provavelmente, subclassing, o que ainda é um processo meio "delicado" no Windows.
Mas eu vou dar uma olhada e ver o que consigo saber por aí, ok?

USUARIO.EXCLUIDOS 05/04/2004 14:54:03
#18930

Marcelo, achei algo interessante.
O autor é Derek Stone e o código é simples.

Em um módulo:

Option Explicit
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" ( _
ByVal hwnd As Long, _
ByVal nIndex As Long) As Long

Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" ( _
ByVal hwnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long

Private Declare Function DefWindowProc Lib "user32" Alias "DefWindowProcA" ( _
ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam 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

Public Declare Function GetProp Lib "user32" Alias "GetPropA" ( _
ByVal hwnd As Long, _
ByVal lpString As String) As Long

Public Declare Function SetProp Lib "user32" Alias "SetPropA" ( _
ByVal hwnd As Long, _
ByVal lpString As String, _
ByVal hData As Long) As Long

Public Declare Function RemoveProp Lib "user32" Alias "RemovePropA" ( _
ByVal hwnd As Long, _
ByVal lpString As String) As Long

Public Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" ( _
ByVal uAction As Long, _
ByVal uParam As Long, _
ByVal lpvParam As Any, _
ByVal fuWinIni As Long) As Long

Public Declare Function GetSystemMetrics Lib "user32" ( _
ByVal nIndex As Long) As Long

Public Const GWL_WNDPROC = -4

Private Const WM_MOUSEWHEEL = &H20A

Private Const WHEEL_DELTA = 120
Private Const WHEEL_PAGESCROLL = &HFFFFFFFF

Public Const SPI_GETWHEELSCROLLLINES = 104

Public Const SM_MOUSEWHEELPRESENT = 75

Private Const MK_CONTROL = &H8 'Control key
Private Const MK_SHIFT = &H4 'Shift key
Private Const MK_LBUTTON = &H202 'Left mouse button
Private Const MK_MBUTTON = &H10 'Middle mouse button
Private Const MK_RBUTTON = &H2 'Right mouse button
Private Const MK_XBUTTON1 = &H20 'First X button; Windows 2000/XP only
Private Const MK_XBUTTON2 = &H40 'Second X button; Windows 2000/XP only

Public Function WndProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If uMsg = WM_MOUSEWHEEL Then

MainWindow.MouseWheelShape.BackColor = vbRed
MainWindow.ResetTimer.Enabled = True

' ##### Button/key pressed #####
Select Case LoWord(wParam)
Case MK_CONTROL
MainWindow.ControlButtonShape.BackColor = vbRed
Case MK_SHIFT
MainWindow.ShiftButtonShape.BackColor = vbRed
Case MK_CONTROL Or MK_SHIFT
MainWindow.ControlButtonShape.BackColor = vbRed
MainWindow.ShiftButtonShape.BackColor = vbRed
Case MK_XBUTTON1
Case MK_LBUTTON
Case MK_MBUTTON
Case MK_RBUTTON
Case MK_XBUTTON2
End Select

MainWindow.ScrollingInfoLabel.Visible = True

' ##### Scroll direction #####
If (HiWord(wParam) / WHEEL_DELTA) 0 Then
'Scrolling down
MainWindow.ScrollingInfoLabel.Caption = "Scrolling down"
Else
MainWindow.ScrollingInfoLabel.Caption = "Scrolling up"
End If

' ##### Paging = suggested number of lines to scroll (e.g. in a textbox) #####
' Windows 95: Not supported
Dim r As Long

SystemParametersInfo SPI_GETWHEELSCROLLLINES, 0, r, 0

If r = WHEEL_PAGESCROLL Then
'Wheel roll should be interpreted as clicking
'once in the page down or page up regions of
'the scroll bar
Else
'Scroll 3 lines (3 is the default value)
End If

'Pass the message to default window procedure and then onto the parent
DefWindowProc hwnd, uMsg, wParam, lParam
Else
'No messages handled, call original window procedure
WndProc = CallWindowProc(GetProp(MainWindow.hwnd, "PrevWndProc"), hwnd, uMsg, wParam, lParam)
End If
End Function

Public Function HiWord(dw As Long) As Integer
If dw And &H80000000 Then
HiWord = (dw \ 65535) - 1
Else
HiWord = dw \ 65535
End If
End Function

Public Function LoWord(dw As Long) As Integer
If dw And &H8000& Then
LoWord = &H8000 Or (dw And &H7FFF&)
Else
LoWord = dw And &HFFFF&
End If
End Function

'--------------------------------------------------------------------------------------
No Form:

Option Explicit

Private Sub Form_Load()
SetProp MainWindow.hwnd, "PrevWndProc", SetWindowLong(MainWindow.hwnd, GWL_WNDPROC, AddressOf WndProc)

If GetSystemMetrics(SM_MOUSEWHEELPRESENT) Then
MsgBox "A simple call to GetSystemMetrics tells you whether or not the mouse has a wheel. The mouse connected to this computer does have a wheel.", vbInformation + vbOKOnly, App.Title
Else
MsgBox "A simple call to GetSystemMetrics tells you whether or not the mouse has a wheel. The mouse connected to this computer doesn't have a wheel.", vbInformation + vbOKOnly, App.Title
Unload MainWindow
End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
SetWindowLong MainWindow.hwnd, GWL_WNDPROC, GetProp(MainWindow.hwnd, "PrevWndProc")
RemoveProp MainWindow.hwnd, "PrevWndProc"
Set MainWindow = Nothing
End Sub

Private Sub ResetTimer_Timer()
ResetTimer.Enabled = False
MainWindow.MouseWheelShape.BackColor = &HC0C000
MainWindow.ControlButtonShape.BackColor = &HFFFFFF
MainWindow.ShiftButtonShape.BackColor = &HFFFFFF
MainWindow.ScrollingInfoLabel.Visible = False
End Sub

Ainda no form, inserir os controles:
Nome: Tipo:

ResetTimer Timer
ScrollingInfoLabel Label
DescriptionLabel Label
ControlButtonLabel Label
ShiftButtonLabel Label
ControlButtonShape Shape
ShiftButtonShape Shape
Line3 Line
Line2 Line
Line1 Line
MouseWheelShape Shape
RButtonImage Image
LButtonImage Image

Dá para componentizar, na boa.
Fica aí para a thurma.

USUARIO.EXCLUIDOS 05/04/2004 16:16:11
#18948

Se você perder algum tempo com o código, vai reparar que dá para gerar um OCX com ele. Aí fica "moleza" de usar.

USUARIO.EXCLUIDOS 06/04/2004 10:46:13
#19051

Desculpe Marcelo! Cheguei no site agora há pouco. Vou dar uma fuçada nos fontes e envio o resultado, ok?

USUARIO.EXCLUIDOS 06/04/2004 12:13:01
#19079

Marcelo, não teve jeito. Por conta do subclassing do form, não estou conseguindo componentizar, não. A solução fica por conta de gerar uma rotina genérica, que avalie cada form e apresente o que você deseja.
Por curiosidade, você precisa avaliar o evento do MouseWheel para qual finalidade?

USUARIO.EXCLUIDOS 08/04/2004 13:12:42
#19450

Era o que eu queria saber. Onde você estava utilizando o scroll e com qual finalidade. Sabendo que é por conta do FlexiGrid, fica mais fácil.
O FlexiGrid assume a rolagem do MouseWheel de forma automática, por conta das barras de rolagem.
Você não precisa captar o evento diretamente do mouse, como estávamos fazendo.
Basta capturar o evento Scroll do próprio FlexiGrid.