|
|
|
|
|
|
|
|
Dicas
|
|
|
Visual Basic (Menu/Toobar/Coolbar)
|
|
 |
Título da Dica: Rolar Scollbar com o mouse
|
 |
|
|
|
Postada em 7/8/2005 por Romero
Muitas vezes queremos quea barra de rolagem role com o botão do mouse...
Mas o vb tem suporte para isso?...
Tem sim!!!... mas com o uso da WindowProc, a WindowProc força o vb a fazer tudo aquilo que em termos normais não seria possivel... como mudar o restilo de uma janela, ou qualquer outra coisa em seu programa... mas usa-lo requer um pouco de conhecimento...
Para começar declare as funções que vão dar o suporte para a WindowProc e não se esqueça de descarrega-la antes de sair... pois caso contrario o vb gera um erro e é finalizado bruscamente...
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'Declarações gerais em um módulo.
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByRef lParam As WAVEHDR) As Long
'variáveis do modulo
Public lProcOld As Long
Public Const GWL_WNDPROC = (-4)
'Função que chama a WindowProc.
Public Function SubClass(FormName As Form)
lProcOld = SetWindowLong(FormName.hWnd, GWL_WNDPROC, AddressOf WindowProc)
End Function
'Função WindowProc responsável pela
'interceptação das mensagem do Windows.
Public Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByRef wavhdr As WAVEHDR) As Long
'Mensagem enviada pelo Windows quando a roalgem do mouse a acionada
If uMsg = 522 Then
'Inicia a seleção de caso para saber se o usuário moveu
'a roalgem para cima ou para baixo
Select Case wParam
Case 7864320 'caso positivo
'acrecenta +1 a barra de rolagem
If Frm_Cliente.Barra.Value > 0 Then Frm_Cliente.Barra.Value = Frm_Cliente.Barra.Value - 1
caso
Case -7864320 'caso Megativo
'acrecenta -1 a barra de rolagem
If Frm_Cliente.Barra.Value < Frm_Cliente.Barra.Max Then Frm_Cliente.Barra.Value = Frm_Cliente.Barra.Value + 1
End Select
End If
'Retorna a Função ao Windows
WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, wavhdr)
End Function
'no form
Private Sub Form_Load()
'chama a WindowProc
d = SubClass(Frm_Cliente)'nome do form
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
'descarrega a WindowProc
SetWindowLong Me.hWnd, GWL_WNDPROC, lProcOld
End Sub
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
com o uso da WindowProc você retem todas as mensagens enviadas pelo Windows...
podendo passa-la ou não dependendo sa situação... no nosso caso passamos normalmente.
Boa sorte... Valeu...
|
|
|
|
|
