Ir para conteúdo
Fórum Script Brasil
  • 0

Programar Sobre O Scroll Do Mouse No Visual Basic 6


kuroi

Pergunta

Nesse tópico aqui http://scriptbrasil.com.br/forum/index.php?showtopic=82391 o nosso amigo fabyo postou uma solucao pra como utilizar a rodinha do mouse no editor de codigo do Visual Basic.

Mas acredito que mta gente ainda ta loco atras de alguma forma de fazer os controles VScrollBar ou HScrollBar ou qualquer outro responder à rodinha.

Agora você vai aprender então como fazer o seu programa em Visual Basic 6 responder ao scroll do mouse.

Na verdade há alguns anos atrás encontrei na internet um código já pronto que ensinava a usar a rodinha. Mas na época não consegui fazer funcionar em otro projeto e desisti. Olhando agora eu não sei porque não consegui já q é tão facil de entender.

Mas há alguns dias atrás achei na minha casa aqui o projeto e consegui adaptar pra outros programas.

Pra quem quer ver, o projeto original é esse aqui:

http://rapidshare.com/files/70659407/MouseWheel.zip.html

Baseado nele, abaixo vou ensinar como fazer a sua VScrollBar responder ao scroll.

ATENÇÃO:

Só pra adiantar, esse procedimentos fazem um uso MUITO pesado de APIs. Você deve seguir EXATAMENTE como está abaixo. De preferência, SALVE o seu projeto antes de qualquer coisa e depois vá salvando a cada procedimento.

A princípio não faça NENHUMA alteração em nenhum parte do código por mais que pareça que não vai interferir em nada.

As APIs fazem uma comunicação com todo o ambiente Windows a ponto de apontar o endereço na memória da sua janela (apesar de eu estar falando bonito assim, tb não tenho ideia dos detalhes de como funciona) e qualquer besteira que você fizer pode causar o fechamento do Visual Basic sem aviso prévio e perda de informações não salvas. Por isso, SALVE SEMPRE.

Observação: O tutorial abaixo ensina como usar o scroll em apenas UM dos formulários do seu projeto.

Para a utilização do scroll em mais de um formulário, talvez mais pra frente eu poste aqui uma solução, tb porque no momento eu também estou com dificuldades para encontrar um método prático e que funcione certinho.

Primeiro de tudo, adicione um Module no seu projeto (se você já tiver um Module, é bom usar um separado só para as funções do Scroll). Em seguida, declare as seguintes variáveis, funções e constantes:

Option Explicit

Public roda As Boolean

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

Public Const SM_MOUSEWHEELPRESENT = 75

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[/code] Agora, abra o formulário que possui a Scroll Bar e adicione os seguintes códigos nos eventos Load e UnLoad:
[code]Private Sub Form_Load()
    SetProp Form1.hwnd, "PrevWndProc", SetWindowLong(Form1.hwnd, GWL_WNDPROC, AddressOf WndProc)
    
    If GetSystemMetrics(SM_MOUSEWHEELPRESENT) Then
        roda = True
    Else
        roda = False
        SetWindowLong Form1.hwnd, GWL_WNDPROC, GetProp(Form1.hwnd, "PrevWndProc")
        RemoveProp Form1.hwnd, "PrevWndProc"
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If roda Then
        SetWindowLong Form1.hwnd, GWL_WNDPROC, GetProp(Form1.hwnd, "PrevWndProc")
        RemoveProp Form1.hwnd, "PrevWndProc"
        Set Form1 = Nothing
    End If
End Sub
A variável roda é um flag pra guardar se o mouse possui scroll ou não. Se não possuir ele já desativa a função que lê o mouse. Caso ele possua, ele só vai desativar no UnLoad do formulário. !!!IMPORTANTE!!!! Preste atenção ao NOME do seu formulário. No código acima, substitua Form1 pelo nome do seu formulário em TODAS as ocorrências. Atenção que não adianta usar o atalho e escrever Me em vez do nome do formulário. TEM QUE SER o nome. ATENÇÃO: Ao ativar a função que lê o mouse, o Windows vai marcar sua janela como referência. Por isso, NÃO CANCELE a execução no editor de códigos clicando no botão Stop, pois se fizer isso e a função que lê o mouse não for desativada o Windows ainda vai querer ler a sua janela o que pode causar erros enquanto você não reiniciar o computador. Para finalizar, no MODULE, adicione a função que lê o mouse:
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
    
        If (HiWord(wParam) / WHEEL_DELTA) < 0 Then 'RODANDO PARA BAIXO
            With Form1.VScroll1
                If .Value < .Max Then .Value = .Value + 1
            End With
        Else  'RODANDO PARA CIMA
            With Form1.VScroll1
                If .Value > .Min Then .Value = .Value - 1
            End With
        End If
            
        DefWindowProc hwnd, uMsg, wParam, lParam
    Else
        WndProc = CallWindowProc(GetProp(Form1.hwnd, "PrevWndProc"), hwnd, uMsg, wParam, lParam)
    End If
End Function[/code] Essa é a função que, a cada instante, responde aos eventos do mouse. O código procura especificamente quando a roda for girada e, no caso, ele roda a VScrollBar. Você pode alterar a parte da ScrollBar como te for conveniente dependendo da resposta que você quer dar à girada da rodinha. ATENÇÃO - Novamente, altere Form1 para o nome do seu formulário em todas as ocorrências. - NÃO ALTERE O NOME DA FUNÇÃO WndProc Pronto. Gire a roda pra ver a ScrollBar se mexer. Note também, que o código acima vai mover a ScrollBar não importa a localização do mouse. Se você tiver outras ScrollBars e quiser mover uma específica de acordo com a localização, cabe a você fazer a programação correta. Para isso é relativamente simples, pelo evento MouseMove do formulario pegar a posicao do mouse e assim, utilizando variaveis globais, adaptar na funcao acima pra tomar determinada ação dependendo da posição. Também, abaixo está um link com um projeto de exemplo de como trabalhar com múltiplas ScrollBars. Como vocês viram, é preciso muito cuidado pra mexer com essas funções. Pra qualquer dúvidas que vocês tiverem, BAIXE AQUI o projeto com o código funcionando: http://rapidshare.com/files/70696444/RodaDoMouse.zip.html Nesse link você encontra dois projetos. Um deles é o exemplo prático desse tutorial, no caso de você não conseguir fazer, você vai ter o exemplo pronto pra poder olhar. O segundo projeto é um exemplo de como trabalhar com múltiplas ScrollBars. Últimas Considerações: Resumindo, trabalhar com o Scroll do Mouse no Visual Basic 6 é uma tristeza. O que eu recomendo é que você adicione as funções no Module, ponha o código no formulário pra ativar a função, teste e veja se funciona mas, enquanto estiver ainda desenvolvendo o projeto, deixe o código do formulário todo comentado pra não atrapalhar os seus testes referente ao resto do programa. Ative o código somente quando for liberar o programa pronto. O programa original (link lá em cima) ensina também a saber quando a rodinha é girada com o Ctrl ou Shift, ou algum botão pressionado, dêem uma olhada lá. Só pra constar, a função WndProc pode ler qualquer ação do mouse, mas no código acima está focado apenas no girar da rodinha. Mas, por exemplo, você pode programar uma ação pra quando ele clicar na rodinha (considerada como botão do meio do mouse), assim como você faz pra abrir o link em uma nova aba no FireFox. Você só precisaria declarar a constante:
[code]Private Const WM_MBUTTONUP = &H208
E adicionar a programação correta na função WndProc:
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
        ...
    ElseIf uMsg = WM_MBUTTONUP Then
        MsgBox "Apertou botão do meio!"
    Else
        WndProc = CallWindowProc(GetProp(Form1.hwnd, "PrevWndProc"), hwnd, uMsg, wParam, lParam)
    End If
End Function[/code]

Aqui está o Enum de todas as ações possíveis do mouse:

[codebox]Public Enum WindowMessages
WM_ACTIVATE = &H6
WM_ACTIVATEAPP = &H1C
WM_ASKCBFORMATNAME = &H30C
WM_CANCELJOURNAL = &H4B
WM_CANCELMODE = &H1F
WM_CAPTURECHANGED = &H1F
WM_CAPTURECHANGED_R = &H215
WM_CHANGECBCHAIN = &H30D
WM_CHAR = &H102
WM_CHARTOITEM = &H2F
WM_CHILDACTIVATE = &H22
WM_CHOOSEFONT_GETLOGFONT = &H401
WM_CHOOSEFONT_SETFLAGS = (&H400 + 102)
WM_CHOOSEFONT_SETLOGFONT = (&H400 + 101)
WM_CLEAR = &H303
WM_CLOSE = &H10
WM_COMMAND = &H111
WM_COMPACTING = &H41
WM_COMPAREITEM = &H39
WM_CONTEXTMENU = &H7B
WM_CONVERTREQUESTEX = &H108
WM_COPY = &H301
WM_COPYDATA = &H4A
WM_CREATE = &H1
WM_CTLCOLORBTN = &H135
WM_CTLCOLORDLG = &H136
WM_CTLCOLOREDIT = &H133
WM_CTLCOLORLISTBOX = &H134
WM_CTLCOLORMSGBOX = &H132
WM_CTLCOLORSCROLLBAR = &H137
WM_CTLCOLORSTATIC = &H138
WM_CUT = &H300
WM_DDE_ACK = (&H3E0 + 4)
WM_DDE_ADVISE = (&H3E0 + 2)
WM_DDE_DATA = (&H3E0 + 5)
WM_DDE_EXECUTE = (&H3E0 + 8)
WM_DDE_FIRST = &H3E0
WM_DDE_INITIATE = &H3E0
WM_DDE_LAST = (&H3E0 + 8)
WM_DDE_POKE = (&H3E0 + 7)
WM_DDE_REQUEST = (&H3E0 + 6)
WM_DDE_TERMINATE = (&H3E0 + 1)
WM_DDE_UNADVISE = (&H3E0 + 3)
WM_DEADCHAR = &H103
WM_DELETEITEM = &H2D
WM_DESTROY = &H2
WM_DESTROYCLIPBOARD = &H307
WM_DEVICECHANGE = &H219
WM_DEVMODECHANGE = &H1B
WM_DRAWCLIPBOARD = &H308
WM_DRAWITEM = &H2B
WM_DROPFILES = &H233
WM_ENABLE = &há
WM_ENDSESSION = &H16
WM_ENTERIDLE = &H121
WM_ENTERSIZEMOVE = &H231
WM_ENTERMENULOOP = &H211
WM_ERASEBKGND = &H14
WM_EXITMENULOOP = &H212
WM_EXITSIZEMOVE = &H232
WM_FONTCHANGE = &H1D
WM_GETDLGCODE = &H87
WM_GETFONT = &H31
WM_GETHOTKEY = &H33
WM_GETMINMAXINFO = &H24
WM_GETTEXT = &HD
WM_GETTEXTLENGTH = &HE
WM_HELP = &H53
WM_HOTKEY = &H312
WM_HSCROLL = &H114
WM_HSCROLLCLIPBOARD = &H30E
WM_ICONERASEBKGND = &H27
WM_IME_CHAR = &H286
WM_IME_COMPOSITION = &H10F
WM_IME_COMPOSITIONFULL = &H284
WM_IME_CONTROL = &H283
WM_IME_ENDCOMPOSITION = &H10E
WM_IME_KEYDOWN = &H290
WM_IME_KEYLAST = &H10F
WM_IME_KEYUP = &H291
WM_IME_NOTIFY = &H282
WM_IME_SELECT = &H285
WM_IME_SETCONTEXT = &H281
WM_IME_STARTCOMPOSITION = &H10D
WM_INITDIALOG = &H110
WM_INITMENU = &H116
WM_INITMENUPOPUP = &H117
WM_INPUTLANGCHANGEREQUEST = &H50
WM_INPUTLANGCHANGE = &H51
WM_KEYDOWN = &H100
WM_KEYUP = &H101
WM_KILLFOCUS = &H8
WM_LBUTTONDBLCLK = &H203
WM_LBUTTONDOWN = &H201
WM_LBUTTONUP = &H202
WM_MBUTTONDBLCLK = &H209
WM_MBUTTONDOWN = &H207
WM_MBUTTONUP = &H208
WM_MDIACTIVATE = &H222
WM_MDICASCADE = &H227
WM_MDICREATE = &H220
WM_MDIDESTROY = &H221
WM_MDIGETACTIVE = &H229
WM_MDIICONARRANGE = &H228
WM_MDIMAXIMIZE = &H225
WM_MDINEXT = &H224
WM_MDIREFRESHMENU = &H234
WM_MDIRESTORE = &H223
WM_MDISETMENU = &H230
WM_MDITILE = &H226
WM_MEASUREITEM = &H2C
WM_MENUCHAR = &H120
WM_MENUSELECT = &H11F
WM_MENURBUTTONUP = &H122
WM_MENUDRAG = &H123
WM_MENUGETOBJECT = &H124
WM_MENUCOMMAND = &H126
WM_MOUSEACTIVATE = &H21
WM_MOUSEHOVER = &H2A1
WM_MOUSELEAVE = &H2A3
WM_MOUSEMOVE = &H200
WM_MOUSEWHEEL = &H20A
WM_MOVE = &H3
WM_MOVING = &H216
WM_NCACTIVATE = &H86
WM_NCCALCSIZE = &H83
WM_NCCREATE = &H81
WM_NCDESTROY = &H82
WM_NCHITTEST = &H84
WM_NCLBUTTONDBLCLK = &HA3
WM_NCLBUTTONDOWN = &HA1
WM_NCLBUTTONUP = &HA2
WM_NCMBUTTONDBLCLK = &HA9
WM_NCMBUTTONDOWN = &HA7
WM_NCMBUTTONUP = &HA8
WM_NCMOUSEMOVE = &HA0
WM_NCPAINT = &H85
WM_NCRBUTTONDBLCLK = &HA6
WM_NCRBUTTONDOWN = &HA4
WM_NCRBUTTONUP = &HA5
WM_NEXTDLGCTL = &H28
WM_NEXTMENU = &H213
WM_NULL = &H0
WM_PAINT = &HF
WM_PAINTCLIPBOARD = &H309
WM_PAINTICON = &H26
WM_PALETTECHANGED = &H311
WM_PALETTEISCHANGING = &H310
WM_PARENTNOTIFY = &H210
WM_PASTE = &H302
WM_PENWINFIRST = &H380
WM_PENWINLAST = &H38F
WM_POWER = &H48
WM_POWERBROADCAST = &H218
WM_PRINT = &H317
WM_PRINTCLIENT = &H318
WM_PSD_ENVSTAMPRECT = (&H400 + 5)
WM_PSD_FULLPAGERECT = (&H400 + 1)
WM_PSD_GREEKTEXTRECT = (&H400 + 4)
WM_PSD_MARGINRECT = (&H400 + 3)
WM_PSD_MINMARGINRECT = (&H400 + 2)
WM_PSD_PAGESETUPDLG = (&H400)
WM_PSD_YAFULLPAGERECT = (&H400 + 6)
WM_QUERYDRAGICON = &H37
WM_QUERYENDSESSION = &H11
WM_QUERYNEWPALETTE = &H30F
WM_QUERYOPEN = &H13
WM_QUEUESYNC = &H23
WM_QUIT = &H12
WM_RBUTTONDBLCLK = &H206
WM_RBUTTONDOWN = &H204
WM_RBUTTONUP = &H205
WM_RENDERALLFORMATS = &H306
WM_RENDERFORMAT = &H305
WM_SETCURSOR = &H20
WM_SETFOCUS = &H7
WM_SETFONT = &H30
WM_SETHOTKEY = &H32
WM_SETREDRAW = &HB
WM_SETTEXT = &HC
WM_SETTINGCHANGE = &H1A
WM_SHOWWINDOW = &H18
WM_SIZE = &H5
WM_SIZING = &H214
WM_SIZECLIPBOARD = &H30B
WM_SPOOLERSTATUS = &H2A
WM_SYSCHAR = &H106
WM_SYSCOLORCHANGE = &H15
WM_SYSCOMMAND = &H112
WM_SYSDEADCHAR = &H107
WM_SYSKEYDOWN = &H104
WM_SYSKEYUP = &H105
WM_TIMECHANGE = &H1E
WM_TIMER = &H113
WM_UNDO = &H304
WM_USER = &H400
WM_VKEYTOITEM = &H2E
WM_VSCROLL = &H115
WM_VSCROLLCLIPBOARD = &H30A
WM_WINDOWPOSCHANGED = &H47
WM_WINDOWPOSCHANGING = &H46
WM_WININICHANGE = &H1A
WM_APPCOMMAND = &H319
End Enum[/codebox]

Editado por kuroi
Link para o comentário
Compartilhar em outros sites

0 respostass a esta questão

Posts Recomendados

Até agora não há respostas para essa pergunta

Participe da discussão

Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.

Visitante
Responder esta pergunta...

×   Você colou conteúdo com formatação.   Remover formatação

  Apenas 75 emoticons são permitidos.

×   Seu link foi incorporado automaticamente.   Exibir como um link em vez disso

×   Seu conteúdo anterior foi restaurado.   Limpar Editor

×   Você não pode colar imagens diretamente. Carregar ou inserir imagens do URL.



  • Estatísticas dos Fóruns

    • Tópicos
      152,1k
    • Posts
      651,8k
×
×
  • Criar Novo...