如何将主窗口图标加入系统托盘，并使它响应左击，打开主程序

先建立个模块用来放一写申明：
代码如下：
Option Explicit
Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
Public Const WM_LBUTTONDBLCLK = &H203
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_RBUTTONUP = &H205
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
Public Const WM_MOUSEMOVE = &H200
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
Public TrayIcon As NOTIFYICONDATA再在窗体内写一过程
代码如下：
Sub MyTray()
    On Error Resume Next
    TrayIcon.cbSize = Len(TrayIcon)
    TrayIcon.hWnd = Me.hWnd
    TrayIcon.uId = vbNull
    TrayIcon.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
    TrayIcon.ucallbackMessage = WM_MOUSEMOVE
    TrayIcon.hIcon = Me.Icon
    TrayIcon.szTip = "你要显示的程序名" & Chr$(0)
    Call Shell_NotifyIcon(NIM_ADD, TrayIcon)
    App.TaskVisible = False
End Sub
在form_load中调用MyTray过程就在系统托盘上加了你的程序的图标了。
响应代码如下。我把鼠标的按键响应都给你吧。
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error GoTo err
Static Message As Long
Static RR As Boolean
     Message = X / Screen.TwipsPerPixelX
     If RR = False Then
        RR = True
        Select Case Message
           case WM_LBUTTONDBLCLK
           MsgBox "左键双击"
           Case WM_LBUTTONDOWN
           MsgBox "左键单击"
           case ······
        End Select
        RR = False
    End If
err:
End Sub
Message的常数我在声明中只声名了3个。你可以自己看api浏览器中的申明。自己来添加响应的代码。
to pp616(平平):
    thanks,比如金山词霸，或Norton Antivirus ,程序关闭后，图标还在，单击恢复主程序
Attribute VB_Name = "Tray"
Option Explicit
'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
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202' 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 NOTIFYICONDATAVERSION 5.00
Begin VB.Form frmTrayIcon
   Caption         =   "Mind's Tray Icon Example"
   ClientHeight    =   1485
   ClientLeft      =   2625
   ClientTop       =   2175
   ClientWidth     =   3480
   Icon            =   "TrayIcon.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   1485
   ScaleWidth      =   3480
   Begin VB.CommandButton cmdExit
      Caption         =   "E&xit"
      Height          =   375
      Left            =   1200
      TabIndex        =   0
      Top             =   840
      Width           =   1215
   End
   Begin VB.Image imgIcon2
      Height          =   480
      Left            =   1920
      Picture         =   "TrayIcon.frx":030A
      Top             =   240
      Width           =   480
   End
   Begin VB.Image imgIcon1
      Height          =   480
      Left            =   1200
      Picture         =   "TrayIcon.frx":074C
      Top             =   240
      Width           =   480
   End
   Begin VB.Menu mnuPopUp
      Caption         =   "PopUp_Menu"
      Visible         =   0   'False
      Begin VB.Menu mnuChange
         Caption         =   "Change &Icon"
      End
      Begin VB.Menu line2
         Caption         =   "-"
      End
      Begin VB.Menu mnuExit
         Caption         =   "E&xit"
      End
      Begin VB.Menu line
         Caption         =   "-"
      End
      Begin VB.Menu mnuAbout
         Caption         =   "&About"
      End
   End
End
Attribute VB_Name = "frmTrayIcon"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option ExplicitPrivate Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As LongPrivate Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As LongConst SW_RESTORE = 9Const SW_SHOWNORMAL = 1Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const WM_SYSCOMMAND = &H112
Private Const SC_MOVE = &HF010&
Private Const SC_RESTORE = &HF120&
Private Const SC_SIZE = &HF000&
Private 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 = False
    Me.Hide
End 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
            Case WM_LBUTTONUP
            'Me.Visible = True

                SendMessage Me.hwnd, WM_SYSCOMMAND, SC_RESTORE, 0&
                ShowWindow Me.hwnd, SW_SHOWNORMAL
                SetForegroundWindow Me.hwnd

'            ' Left double click (This should bring up a dialog box)
'            Case WM_LBUTTONDBLCLK
'                'Me.Visible = True
'
'                Me.Show
'
'                SetForegroundWindow Me.hwnd
'                Me.SetFocus
'            ' 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 Form_Resize()    If Me.WindowState = vbMinimized Then
     Me.Hide
    End If

End SubPrivate 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

调试易

如何将主窗口图标加入系统托盘，并使它响应左击，打开主程序

解决方案 »