500分 快捷键设置？

Question

vb6中实现vbkeyup 与vbkeytab相同的功能, vbkeyDown 与 shift + vbkeytab 相同的功能，只有窗口是当前窗口时有效，对所有控件均有效（注： 有些控件已经使用了他们，所以from_keydown事件中实现快捷键功能无效）。
要求：可以直接用的代码。
验证有效的代码立即结贴给分（其他分另开贴给）。

Answer 1

你把form的keypreview设成true,就可以在窗体的keydown事件中写相应的代码了。

Answer 2

我用其它方法给你写了一个
'以下程序放在模块中
Option ExplicitDeclare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
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
Declare Function RegisterHotKey Lib "user32" (ByVal hwnd As Long, ByVal id As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long
Declare Function UnregisterHotKey Lib "user32" (ByVal hwnd As Long, ByVal id As Long) As Long
Declare Function GetForegroundWindow Lib "user32" () As LongPublic Const WM_HOTKEY = &H312
Public Const MOD_ALT = &H1
Public Const MOD_CONTROL = &H2
Public Const MOD_SHIFT = &H4
Public Const GWL_WNDPROC = (-4)Public preWinProc As Long
Public Modifiers As Long, uVirtKey1 As Long, uVirtKey2 As Long, idHotKey As LongPrivate Type taLong
     ll As Long
End TypePrivate Type t2Int
    lWord As Integer
    hword As Integer
End Type
    
Public Function wndproc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim lp As taLong, i2 As t2Int    If Msg = WM_HOTKEY Then
        If wParam = idHotKey Then
            lp.ll = lParam
            LSet i2 = lp
            If (i2.lWord = Modifiers) And i2.hword = uVirtKey1 Then
                If GetForegroundWindow() = Form4.hwnd Then
                    SendKeys "{TAB}"
                End If
            End If
        ElseIf wParam = idHotKey + 1 Then
            lp.ll = lParam
            LSet i2 = lp
            If (i2.lWord = Modifiers) And i2.hword = uVirtKey2 Then
                If GetForegroundWindow() = Form4.hwnd Then
                    SendKeys "+{TAB}"
                End If
            End If
        End If
    End If
    '如果不是热键信息则调用原来的程序
    wndproc = CallWindowProc(preWinProc, hwnd, Msg, wParam, lParam)
End Function'窗体中代码
Option ExplicitPrivate Sub Form_Load()
Dim ret As Long
    '记录原来的window程序地址
    preWinProc = GetWindowLong(Me.hwnd, GWL_WNDPROC)
    '用自定义程序代替原来的window程序
    ret = SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf wndproc)
    idHotKey = 1 'in the range ＆h0000 through ＆hBFFF
    Modifiers = 0
    uVirtKey1 = vbKeyDown
    '注册热键
    ret = RegisterHotKey(Me.hwnd, idHotKey, Modifiers, uVirtKey1)
    If ret = 0 Then
        MsgBox "注册热键失败,请使用其它热键!", vbCritical, "错误"
    End If    uVirtKey2 = vbKeyUp
    '注册热键
    ret = RegisterHotKey(Me.hwnd, idHotKey + 1, Modifiers, uVirtKey2)
    If ret = 0 Then
        MsgBox "注册热键失败,请使用其它热键!", vbCritical, "错误"
    End IfEnd SubPrivate Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Call UnregisterHotKey(Me.hwnd, uVirtKey1)
    Call UnregisterHotKey(Me.hwnd, uVirtKey2)
End Sub

Answer 3

改进方法，用键盘钩子
'in a moudle
Option Explicit'模块
Public Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Public Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Public Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, ByVal lpvSource As Long, ByVal cbCopy As Long)'
' Win32 API declarations.
'
Public Declare Function timeGetTime Lib "winmm.dll" () As Long
Public Declare Function timeGetDevCaps Lib "winmm.dll" (lpTimeCaps As TIMECAPS, ByVal uSize As Long) As Long
'
' API Structure definitions.
'
Public Type TIMECAPS
   wPeriodMin As Long
   wPeriodMax As Long
End Type
'///////////////////////////////////////
Public Type KEYMSGS
       vKey As Long          '虚拟码  (and &HFF)
       sKey As Long          '扫描码
       Flag As Long          '键按下：128 抬起：0
       Time As Long          'Window运行时间
End TypePublic Const WH_KEYBOARD_LL = 13
Public Const WH_MOUSE_LL = 14
Public Const Alt_Down = &H20
'-----------------------------------------
'消息
Public Const HC_ACTION = 0
Public Const HC_SYSMODALOFF = 5
Public Const HC_SYSMODALON = 4
'键盘消息
Public Const WM_KEYDOWN = &H100
Public Const WM_KEYUP = &H101
Public Const WM_SYSKEYDOWN = &H104
Public Const WM_SYSKEYUP = &H105
'---------------------------------------Public keyMsg As KEYMSGS
Public lHook(1) As Long'模拟按键
Public Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Public Declare Function GetForegroundWindow Lib "user32" () As LongPublic BeginTime As Long
'键盘钩子
Public Function CallKeyHookProc(ByVal code As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim lKey As Long
    Dim strKeyName As String * 255
    Dim strLen As Long
    Dim Flag As String
    Dim lngFlag As Long
    
    If code = HC_ACTION Then
        CopyMemory keyMsg, lParam, LenB(keyMsg)        
        Select Case wParam
         Case WM_SYSKEYDOWN, WM_KEYDOWN, WM_SYSKEYUP, WM_KEYUP:
             lKey = keyMsg.sKey And &HFF           '扫描码
             lKey = lKey * 65536             If GetForegroundWindow = Form4.hWnd Then
                If (keyMsg.vKey And &HFF) = vbKeyDown Then       '把Y键替换为N
                   If wParam = WM_SYSKEYDOWN Or wParam = WM_KEYDOWN Then
                      SendKeys "{TAB}"
                   End If
                   CallKeyHookProc = 1        '屏蔽按键
                End If
                
                If (keyMsg.vKey And &HFF) = vbKeyUp Then       '把Y键替换为N
                   If wParam = WM_SYSKEYDOWN Or wParam = WM_KEYDOWN Then
                        SendKeys "+{TAB}"
                   End If
                   CallKeyHookProc = 1        '屏蔽按键
                End If
                
             End If
        End Select
    End If
    
    If code <> 0 Then
      CallKeyHookProc = CallNextHookEx(0, code, wParam, lParam)
    End If
End Function
'in a form (name form4)
Option ExplicitPrivate Sub Form_Load()
Dim ret As Long
    lHook(0) = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf CallKeyHookProc, App.hInstance, 0)
End SubPrivate Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    UnhookWindowsHookEx lHook(0)
End Sub

Answer 4

Option ExplicitPrivate Sub Form_Load()
Dim ret As Long'记录原来的window程序地址
preWinProc = GetWindowLong(Me.hwnd, GWL_WNDPROC)
'用自定义程序代替原来的window程序
ret = SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf Wndproc)idHotKey = 1
Modifiers = MOD_ALT + MOD_CONTROL 'Alt+Ctrl 键
uVirtKey = vbKeyG  'G键
ret = RegisterHotKey(Me.hwnd, idHotKey, Modifiers, uVirtKey)End SubPrivate Sub Form_Unload(Cancel As Integer)
Dim ret As Long
'取消Message的截取，使之送往原来的windows程序
ret = SetWindowLong(Me.hwnd, GWL_WNDPROC, preWinProc)
Call UnregisterHotKey(Me.hwnd, uVirtKey)End Sub按"Ctrl+Alt+G"试试看

Answer 5

等明天试了有效就给分。
采用form的方法简单是简单，但是有些控件已经将他们用了，form窗口的无效。

Answer 6

该键盘钩子只在NT内核下有效，98就不行了我一般用Timer，好调试，省资源，也挺好使
'这是我API浏览器中的一段代码
Private Sub tmrSystem_Timer()
  Dim intKey As Integer
  Dim intMouse As Integer
  Dim strClassName As String * 255
  Dim hwnd1 As Long
  Dim Mousemsg As POINTAPI
  
  intKey = (GetAsyncKeyState(VK_F12) And &HFF00) / 2 ^ 15
  intMouse = (GetAsyncKeyState(VK_LBUTTON) And &HFF00) / 2 ^ 15
 
  If intKey = -1 Then     'F12
     frmMain.WindowState = frmMain.LastState
     frmMain.Visible = True
     frmMain.SetFocus
  End If
  
  If intMouse = -1 And frmMain.WindowState = 1 Then   'LBUTTON
        GetCursorPos Mousemsg
        Call GetClassName(WindowFromPoint(Mousemsg.X, Mousemsg.Y), strClassName, 255)
        If (InStr(strClassName, "#32768")) < 1 Then
            hwnd1 = FindWindow("#32768", "")
            Dim rt As RECT
            
            If hwnd1 > 0 Then
               GetWindowRect hwnd1, rt
               If rt.Left > Screen.Width / Screen.TwipsPerPixelX - 300 And rt.Top > Screen.Height / Screen.TwipsPerPixelY - 150 Then
                 SendMessage hwnd1, &H10, 0, 0
               End If
            End If
        End If
  End If
endif

Answer 7

sorry!现在很忙，不能一个一个的试（好像第一个不符）！等过几天在处理！
楼上的，至少我没有少给过别人分。记得上次那个人并没有完全解答我的问题所以只给了一半的分（500）。

Answer 8

Option ExplicitPublic Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex 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, ByVal lParam As Long) As Long
Public Declare Function RegisterHotKey Lib "user32" (ByVal hwnd As Long, ByVal ID As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long
Public Declare Function UnregisterHotKey Lib "user32" (ByVal hwnd As Long, ByVal ID As Long) As Long
Public Declare Function GetLastError Lib "kernel32" () As Long
Public Const WM_HOTKEY = &H312
Public Const GWL_WNDPROC = (-4)Public preWinProc As Long, MyhWnd As Long, uVirtKey As Long' Get the LOWORD
Public Function LOWORD(ByVal lngVal As Long) As Integer
    If lngVal And &H8000& Then
       LOWORD = &H8000 Or (lngVal And &H7FFF&)
   Else
       LOWORD = lngVal And &HFFFF&
   End If
End Function' Get the HIWORD
Public Function HIWORD(ByVal lngVal As Long) As Integer
   If lngVal And &H80000000 Then
       HIWORD = (lngVal \ 65535) - 1
   Else
       HIWORD = lngVal \ 65535
   End If
End FunctionPublic Function Wndproc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  If Msg = WM_HOTKEY Then '快捷键消息
    If HIWORD(lParam) = uVirtKey Then
        MsgBox "hello"    ' 处理你的快捷键
    End If
    
  End If
  Wndproc = CallWindowProc(preWinProc, hwnd, Msg, wParam, lParam)
End FunctionPublic Function RegisterKey(ByRef objForm As Form, ByVal btHotKey As Byte) As Boolean
    Dim lngReturn As Long
    Dim modifiers As Long
    preWinProc = GetWindowLong(objForm.hwnd, GWL_WNDPROC)
    lngReturn = SetWindowLong(objForm.hwnd, GWL_WNDPROC, AddressOf Wndproc)
    
    modifiers = 0
    uVirtKey = btHotKey
    
    lngReturn = RegisterHotKey(objForm.hwnd, &HBFFF&, modifiers, uVirtKey)
    If (lngReturn = 0) Then
        RegisterKey = False
    Else
        RegisterKey = True
    End If
    
End FunctionPublic Function UnRegisterKey()
    SetWindowLong Me.hwnd, GWL_WNDPROC, preWinProc
    UnregisterHotKey Me.hwnd, uVirtKey
End Function----------------------------------
用法很简单：
RegisterKey(Me, vbKeyF3)完了调用
UnRegisterKey()

Answer 9

经测试只有griefforyou(为你伤心) 符合本次问题，其他人的回答，不符合要求不能给分。
声明： 我要的不是快捷键的例子，那些东西我有，只是由于项目忙没时间看和修改，只用姚现成的。500分归所有。以下是给分的地址：http://expert.csdn.net/Expert/topic/2041/2041784.xml?temp=.4302637http://expert.csdn.net/Expert/topic/2041/2041790.xml?temp=.9922754http://expert.csdn.net/Expert/topic/2041/2041793.xml?temp=.7070581http://expert.csdn.net/Expert/topic/2041/2041792.xml?temp=.8053247