vb实现老板键功能

很久没用vb了，做了个小东西，用着还挺顺手的 :)

frmmain.frm

'--------------------------------------------------------------------------------------- 
' Author        :阿汐 
' Purpose     :vb实现老板键的简单功能 
'--------------------------------------------------------------------------------------- 

Sub Form_Load()  Sub Form_Load() 
Dim ret  As Long 
preWinProc = GetWindowLong(Me.hwnd, GWL_WNDPROC) 
ret = SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf Wndproc) 
idHotKey = 1 
'按住ctrl+q实现切换 
Modifiers = MOD_CONTROL 
uVirtKey = vbKeyQ 
ret = RegisterHotKey(Me.hwnd, idHotKey, Modifiers, uVirtKey) 
'最小花到托盘 
TrayAddIcon frmmain, App.Path &  "\pbs.ico",  "系统托盘" 
End  Sub 

Sub Form_Unload()  Sub Form_Unload(Cancel  As Integer) 
Dim ret  As Long 
ret = SetWindowLong(Me.hwnd, GWL_WNDPROC, preWinProc) 
Call UnregisterHotKey(Me.hwnd, uVirtKey) 
'退出时移出托盘图标 
TrayRemoveIcon 
End  Sub 

Sub Form_Resize()  Sub Form_Resize() 

         '窗口最小化 
         If Me.WindowState = vbMinimized  Then Me.Hide 

End  Sub 

Sub Form_MouseMove()  Sub Form_MouseMove(Button  As Integer, Shift  As Integer, X  As Single, Y  As Single) 

         '气泡单击时的鼠标事件 
         Dim Result  As Long 
         Dim cEvent  As Single 
        cEvent = X / Screen.TwipsPerPixelX 

         Select  Case cEvent 

         Case MouseMove 
                TrayBalloon frmmain,  "一键隐藏程序 v0.1 By 阿汐", NIIF_INFO 
         Case LeftUp 

         Case LeftDown 
                frmmain.WindowState = 0 
                frmmain.Show 
         Case LeftDbClick 
                 
         Case MiddleUp 
             
         Case MiddleDown 
                
         Case MiddleDbClick 
                
         Case RightUp 
                
         Case RightDown 

         Case RightDbClick 

         Case BalloonClick 

         End  Select 

End  Sub 

Sub Label1_Click()  Sub Label1_Click() 

End  Sub 

Sub Label2_Click()  Sub Label2_Click() 

End  Sub 

 

bas_Main.bas

Option  Explicit 
Declare  Function FindWindow Lib  "user32" Alias  "FindWindowA" () Declare  Function FindWindow Lib  "user32" Alias  "FindWindowA" (ByVal lpClassName  As String, ByVal lpWindowName  As String)  As Long 
Declare  Function FindWindowEx Lib  "user32" Alias  "FindWindowExA" () Declare  Function FindWindowEx Lib  "user32"Alias  "FindWindowExA" (ByVal hWnd1  As Long, ByVal hWnd2  As Long, ByVal lpsz1  As String, ByVal lpsz2  As String)  As Long 
Declare  Function RegisterHotKey Lib  "user32" () 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 SetWindowPos Lib  "user32" () Declare  Function SetWindowPos Lib  "user32" (ByVal hwnd  As Long, ByVal hWndInsertAfter  As Long, ByVal X  As Long, ByVal Y  As Long, ByVal cx  As Long, ByVal cy  As Long, ByVal wFlags  As Long)  As Long 
Declare  Function SetWindowLong Lib  "user32" Alias  "SetWindowLongA" () Declare  Function SetWindowLong Lib  "user32" Alias  "SetWindowLongA" (ByVal hwnd  As Long, ByVal nIndex  As Long, ByVal dwNewLong  As Long)  As Long 
Declare  Function GetForegroundWindow Lib  "user32" () Declare  Function GetForegroundWindow Lib  "user32" ()  As Long 
Declare  Function ShowWindow Lib  "user32" () Declare  Function ShowWindow Lib  "user32" (ByVal hwnd  As Long, ByVal nCmdShow  As Long)  As Long 
Declare  Function CallWindowProc Lib  "user32" Alias  "CallWindowProcA" () 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  Sub keybd_event Lib  "user32" () Declare  Sub keybd_event Lib  "user32" (ByVal bVk  As Byte, ByVal bScan  AsByte, ByVal dwFlags  As Long, ByVal dwExtraInfo  As Long) 
Declare  Function GetWindowText Lib  "user32" Alias  "GetWindowTextA" () Declare  Function GetWindowText Lib  "user32" Alias  "GetWindowTextA" (ByVal hwnd  As Long, ByVal lpString  As String, ByVal cch  As Long)  As Long 
Public hw1  As Long 
Public CloseQuickKey  As Boolean  '是否可以退出 
Public AutoActivate  As Boolean  '是否为鼠标激活 
Public WindowStatus  As Boolean  '窗体状态（隐藏或显示） 
Public  Const WM_HOTKEY = &H312 
Public  Const WM_SYSCOMMAND = &H112 
Public  Const MOUSEEVENTF_ABSOLUTE = &H8000  ' absolute move 
Public  Const MOUSEEVENTF_LEFTDOWN = &H2 
Public  Const MOUSEEVENTF_LEFTUP = &H4 
Public  Const MOUSEEVENTF_RIGHTDOWN = &H8 
Public  Const MOUSEEVENTF_RIGHTUP = &H10 
Const GWL_WNDPROC = ()  Const GWL_WNDPROC = (-4) 
HotKeys() HotKeys(100, 3)  As String  '热键名称和运行的程序 
HotKeyValue() HotKeyValue(100, 2)  As Integer  '热键名所对应的值 
Public Username  As String * 30 
Public HideOrShow  As Boolean  '隐藏当前窗口 
Public HideWindowHnd  As Long  '被隐藏窗口的ID 
Public ActiveHwnd  As Long  '活动窗口的ID 
GetWindowLong Lib  "user32" Alias  "GetWindowLongA" () GetWindowLong Lib  "user32" Alias  "GetWindowLongA" (ByVal hwnd  As Long, ByVal nIndex  As Long)  As Long 
UnregisterHotKey Lib  "user32" () UnregisterHotKey Lib  "user32" (ByVal hwnd  As Long, ByVal id  As Long)  As Long 
Public  Const MOD_ALT = &H1 
Public  Const MOD_CONTROL = &H2 
Public  Const MOD_SHIFT = &H4 

Public preWinProc  As Long 

Public Modifiers  As Long, uVirtKey  As Long, idHotKey  As Long 

Private Type taLong 
ll  As Long 
End Type 

Private Type t2Int 
lWord  As Integer 
hWord  As Integer 
End Type 


Function Wndproc()  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 wParam = idHotKey  Then 
                 Dim lp  As taLong, i2  As t2Int 
                lp.ll = lParam 
                LSet i2 = lp 
                         If (i2.lWord = Modifiers)  And i2.hWord = uVirtKey  Then 
                                 If HideWindowHnd = 0&  Then 
                                        HideWindowHnd = GetForegroundWindow 
                                        ShowWindow HideWindowHnd, 0 
                                 Else 
                                        ShowWindow HideWindowHnd, 5 
                                        HideWindowHnd = 0& 
                                 End  If 
                         End  If 
         End  If 
End  If 
Wndproc = CallWindowProc(preWinProc, hwnd, Msg, wParam, lParam) 
End  Function 

 

bas_Tray.bas

'--------------------------------------------------------------------------------------- 
' Module        : modTray 
' DateTime    : 12/05/2005 21:38 
' Author        : Carlos Alberto S. 
' Purpose     : System tray module with high resolution icon (Windows XP), balloon (with 
'                             or without sound) and mouse event support for icon and balloon. 
'--------------------------------------------------------------------------------------- 

Option  Explicit 

'使用高分辨率图标所用的API 
Declare  Function LoadImage Lib  "user32" Alias  "LoadImageA" () Declare  Function LoadImage Lib  "user32" Alias  "LoadImageA" (ByVal hInst  As Long, ByVal lpsz  As String, ByVal dwImageType  As Long, ByVal dwDesiredWidth  As Long, ByVal dwDesiredHeight  As Long, ByVal dwFlags  As Long)  As Long 
Private  Const LR_LOADFROMFILE = &H10 
Private  Const LR_LOADMAP3DCOLORS = &H1000 
Private  Const IMAGE_ICON = 1 
'系统托盘 
Declare  Function Shell_NotifyIcon Lib  "shell32.dll" Alias  "Shell_NotifyIconA" () Declare  Function Shell_NotifyIcon Lib "shell32.dll" Alias  "Shell_NotifyIconA" (ByVal dwMessage  As Long, lpData  As NOTIFYICONDATA)  As Long 
Private  Const NIF_MESSAGE = &H1 
Private  Const NIF_ICON = &H2 
Private  Const NIF_TIP = &H4 
Private  Const NIF_STATE = &H8 
Private  Const NIF_INFO = &H10 
Private  Const NIM_ADD = &H0 
Private  Const NIM_MODIFY = &H1 
Private  Const NIM_DELETE = &H2 
Private  Const NIM_SETFOCUS = &H3 
Private  Const NIM_SETVERSION = &H4 
Private  Const NIM_VERSION = &H5 
Private  Const WM_USER  As Long = &H400 
Const NIN_BALLOONSHOW = ()  Const NIN_BALLOONSHOW = (WM_USER + 2) 
Const NIN_BALLOONHIDE = ()  Const NIN_BALLOONHIDE = (WM_USER + 3) 
Const NIN_BALLOONTIMEOUT = ()  Const NIN_BALLOONTIMEOUT = (WM_USER + 4) 
Const NIN_BALLOONUSERCLICK = ()  Const NIN_BALLOONUSERCLICK = (WM_USER + 5) 
Private  Const NOTIFYICON_VERSION = 3 
Private  Const NIS_HIDDEN = &H1 
Private  Const NIS_SHAREDICON = &H2 
Private  Const WM_NOTIFY  As Long = &H4E 
Private  Const WM_COMMAND  As Long = &H111 
Private  Const WM_CLOSE  As Long = &H10 
Private  Const WM_MOUSEMOVE  As Long = &H200 
Private  Const WM_LBUTTONDOWN  As Long = &H201 
Private  Const WM_LBUTTONUP  As Long = &H202 
Private  Const WM_LBUTTONDBLCLK  As Long = &H203 
Private  Const WM_MBUTTONDOWN  As Long = &H207 
Private  Const WM_MBUTTONUP  As Long = &H208 
Private  Const WM_MBUTTONDBLCLK  As Long = &H209 
Private  Const WM_RBUTTONDOWN  As Long = &H204 
Private  Const WM_RBUTTONUP  As Long = &H205 
Private  Const WM_RBUTTONDBLCLK  As Long = &H206 

Public Enum bFlag 
        NIIF_NONE = &H0 
        NIIF_INFO = &H1 
        NIIF_WARNING = &H2 
        NIIF_ERROR = &H3 
        NIIF_GUID = &H5 
        NIIF_ICON_MASK = &HF 
        NIIF_NOSOUND = &H10  '关闭提示音标志 
End Enum 

Private Type NOTIFYICONDATA 
        cbSize  As Long 
        hwnd  As Long 
        uID  As Long 
        uFlags  As Long 
        uCallbackMessage  As Long 
        hIcon  As Long 
        szTip  As String * 128 
        dwState  As Long 
        dwStateMask  As Long 
        szInfo  As String * 256 
        uTimeoutAndVersion  As Long 
        szInfoTitle  As String * 64 
        dwInfoFlags  As Long 
End Type 

'鼠标事件 
Public Enum TrayRetunEventEnum 
        MouseMove = &H200 
        LeftUp = &H202 
        LeftDown = &H201 
        LeftDbClick = &H203 
        RightUp = &H205 
        RightDown = &H204 
        RightDbClick = &H206 
        MiddleUp = &H208 
        MiddleDown = &H207 
        MiddleDbClick = &H209 
        BalloonClick = (WM_USER + 5) 
End Enum 

Public ni  As NOTIFYICONDATA 
Sub TrayAddIcon()  Sub TrayAddIcon(ByVal MyForm  As Form, ByVal MyIcon  As String, ByVal ToolTip  As String, Optional ByVal bFlag  As bFlag) 

         With ni 
                .cbSize =  Len(ni) 
                .hwnd = MyForm.hwnd 
                .uID = vbNull 
                .uFlags = NIF_ICON  Or NIF_TIP  Or NIF_MESSAGE 
                .uCallbackMessage = WM_MOUSEMOVE 
                .hIcon = LoadImage(App.hInstance, MyIcon, IMAGE_ICON, 16, 16, LR_LOADFROMFILE  Or LR_LOADMAP3DCOLORS) 
                .szTip = ToolTip & vbNullChar 
         End  With 
         
         Call Shell_NotifyIcon(NIM_ADD, ni) 

End  Sub 

Sub TrayRemoveIcon()  Sub TrayRemoveIcon() 

        Shell_NotifyIcon NIM_DELETE, ni 
         
End  Sub 

Sub TrayBalloon()  Sub TrayBalloon(ByVal MyForm  As Form, ByVal sBaloonText  As String, sBallonTitle  As String, Optional ByVal bFlag  As bFlag) 

         With ni 
                .cbSize =  Len(ni) 
                .hwnd = MyForm.hwnd 
                .uID = vbNull 
                .uFlags = NIF_INFO 
                .dwInfoFlags = bFlag 
                .szInfoTitle = sBallonTitle & vbNullChar 
                .szInfo = sBaloonText & vbNullChar 
         End  With 

        Shell_NotifyIcon NIM_MODIFY, ni 

End  Sub 

Sub TrayTip()  Sub TrayTip(ByVal MyForm  As Form, ByVal sTipText  As String) 

         With ni 
                .cbSize =  Len(ni) 
                .hwnd = MyForm.hwnd 
                .uID = vbNull 
                .uFlags = NIF_ICON  Or NIF_TIP  Or NIF_MESSAGE 
                .szTip = sTipText & vbNullChar 
         End  With 

        Shell_NotifyIcon NIM_MODIFY, ni 

End  Sub 

本文转自阿汐 51CTO博客，原文链接：http://blog.51cto.com/axiii/107832，如需转载请自行联系原作者