level 1
'以下是模块Option ExplicitDeclare Function SetWindowLong Lib "USER32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongDeclare Function GetWindowLong Lib "USER32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As LongDeclare 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 LongDeclare Function RegisterHotKey Lib "USER32" (ByVal hwnd As Long, ByVal id As Long, ByVal fsModifiers As Long, ByVal vk As Long) As LongDeclare Function UnregisterHotKey Lib "USER32" (ByVal hwnd As Long, ByVal id As Long) As LongPublic Const WM_HOTKEY = &H312Public Const MOD_ALT = &H1Public Const MOD_CONTROL = &H2Public Const MOD_SHIFT = &H4Public Const GWL_WNDPROC = (-4)Public preWinProc As LongPublic Modifiers As Long, uVirtKey1 As Long, idHotKey As LongPrivate Type taLongll As LongEnd TypePrivate Type t2IntlWord As Integerhword As IntegerEnd TypePublic Function wndproc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As LongDim lp As taLong, i2 As t2IntIf Msg = WM_HOTKEY ThenIf wParam = idHotKey Thenlp.ll = lParamLSet i2 = lpIf (i2.lWord = Modifiers) And i2.hword = uVirtKey1 Then'------------------------------------------------------'这里面是快捷键代码,你可以随便改If Clipboard.GetText Like "*(*)*号码*DB*商品名称*游戏/区/服*商品件数*角色名*" ThenForm1.新订单_ClickEnd If'Form1.Visible = Not Form1.Visible'------------------------------------------------------End If'If 订单分析.HS1.Value = 1 Then'订单分析.HS1.Value = 订单分析.HS1.Value - 1'End IfEnd IfEnd If'如果不是热键信息则调用原来的程序wndproc = CallWindowProc(preWinProc, hwnd, Msg, wParam, lParam)End Function
2007年11月20日 07点11分
1
level 1
Public Function zhuce快捷键(窗体hwnd As Long, 快捷键ID As Long, 辅助键 As String, 主按键 As Long, 行为 As String) 'zhuce,强制zhuce,卸载'记录原来的window程序地址Dim ret As Long, iidHotKey = 快捷键ID 'in the range &h0000 through &hBFFFSelect Case 行为Case "zhuce", "强行zhuce"Select Case LCase(辅助键) Case "ctrl" Modifiers = MOD_CONTROL Case "alt" Modifiers = MOD_ALT Case "shift" Modifiers = MOD_SHIFT Case "ctrl+alt" Modifiers = MOD_CONTROL + MOD_ALT Case Is = "ctrl+shift" Modifiers = MOD_CONTROL + MOD_SHIFT Case Is = "ctrl+alt+shift" Modifiers = MOD_CONTROL + MOD_ALT + MOD_SHIFT Case Is = "shift+alt" Modifiers = MOD_SHIFT + MOD_ALT Case Else MsgBox "zhuce失败,辅助键错误", 0, "Error!" Exit FunctionEnd SelectuVirtKey1 = Val(主按键) 'zhuce的热键为Alt+QpreWinProc = GetWindowLong(窗体hwnd, GWL_WNDPROC)'用自定义程序代替原来的window程序ret = SetWindowLong(窗体hwnd, GWL_WNDPROC, AddressOf wndproc)'zhuce热键ret = RegisterHotKey(窗体hwnd, idHotKey, Modifiers, uVirtKey1)If ret = 0 Then If 行为 = " 强行zhuce" ThenSetWindowLong 窗体hwnd, GWL_WNDPROC, AddressOf wndproc '恢复窗口信息UnregisterHotKey 窗体hwnd, 快捷键ID '取消系统热键ElseMsgBox "zhuce热键失败,请使用其它热键!", vbCritical, "错误"End IfEnd IfCase "卸载"'取消Message的截取,使之送往原来的window程序ret = SetWindowLong(窗体hwnd, GWL_WNDPROC, preWinProc)Call UnregisterHotKey(窗体hwnd, uVirtKey1)End SelectEnd Function'以下是调用Call zhuce快捷键(Form1.hwnd, 1, "ctrl", vbKeyE, "zhuce")'Call zhuce快捷键(Form1.hwnd, 3, "ctrl", vbKeyQ, "zhuce")'Call zhuce快捷键(Form1.hwnd, 3, "ctrl", vbKeyRight, "zhuce")只zhuce一个的时候就没事zhuce2个快捷键马上程序就自动关闭,没有任何提示在调试模式下也一样谁知道问题在哪里???
2007年11月20日 07点11分
2
level 1
只zhuce一个的时候就没事 zhuce2个快捷键马上程序就自动关闭,没有任何提示 在调试模式下也一样
2007年11月20日 23点11分
4
level 0
我自己已经找到原因了`!!~~这段话preWinProc = GetWindowLong(窗体hwnd, GWL_WNDPROC)'用自定义程序代替原来的window程序ret = SetWindowLong(窗体hwnd, GWL_WNDPROC, AddressOf wndproc)改成If preWinProc = 0 ThenpreWinProc = GetWindowLong(窗体hwnd, GWL_WNDPROC)'用自定义程序代替原来的window程序ret = SetWindowLong(窗体hwnd, GWL_WNDPROC, AddressOf wndproc)End If
2007年11月21日 03点11分
5