vb6托盘右键菜单

vb6托盘右键菜单

 

 

菜单应用。

'系统托盘相关
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Call Shell_NotifyIcon(NIM_DELETE, nfIconData)
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
  Dim lMsg As Single
  lMsg = x / Screen.TwipsPerPixelX
  Select Case lMsg
    Case WM_LBUTTONUP
      'MsgBox "请用鼠标右键点击图标!", vbInformation, "实时播音专家"
      '单击左键，显示窗体
      ShowWindow Me.hWnd, SW_RESTORE
      '下面两句的目的是把窗口显示在窗口最顶层
      'Me.Show
      'Me.SetFocus
       Case WM_RBUTTONUP
       Dim r As RECT
    Dim p As POINTAPI
        GetCursorPos p
        TrackPopupMenu hmenupopup, 0, p.x, p.y, 0, Me.hWnd, r
      ' PopupMenu MenuTray '如果是在系统Tray图标上点右键，则弹出菜单MenuTray
      ' Case WM_MOUSEMOVE
      ' Case WM_LBUTTONDOWN
      ' Case WM_LBUTTONDBLCLK
      ' Case WM_RBUTTONDOWN
      ' Case WM_RBUTTONDBLCLK
      ' Case Else
  End Select
End Sub

 

新建一个类

'菜单
Public Declare Function CreateMenu Lib "user32" () As Long
Public Declare Function AppendMenu Lib "user32" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long
Public Declare Function TrackPopupMenu Lib "user32" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal x As Long, ByVal y As Long, ByVal nReserved As Long, ByVal hWnd As Long, lprc As RECT) As Long
Public Declare Function CreatePopupMenu Lib "user32" () As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong 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 GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Public Const MF_STRING = &H0&
Public Const MF_POPUP = &H10&
Public Const WM_USER = &H400
Public Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
Public Type POINTAPI
        x As Long
        y As Long
End Type
Public Const GWL_WNDPROC = (-4)
Public hMenu As Long
Public hmenupopup As Long
Public result As Long
Public oldwinproc As Long
Public Const WM_COMMAND = &H111
'菜单事件
Public Function OnMenu(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Select Case wMsg
        Case WM_COMMAND
            Select Case wParam
                Case 300
                    Form1.Show
                Case 301
                    MsgBox "本程序系电脑人工智能程序BATE版，当前版本：V 1.0.52 本程序测试自动识别指令并运行，后续增加逻辑判断。", vbInformation, "关于程序"
                Case 302
                  Close (Form1)
            End Select
    End Select
    OnMenu = CallWindowProc(oldwinproc, hWnd, wMsg, wParam, lParam)
End Function