With TheData .uID = 0 .hwnd = frm.hwnd .cbSize = Len(TheData) .hIcon = frm.Icon.Handle .uFlags = NIF_ICON + NIF_TIP + NIF_MESSAGE .uCallbackMessage = TRAY_CALLBACK .uFlags = .uFlags Or NIF_MESSAGE .cbSize = Len(TheData) End With
Shell_NotifyIcon NIM_ADD, TheData End Sub Public Sub RemoveFromTray()
With TheData .uFlags = 0 End With
Shell_NotifyIcon NIM_DELETE, TheData
SetWindowLong TheForm.hwnd, GWL_WNDPROC, OldWindowProcEnd Sub Public Sub SetTrayTip(tip As String)
With TheData .szTip = tip & vbNullChar .uFlags = NIF_TIP End With
Shell_NotifyIcon NIM_MODIFY, TheDataEnd Sub
'*********************************************************************** '窗体frmTrayIcon，在其上先用菜单编辑器建立菜单，让它的Visible=false. '代码： '*********************************************************************** Option ExplicitPrivate Sub cmdExit_Click() Unload Me
End Sub Private Sub Form_Load() 'centers form Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2 'sets cbSize to the Length of TrayIcon TrayIcon.cbSize = Len(TrayIcon) ' Handle of the window used to handle messages - which is the this form TrayIcon.hWnd = Me.hWnd ' ID code of the icon TrayIcon.uId = vbNull ' Flags TrayIcon.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE ' ID of the call back message TrayIcon.ucallbackMessage = WM_MOUSEMOVE ' The icon - sets the icon that should be used TrayIcon.hIcon = imgIcon1.Picture ' The Tooltip for the icon - sets the Tooltip that will be displayed TrayIcon.szTip = "Mind's Tray Icon Example" & Chr$(0)
' Add icon to the tray by calling the Shell_NotifyIcon API 'NIM_ADD is a Constant - add icon to tray Call Shell_NotifyIcon(NIM_ADD, TrayIcon)
' Don't let application appear in the Windows task list App.TaskVisible = FalseEnd Sub Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)Static Message As Long Static RR As Boolean
'x is the current mouse location along the x-axis Message = X / Screen.TwipsPerPixelX
If RR = False Then RR = True Select Case Message ' Left double click (This should bring up a dialog box) Case WM_LBUTTONDBLCLK Me.Show ' Right button up (This should bring up a menu) Case WM_RBUTTONUP Me.PopupMenu mnuPopUp End Select RR = False End If
End Sub Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) TrayIcon.cbSize = Len(TrayIcon) TrayIcon.hWnd = Me.hWnd TrayIcon.uId = vbNull 'Remove icon for Tray Call Shell_NotifyIcon(NIM_DELETE, TrayIcon)
End Sub Private Sub mnuAbout_Click() frmAbout.ShowEnd SubPrivate Sub mnuChange_Click() 'checks to find what icon is currently displayed If TrayIcon.hIcon = imgIcon1.Picture Then 'changes the icon to display TrayIcon.hIcon = imgIcon2.Picture 'removes current icon from tray Call Shell_NotifyIcon(NIM_DELETE, TrayIcon) 'calls the API to add in new icon Call Shell_NotifyIcon(NIM_ADD, TrayIcon) Else 'changes the icon to display TrayIcon.hIcon = imgIcon1.Picture 'removes current icon from tray Call Shell_NotifyIcon(NIM_DELETE, TrayIcon) 'calls the API to add in new icon Call Shell_NotifyIcon(NIM_ADD, TrayIcon) End If
End Sub Private Sub mnuExit_Click() Unload MeEnd Sub '***************************************************** '建立模块Tray '代码： '*************************************************** Option Explicit'**Originally published by Ryan Heldt ([email protected]) '**Modified by Donovan Parks ([email protected])'Win32 API declaration Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean' Constants used to detect clicking on the icon Public Const WM_LBUTTONDBLCLK = &H203 Public Const WM_RBUTTONUP = &H205' Constants used to control the icon Public Const NIM_ADD = &H0 Public Const NIM_MODIFY = &H1 Public Const NIF_MESSAGE = &H1 Public Const NIM_DELETE = &H2 Public Const NIF_ICON = &H2 Public Const NIF_TIP = &H4' Used as the ID of the call back message Public Const WM_MOUSEMOVE = &H200' Used by Shell_NotifyIcon Public Type NOTIFYICONDATA cbSize As Long hWnd As Long uId As Long uFlags As Long ucallbackMessage As Long hIcon As Long szTip As String * 64 End Type'create variable of type NOTIFYICONDATA Public TrayIcon As NOTIFYICONDATA
Dim MyNot As NOTIFYICONDATA '定义一个托盘结构Private Sub Command1_Click() '鼠标按下删除按钮 Dim hh As Long With MyNot .hIcon = Form1.Icon '托盘图标指针 .hwnd = Form1.hwnd '窗体指针 .szTip = "" '弹出提示字符串 .uCallbackMessage = WM_USER + 100 '对应程序定义的消息 .uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE '标志 .uID = 1 '图标识别符 .cbSize = Len(MyNot) '计算该结构所占字节数 End With hh = Shell_NotifyIcon(NIM_DELETE, MyNot) '删除该图标 trayflag = False '图标删除后trayflag为假End SubPrivate Sub Command2_Click() '按下创建按钮 Dim hh As Long With MyNot .hIcon = Form1.Icon .hwnd = Form1.hwnd .szTip = "托盘图标" & Chr(&H0) .uCallbackMessage = WM_USER + 100 .uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE .uID = 1 .cbSize = Len(MyNot) End With hh = Shell_NotifyIcon(NIM_ADD, MyNot) '添加一个托盘图标 trayflag = True '图标添加后trayflag为真 Form1.Hide End Sub Private Sub Command3_Click() '修改托盘图标 Dim p Dim hh As Long Set p = LoadPicture(App.Path & "\xsqico1.ico") '导入一个新图标 With MyNot .hIcon = p '将托盘图标改为新图标 .hwnd = Form1.hwnd .szTip = "桥梁图标" & Chr(&H0) '更改提示信息 .uCallbackMessage = WM_USER + 100 .uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE .uID = 1 .cbSize = Len(MyNot) End With hh = Shell_NotifyIcon(NIM_MODIFY, MyNot) '修改托盘的某些特征 End Sub Private Sub Command4_Click() 'END按钮被按下 quit '调用退出函数Quit End SubPrivate Sub DBGrid1_Click() 'DBGrid1.Columns(0).AddItem "1" End Sub Private Sub Form_Load() gHW = Me.hwnd '取得本窗体指针 '下一句调用钩子函数，将自制消息处理函数钩入Windows的消息循环 hook Command2_Click End SubPublic Sub hook() '利用AddressOf取得消息处理函数WindowProc的指针，并将其传给SetWindowLong 'lpPrevWndProc用来存储原窗口的指针 lpPrevWndProc = SetWindowLong(gHW, GWL_WNDPROC, AddressOf WindowProc) End SubPublic Sub Unhook() '本子程序用原窗口的指针替换WindowProc函数的指针，即关闭子类、退出消息循环 Dim temp As Long temp = SetWindowLong(gHW, GWL_WNDPROC, lpPrevWndProc) End Sub Private Sub mnuhideForm_Click() '点中弹出菜单的‘隐藏’功能 Form1.Hide '将窗体隐藏 End Sub Private Sub mnumaxForm_Click() '点中弹出菜单的‘最大化’功能 formstatus (2) '窗体最大化 End Sub Private Sub mnuminForm_Click() '点中弹出菜单的‘最小化’功能 formstatus (1) '窗体最小化 End Sub Private Sub mnunorForm_Click() '点中弹出菜单的‘正常’功能 formstatus (0) '窗体还原到正常 End Sub Public Sub quit() '退出 If trayflag = True Then Command1_Click '托盘图标仍在，模拟按下‘删除’按钮 Unhook '退出消息循环 Unload Me '卸载窗体 End Sub Private Sub mnuQuit_Click() '点中弹出菜单的‘退出’功能 quit End Sub Public Sub formstatus(ByVal wstates) '根据传递的参数变化窗体的状态 Form1.WindowState = wstates '设置窗体的状态 Form1.Show '显示窗体 End Sub Private Sub mnu1_Click() formstatus (0) '窗体还原到正常 End SubPrivate Sub mnu2_Click() formstatus (1) End Sub模块内容： Option Explicit Type NOTIFYICONDATA cbSize As Long hwnd As Long uID As Long uFlags As Long uCallbackMessage As Long hIcon As Long szTip As String * 64 End Type Public a As Long '以下为 Shell_NotifyIcon将用到的常量 Public Const NIF_ICON = &H2 Public Const NIF_MESSAGE = &H1 Public Const NIF_TIP = &H4 Public Const NIM_ADD = &H0 Public Const NIM_DELETE = &H2 Public Const NIM_MODIFY = &H1 'Shell_NotifyIcon的函数声明 Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long '处理消息将用到的结构、常量、API声明 Type POINTAPI x As Long y As Long End Type Type Msg hwnd As Long message As Long wParam As Long lParam As Long time As Long pt As POINTAPI End Type Public Const WM_USER = &H400 Public Const WM_RBUTTONDOWN = &H204 Public Const WM_LBUTTONDOWN = &H201 Public Const GWL_WNDPROC = -4 Public trayflag As Boolean Global lpPrevWndProc As Long Global gHW 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 SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long '以下过程为消息循环处理 Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long If hw = Form1.hwnd And uMsg = WM_USER + 100 Then '检测到鼠标点动托盘图标 Select Case lParam Case WM_RBUTTONDOWN '鼠标右键按下 Form1.PopupMenu Form1.mnuhy '弹出菜单 Case WM_LBUTTONDOWN '鼠标左键按下 Form1.formstatus (0) Case Else End Select
自己摘函数把 我写的太乱了 Option ExplicitPublic OldWindowProc As Long Public TheForm As Form Public TheMenu As Menu '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 LongPublic Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPublic Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As LongPublic Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As LongPublic 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)Public Declare Function GetCurrentProcessId Lib "kernel32" () As LongPublic Declare Function GetCurrentProcess Lib "kernel32" () As LongPublic Declare Function RegisterServiceProcess Lib "kernel32" (ByVal dwProcessID As Long, ByVal dwType As Long) As LongPublic Const RSP_SIMPLE_SERVICE = 1 Public Const RSP_UNREGISTER_SERVICE = 0 Public Const WM_SYSCOMMAND = &H112 Public Const SC_MOVE = &HF010& Public Const SC_RESTORE = &HF120& Public Const SC_SIZE = &HF000& Public Const WM_USER = &H400 Public Const WM_LBUTTONUP = &H202 Public Const WM_MBUTTONUP = &H208 Public Const WM_RBUTTONUP = &H205 Public Const TRAY_CALLBACK = (WM_USER + 1001&) Public Const GWL_WNDPROC = (-4) Public Const GWL_USERDATA = (-21) Public Const NIF_ICON = &H2 Public Const NIF_TIP = &H4 Public Const NIM_ADD = &H0 Public Const NIF_MESSAGE = &H1 Public Const NIM_MODIFY = &H1 Public Const NIM_DELETE = &H2Public Type NOTIFYICONDATA cbSize As Long hwnd As Long uID As Long uFlags As Long uCallbackMessage As Long hIcon As Long szTip As String * 64 End TypePrivate TheData As NOTIFYICONDATA
Public Function NewWindowProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If Msg = TRAY_CALLBACK Then
If lParam = WM_LBUTTONUP Then
If TheForm.WindowState = vbMinimized Then _
TheForm.WindowState = TheForm.LastState
TheForm.SetFocus
Exit Function
End If
If lParam = WM_RBUTTONUP Then
TheForm.PopupMenu TheMenu
Exit Function
End If
End If
NewWindowProc = CallWindowProc(OldWindowProc, hwnd, Msg, wParam, lParam)End Function
Public Sub AddToTray(frm As Form, mnu As Menu)
Set TheForm = frm
Set TheMenu = mnu
OldWindowProc = SetWindowLong(frm.hwnd, GWL_WNDPROC, AddressOf NewWindowProc)
With TheData
.uID = 0
.hwnd = frm.hwnd
.cbSize = Len(TheData)
.hIcon = frm.Icon.Handle
.uFlags = NIF_ICON + NIF_TIP + NIF_MESSAGE
.uCallbackMessage = TRAY_CALLBACK
.uFlags = .uFlags Or NIF_MESSAGE
.cbSize = Len(TheData)
End With
Shell_NotifyIcon NIM_ADD, TheData
End Sub
Public Sub RemoveFromTray()
With TheData
.uFlags = 0
End With
Shell_NotifyIcon NIM_DELETE, TheData
SetWindowLong TheForm.hwnd, GWL_WNDPROC, OldWindowProcEnd Sub
Public Sub SetTrayTip(tip As String)
With TheData
.szTip = tip & vbNullChar
.uFlags = NIF_TIP
End With
Shell_NotifyIcon NIM_MODIFY, TheDataEnd Sub
'窗体frmTrayIcon，在其上先用菜单编辑器建立菜单，让它的Visible=false.
'代码：
'***********************************************************************
Option ExplicitPrivate Sub cmdExit_Click() Unload Me
End Sub
Private Sub Form_Load()
'centers form
Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2 'sets cbSize to the Length of TrayIcon
TrayIcon.cbSize = Len(TrayIcon)
' Handle of the window used to handle messages - which is the this form
TrayIcon.hWnd = Me.hWnd
' ID code of the icon
TrayIcon.uId = vbNull
' Flags
TrayIcon.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
' ID of the call back message
TrayIcon.ucallbackMessage = WM_MOUSEMOVE
' The icon - sets the icon that should be used
TrayIcon.hIcon = imgIcon1.Picture
' The Tooltip for the icon - sets the Tooltip that will be displayed
TrayIcon.szTip = "Mind's Tray Icon Example" & Chr$(0)
' Add icon to the tray by calling the Shell_NotifyIcon API
'NIM_ADD is a Constant - add icon to tray
Call Shell_NotifyIcon(NIM_ADD, TrayIcon)
' Don't let application appear in the Windows task list
App.TaskVisible = FalseEnd Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)Static Message As Long
Static RR As Boolean
'x is the current mouse location along the x-axis
Message = X / Screen.TwipsPerPixelX
If RR = False Then
RR = True
Select Case Message
' Left double click (This should bring up a dialog box)
Case WM_LBUTTONDBLCLK
Me.Show
' Right button up (This should bring up a menu)
Case WM_RBUTTONUP
Me.PopupMenu mnuPopUp
End Select
RR = False
End If
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) TrayIcon.cbSize = Len(TrayIcon)
TrayIcon.hWnd = Me.hWnd
TrayIcon.uId = vbNull
'Remove icon for Tray
Call Shell_NotifyIcon(NIM_DELETE, TrayIcon)
End Sub
Private Sub mnuAbout_Click() frmAbout.ShowEnd SubPrivate Sub mnuChange_Click() 'checks to find what icon is currently displayed
If TrayIcon.hIcon = imgIcon1.Picture Then
'changes the icon to display
TrayIcon.hIcon = imgIcon2.Picture
'removes current icon from tray
Call Shell_NotifyIcon(NIM_DELETE, TrayIcon)
'calls the API to add in new icon
Call Shell_NotifyIcon(NIM_ADD, TrayIcon)
Else
'changes the icon to display
TrayIcon.hIcon = imgIcon1.Picture
'removes current icon from tray
Call Shell_NotifyIcon(NIM_DELETE, TrayIcon)
'calls the API to add in new icon
Call Shell_NotifyIcon(NIM_ADD, TrayIcon)
End If
End Sub
Private Sub mnuExit_Click() Unload MeEnd Sub
'*****************************************************
'建立模块Tray
'代码：
'***************************************************
Option Explicit'**Originally published by Ryan Heldt ([email protected])
'**Modified by Donovan Parks ([email protected])'Win32 API declaration
Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean' Constants used to detect clicking on the icon
Public Const WM_LBUTTONDBLCLK = &H203
Public Const WM_RBUTTONUP = &H205' Constants used to control the icon
Public Const NIM_ADD = &H0
Public Const NIM_MODIFY = &H1
Public Const NIF_MESSAGE = &H1
Public Const NIM_DELETE = &H2
Public Const NIF_ICON = &H2
Public Const NIF_TIP = &H4' Used as the ID of the call back message
Public Const WM_MOUSEMOVE = &H200' Used by Shell_NotifyIcon
Public Type NOTIFYICONDATA
cbSize As Long
hWnd As Long
uId As Long
uFlags As Long
ucallbackMessage As Long
hIcon As Long
szTip As String * 64
End Type'create variable of type NOTIFYICONDATA
Public TrayIcon As NOTIFYICONDATA
Dim hh As Long
With MyNot
.hIcon = Form1.Icon '托盘图标指针
.hwnd = Form1.hwnd '窗体指针
.szTip = "" '弹出提示字符串
.uCallbackMessage = WM_USER + 100 '对应程序定义的消息
.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE '标志
.uID = 1 '图标识别符
.cbSize = Len(MyNot) '计算该结构所占字节数
End With
hh = Shell_NotifyIcon(NIM_DELETE, MyNot) '删除该图标
trayflag = False '图标删除后trayflag为假End SubPrivate Sub Command2_Click() '按下创建按钮
Dim hh As Long
With MyNot
.hIcon = Form1.Icon
.hwnd = Form1.hwnd
.szTip = "托盘图标" & Chr(&H0)
.uCallbackMessage = WM_USER + 100
.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
.uID = 1
.cbSize = Len(MyNot)
End With
hh = Shell_NotifyIcon(NIM_ADD, MyNot) '添加一个托盘图标
trayflag = True '图标添加后trayflag为真
Form1.Hide
End Sub Private Sub Command3_Click() '修改托盘图标
Dim p
Dim hh As Long Set p = LoadPicture(App.Path & "\xsqico1.ico") '导入一个新图标 With MyNot .hIcon = p '将托盘图标改为新图标 .hwnd = Form1.hwnd .szTip = "桥梁图标" & Chr(&H0) '更改提示信息 .uCallbackMessage = WM_USER + 100 .uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE .uID = 1 .cbSize = Len(MyNot) End With hh = Shell_NotifyIcon(NIM_MODIFY, MyNot) '修改托盘的某些特征 End Sub Private Sub Command4_Click() 'END按钮被按下
quit '调用退出函数Quit
End SubPrivate Sub DBGrid1_Click()
'DBGrid1.Columns(0).AddItem "1"
End Sub Private Sub Form_Load() gHW = Me.hwnd '取得本窗体指针 '下一句调用钩子函数，将自制消息处理函数钩入Windows的消息循环 hook
Command2_Click
End SubPublic Sub hook()
'利用AddressOf取得消息处理函数WindowProc的指针，并将其传给SetWindowLong
'lpPrevWndProc用来存储原窗口的指针
lpPrevWndProc = SetWindowLong(gHW, GWL_WNDPROC, AddressOf WindowProc)
End SubPublic Sub Unhook()
'本子程序用原窗口的指针替换WindowProc函数的指针，即关闭子类、退出消息循环
Dim temp As Long
temp = SetWindowLong(gHW, GWL_WNDPROC, lpPrevWndProc)
End Sub Private Sub mnuhideForm_Click() '点中弹出菜单的‘隐藏’功能
Form1.Hide '将窗体隐藏
End Sub Private Sub mnumaxForm_Click() '点中弹出菜单的‘最大化’功能
formstatus (2) '窗体最大化
End Sub Private Sub mnuminForm_Click() '点中弹出菜单的‘最小化’功能 formstatus (1) '窗体最小化 End Sub Private Sub mnunorForm_Click() '点中弹出菜单的‘正常’功能 formstatus (0) '窗体还原到正常 End Sub Public Sub quit() '退出 If trayflag = True Then Command1_Click '托盘图标仍在，模拟按下‘删除’按钮 Unhook '退出消息循环 Unload Me '卸载窗体 End Sub Private Sub mnuQuit_Click() '点中弹出菜单的‘退出’功能 quit End Sub Public Sub formstatus(ByVal wstates) '根据传递的参数变化窗体的状态 Form1.WindowState = wstates '设置窗体的状态 Form1.Show '显示窗体 End Sub Private Sub mnu1_Click()
formstatus (0) '窗体还原到正常
End SubPrivate Sub mnu2_Click()
formstatus (1)
End Sub模块内容：
Option Explicit Type NOTIFYICONDATA
cbSize As Long
hwnd As Long
uID As Long
uFlags As Long
uCallbackMessage As Long
hIcon As Long
szTip As String * 64
End Type Public a As Long
'以下为 Shell_NotifyIcon将用到的常量
Public Const NIF_ICON = &H2
Public Const NIF_MESSAGE = &H1
Public Const NIF_TIP = &H4
Public Const NIM_ADD = &H0
Public Const NIM_DELETE = &H2
Public Const NIM_MODIFY = &H1 'Shell_NotifyIcon的函数声明
Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long '处理消息将用到的结构、常量、API声明 Type POINTAPI
x As Long
y As Long
End Type Type Msg
hwnd As Long
message As Long
wParam As Long
lParam As Long
time As Long
pt As POINTAPI
End Type Public Const WM_USER = &H400
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_LBUTTONDOWN = &H201
Public Const GWL_WNDPROC = -4
Public trayflag As Boolean
Global lpPrevWndProc As Long
Global gHW 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 SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long '以下过程为消息循环处理 Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If hw = Form1.hwnd And uMsg = WM_USER + 100 Then '检测到鼠标点动托盘图标
Select Case lParam
Case WM_RBUTTONDOWN '鼠标右键按下
Form1.PopupMenu Form1.mnuhy '弹出菜单
Case WM_LBUTTONDOWN '鼠标左键按下
Form1.formstatus (0)
Case Else
End Select
Else '调用缺省窗口指针
WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
End If End Function
Option ExplicitPublic OldWindowProc As Long
Public TheForm As Form
Public TheMenu As Menu '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 LongPublic Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPublic Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As LongPublic Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As LongPublic 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)Public Declare Function GetCurrentProcessId Lib "kernel32" () As LongPublic Declare Function GetCurrentProcess Lib "kernel32" () As LongPublic Declare Function RegisterServiceProcess Lib "kernel32" (ByVal dwProcessID As Long, ByVal dwType As Long) As LongPublic Const RSP_SIMPLE_SERVICE = 1
Public Const RSP_UNREGISTER_SERVICE = 0
Public Const WM_SYSCOMMAND = &H112
Public Const SC_MOVE = &HF010&
Public Const SC_RESTORE = &HF120&
Public Const SC_SIZE = &HF000&
Public Const WM_USER = &H400
Public Const WM_LBUTTONUP = &H202
Public Const WM_MBUTTONUP = &H208
Public Const WM_RBUTTONUP = &H205
Public Const TRAY_CALLBACK = (WM_USER + 1001&)
Public Const GWL_WNDPROC = (-4)
Public Const GWL_USERDATA = (-21)
Public Const NIF_ICON = &H2
Public Const NIF_TIP = &H4
Public Const NIM_ADD = &H0
Public Const NIF_MESSAGE = &H1
Public Const NIM_MODIFY = &H1
Public Const NIM_DELETE = &H2Public Type NOTIFYICONDATA
cbSize As Long
hwnd As Long
uID As Long
uFlags As Long
uCallbackMessage As Long
hIcon As Long
szTip As String * 64
End TypePrivate TheData As NOTIFYICONDATA