USUÁRIO:      SENHA:        SALVAR LOGIN ?    Adicione o VBWEB na sua lista de favoritos   Fale conosco 

 

  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...
 


CyberWEB Network Ltda.    © Copyright 2000-2018   -   Todos os direitos reservados.
Powered by HostingZone - A melhor hospedagem para seu site
Topo da página