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

 

  Dicas

  Visual Basic    (Mouse/Teclado)

Título da Dica:  Hot Key (Tecla de Atalho)
Postada em 31/7/2003 por Everest            
'**************************************
'Windows API/Global Declarações para:
'RegisterHotKey
'**************************************
Const WM_HOTKEY = &H312
Const MOD_ALT = &H1
Const MOD_CONTROL = &H2
Const MOD_SHIFT = &H4
Const MOD_WIN = &H8

Private Declare Function RegisterHotKey Lib "user32" (ByVal hwnd As Long, ByVal id As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long


Private Declare Function GlobalAddAtom Lib "kernel32" Alias "GlobalAddAtomA" (ByVal lpString As String) As Integer


Private Declare Function GlobalDeleteAtom Lib "kernel32" (ByVal nAtom As Integer) As Integer


Private Declare Function UnregisterHotKey Lib "user32" (ByVal hwnd As Long, ByVal id As Long) As Long          
'**************************************
' Nome: RegisterHotKey
' Descrição: Registra uma tecla de atalho no sistema
' Por: Everest
'
' Entradas: Nenhuma
'
' Retornos: Nenhum
'
' Efeitos Colaterais: Nenhum
'**************************************

'Esse exemplo usa OCX MsgHook
'iAtom quarda o id usado pela hotkey.

Dim iAtom As Integer

Private Sub Form_Load()
    Dim res As Long

    iAtom = GlobalAddAtom("MyHotKey")
    'Registra Ctrl-Alt-T como uma hotkey
    res = RegisterHotKey(Me.hwnd, iAtom, MOD_ALT + MOD_CTRL, vbKeyT)

    Msghook1.HwndHook = Me.hwnd
    Msghook1.Message(WM_HOTKEY) = True
End Sub


Private Sub Form_Unload(Cancel As Integer)
    Dim res As Long

    res = UnregisterHotKey(Me.hwnd, iAtom)
    res = GlobalDeleteAtom(iAtom)
End Sub


Private Sub Msghook1_Message(ByVal msg As Long, ByVal wp As Long, ByVal lp As Long, result As Long)


    If msg = WM_HOTKEY Then
        If wp = iAtom Then
            MsgBox "Buuuuum!!!"
        End If
    End If
    Msghook1.InvokeWindowProc msg, wp, lp
End Sub

'Adicionado pelo Roberto admin VBWEB
Baixe o msghook nesse link:

http://www.arcatapet.net/vbsource/msghook.zip

 


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