如何在窗体最小化时将其图标添加到系统托盘

[ebombsuhocom]

请指教

[「已注销」]

先用GetWindowLong取得WndProc（该窗口的消息处理函数），用SetWindowLong设置成自己的消息处理，（用CallWindowProc调用原来的函数），然后可以用HideWindow隐含窗口，用ShowWindow显示窗口。处理MYWM_NOTIFYICON消息（编号是(WM_APP+100)）系统托盘，WM_SIZE里的SIZE_MINIMIZED（最小化）

用Shell_NotifyIcon添加、删除、修改系统托盘内容：）

[vcmfc]

www.vckbase.com或www.vchelp.net上有相关的文章

[知行职场-雷曼]

这是两个文件一个是systray.ctl 另一个是systray.bas你把它存成相应的文件试试


systray.ctl
VERSION 5.00
Begin VB.UserControl cSysTray
CanGetFocus = 0 'False
ClientHeight = 510
ClientLeft = 0
ClientTop = 0
ClientWidth = 510
ClipControls = 0 'False
EditAtDesignTime= -1 'True
InvisibleAtRuntime= -1 'True
MouseIcon = "Systray.ctx":0000
Picture = "Systray.ctx":030A
ScaleHeight = 34
ScaleMode = 3 'Pixel
ScaleWidth = 34
End
Attribute VB_Name = "cSysTray"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'-------------------------------------------------------
' Control Property Globals...
'-------------------------------------------------------
Private gInTray As Boolean
Private gTrayId As Long
Private gTrayTip As String
Private gTrayHwnd As Long
Private gTrayIcon As StdPicture
Private gAddedToTray As Boolean
Const MAX_SIZE = 510

Private Const defInTray = False
Private Const defTrayTip = "VB 5 - SysTray Control." & vbNullChar

Private Const sInTray = "InTray"
Private Const sTrayIcon = "TrayIcon"
Private Const sTrayTip = "TrayTip"

'-------------------------------------------------------
' Control Events...
'-------------------------------------------------------
Public Event MouseMove(Id As Long)
Public Event MouseDown(Button As Integer, Id As Long)
Public Event MouseUp(Button As Integer, Id As Long)
Public Event MouseDblClick(Button As Integer, Id As Long)

'-------------------------------------------------------
Private Sub UserControl_Initialize()
'-------------------------------------------------------
gInTray = defInTray ' Set global InTray defalt
gAddedToTray = False ' Set default state
gTrayId = 0 ' Set global TrayId default
gTrayHwnd = hwnd ' Set and keep HWND of user control
'-------------------------------------------------------
End Sub
'-------------------------------------------------------

'-------------------------------------------------------
Private Sub UserControl_InitProperties()
'-------------------------------------------------------
InTray = defInTray ' Init InTray Property
TrayTip = defTrayTip ' Init TrayTip Property
Set TrayIcon = Picture ' Init TrayIcon property
'-------------------------------------------------------
End Sub
'-------------------------------------------------------

'-------------------------------------------------------
Private Sub UserControl_Paint()
'-------------------------------------------------------
Dim edge As RECT ' Rectangle edge of control
'-------------------------------------------------------
edge.Left = 0 ' Set rect edges to outer
edge.Top = 0 ' - most position in pixels
edge.Bottom = ScaleHeight '
edge.Right = ScaleWidth '
DrawEdge hDC, edge, BDR_RAISEDOUTER, BF_RECT Or BF_SOFT ' Draw Edge...
'-------------------------------------------------------
End Sub
'-------------------------------------------------------

'-------------------------------------------------------
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
'-------------------------------------------------------
' Read in the properties that have been saved into the PropertyBag...
With PropBag
InTray = .ReadProperty(sInTray, defInTray) ' Get InTray
Set TrayIcon = .ReadProperty(sTrayIcon, Picture) ' Get TrayIcon
TrayTip = .ReadProperty(sTrayTip, defTrayTip) ' Get TrayTip
End With
'-------------------------------------------------------
End Sub
'-------------------------------------------------------

'-------------------------------------------------------
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
'-------------------------------------------------------
With PropBag
.WriteProperty sInTray, gInTray ' Save InTray to propertybag
.WriteProperty sTrayIcon, gTrayIcon ' Save TrayIcon to propertybag
.WriteProperty sTrayTip, gTrayTip ' Save TrayTip to propertybag
End With
'-------------------------------------------------------
End Sub
'-------------------------------------------------------

'-------------------------------------------------------
Private Sub UserControl_Resize()
'-------------------------------------------------------
Height = MAX_SIZE ' Prevent Control from being resized...
Width = MAX_SIZE
'-------------------------------------------------------
End Sub
'-------------------------------------------------------

'-------------------------------------------------------
Private Sub UserControl_Terminate()
'-------------------------------------------------------
If InTray Then ' If TrayIcon is visible
InTray = False ' Cleanup and unplug it.
End If
'-------------------------------------------------------
End Sub
'-------------------------------------------------------

'-------------------------------------------------------
Public Property Set TrayIcon(Icon As StdPicture)
'-------------------------------------------------------
Dim Tray As NOTIFYICONDATA ' Notify Icon Data structure
Dim rc As Long ' API return code
'-------------------------------------------------------
If Not (Icon Is Nothing) Then ' If icon is valid...
If (Icon.Type = vbPicTypeIcon) Then ' Use ONLY if it is an icon
If gAddedToTray Then ' Modify tray only if it is in use.
Tray.uID = gTrayId ' Unique ID for each HWND and callback message.
Tray.hwnd = gTrayHwnd ' HWND receiving messages.
Tray.hIcon = Icon.Handle ' Tray icon.
Tray.uFlags = NIF_ICON ' Set flags for valid data items
Tray.cbSize = Len(Tray) ' Size of struct.

rc = Shell_NotifyIcon(NIM_MODIFY, Tray) ' Send data to Sys Tray.
End If

Set gTrayIcon = Icon ' Save Icon to global
Set Picture = Icon ' Show user change in control as well(gratuitous)
PropertyChanged sTrayIcon ' Notify control that property has changed.
End If
End If
'-------------------------------------------------------
End Property
'-------------------------------------------------------

'-------------------------------------------------------
Public Property Get TrayIcon() As StdPicture
'-------------------------------------------------------
Set TrayIcon = gTrayIcon ' Return Icon value
'-------------------------------------------------------
End Property
'-------------------------------------------------------

'-------------------------------------------------------
Public Property Let TrayTip(Tip As String)
Attribute TrayTip.VB_ProcData.VB_Invoke_PropertyPut = ";Misc"
Attribute TrayTip.VB_UserMemId = -517
'-------------------------------------------------------
Dim Tray As NOTIFYICONDATA ' Notify Icon Data structure
Dim rc As Long ' API Return code
'-------------------------------------------------------
If gAddedToTray Then ' if TrayIcon is in taskbar
Tray.uID = gTrayId ' Unique ID for each HWND and callback message.
Tray.hwnd = gTrayHwnd ' HWND receiving messages.
Tray.szTip = Tip & vbNullChar ' Tray tool tip
Tray.uFlags = NIF_TIP ' Set flags for valid data items
Tray.cbSize = Len(Tray) ' Size of struct.

rc = Shell_NotifyIcon(NIM_MODIFY, Tray) ' Send data to Sys Tray.
End If

gTrayTip = Tip ' Save Tip
PropertyChanged sTrayTip ' Notify control that property has changed
'-------------------------------------------------------
End Property
'-------------------------------------------------------

'-------------------------------------------------------
Public Property Get TrayTip() As String
'-------------------------------------------------------
TrayTip = gTrayTip ' Return Global Tip...
'-------------------------------------------------------
End Property
'-------------------------------------------------------

'-------------------------------------------------------
Public Property Let InTray(Show As Boolean)
Attribute InTray.VB_ProcData.VB_Invoke_PropertyPut = ";Behavior"
'-------------------------------------------------------
Dim ClassAddr As Long ' Address pointer to Control Instance
'-------------------------------------------------------
If (Show <> gInTray) Then ' Modify ONLY if state is changing!
If Show Then ' If adding Icon to system tray...
If Ambient.UserMode Then ' If in RunMode and not in IDE...
' SubClass Controls window proc.
PrevWndProc = SetWindowLong(gTrayHwnd, GWL_WNDPROC, AddressOf SubWndProc)

' Get address to user control object
'CopyMemory ClassAddr, UserControl, 4&

' Save address to the USERDATA of the control's window struct.
' this will be used to get an object refenence to the control
' from an HWND in the callback.
SetWindowLong gTrayHwnd, GWL_USERDATA, ObjPtr(Me) 'ClassAddr

AddIcon gTrayHwnd, gTrayId, TrayTip, TrayIcon ' Add TrayIcon to System Tray...
gAddedToTray = True ' Save state of control used in teardown procedure
End If
Else ' If removing Icon from system tray
If gAddedToTray Then ' If Added to system tray then remove...
DeleteIcon gTrayHwnd, gTrayId ' Remove icon from system tray

' Un SubClass controls window proc.
SetWindowLong gTrayHwnd, GWL_WNDPROC, PrevWndProc
gAddedToTray = False ' Maintain the state for teardown purposes
End If
End If

gInTray = Show ' Update global variable
PropertyChanged sInTray ' Notify control that property has changed
End If
'-------------------------------------------------------
End Property
'-------------------------------------------------------

'-------------------------------------------------------
Public Property Get InTray() As Boolean
'-------------------------------------------------------
InTray = gInTray ' Return global property
'-------------------------------------------------------
End Property
'-------------------------------------------------------

'-------------------------------------------------------
Private Sub AddIcon(hwnd As Long, Id As Long, Tip As String, Icon As StdPicture)
'-------------------------------------------------------
Dim Tray As NOTIFYICONDATA ' Notify Icon Data structure
Dim tFlags As Long ' Tray action flag
Dim rc As Long ' API return code
'-------------------------------------------------------
Tray.uID = Id ' Unique ID for each HWND and callback message.
Tray.hwnd = hwnd ' HWND receiving messages.

If Not (Icon Is Nothing) Then ' Validate Icon picture
Tray.hIcon = Icon.Handle ' Tray icon.
Tray.uFlags = Tray.uFlags Or NIF_ICON ' Set ICON flag to validate data item
Set gTrayIcon = Icon ' Save icon
End If

If (Tip <> "") Then ' Validate Tip text
Tray.szTip = Tip & vbNullChar ' Tray tool tip
Tray.uFlags = Tray.uFlags Or NIF_TIP ' Set TIP flag to validate data item
gTrayTip = Tip ' Save tool tip
End If

Tray.uCallbackMessage = TRAY_CALLBACK ' Set user defigned message
Tray.uFlags = Tray.uFlags Or NIF_MESSAGE ' Set flags for valid data item
Tray.cbSize = Len(Tray) ' Size of struct.

rc = Shell_NotifyIcon(NIM_ADD, Tray) ' Send data to Sys Tray.
'-------------------------------------------------------
End Sub
'-------------------------------------------------------

'-------------------------------------------------------
Private Sub DeleteIcon(hwnd As Long, Id As Long)
'-------------------------------------------------------
Dim Tray As NOTIFYICONDATA ' Notify Icon Data structure
Dim rc As Long ' API return code
'-------------------------------------------------------
Tray.uID = Id ' Unique ID for each HWND and callback message.
Tray.hwnd = hwnd ' HWND receiving messages.
Tray.uFlags = 0& ' Set flags for valid data items
Tray.cbSize = Len(Tray) ' Size of struct.

rc = Shell_NotifyIcon(NIM_DELETE, Tray) ' Send delete message.
'-------------------------------------------------------
End Sub
'-------------------------------------------------------

'-------------------------------------------------------
Friend Sub SendEvent(MouseEvent As Long, Id As Long)
'-------------------------------------------------------
Select Case MouseEvent ' Dispatch mouse events to control
Case WM_MOUSEMOVE
RaiseEvent MouseMove(Id)
Case WM_LBUTTONDOWN
RaiseEvent MouseDown(vbLeftButton, Id)
Case WM_LBUTTONUP
RaiseEvent MouseUp(vbLeftButton, Id)
Case WM_LBUTTONDBLCLK
RaiseEvent MouseDblClick(vbLeftButton, Id)
Case WM_RBUTTONDOWN
RaiseEvent MouseDown(vbRightButton, Id)
Case WM_RBUTTONUP
RaiseEvent MouseUp(vbRightButton, Id)
Case WM_RBUTTONDBLCLK
RaiseEvent MouseDblClick(vbRightButton, Id)
End Select
'-------------------------------------------------------
End Sub
'-------------------------------------------------------




'###########################################################
systray.bas
Attribute VB_Name = "mSysTray"
Option Explicit

'-------------------------------------------------------
' Api Declares....
'-------------------------------------------------------
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 SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal ByteLen As Long)
Public Declare Function DrawEdge Lib "user32" (ByVal hDC As Long, qrc As RECT, ByVal edge As Long, ByVal grfFlags As Long) As Boolean

'-------------------------------------------------------
' Api Constants...
'-------------------------------------------------------
Public Const GWL_USERDATA = (-21&)
Public Const GWL_WNDPROC = (-4&)
Public Const WM_USER = &H400&

Public Const TRAY_CALLBACK = (WM_USER + 101&)
Public Const NIM_ADD = &H0&
Public Const NIM_MODIFY = &H1&
Public Const NIM_DELETE = &H2&
Public Const NIF_MESSAGE = &H1&
Public Const NIF_ICON = &H2&
Public Const NIF_TIP = &H4&

Public Const WM_MOUSEMOVE = &H200&
Public Const WM_LBUTTONDOWN = &H201&
Public Const WM_LBUTTONUP = &H202&
Public Const WM_LBUTTONDBLCLK = &H203&
Public Const WM_RBUTTONDOWN = &H204&
Public Const WM_RBUTTONUP = &H205&
Public Const WM_RBUTTONDBLCLK = &H206&

'DrawEdge constants
Public Const BDR_RAISEDOUTER = &H1&
Public Const BDR_RAISEDINNER = &H4&
Public Const BF_LEFT = &H1& ' Border flags
Public Const BF_TOP = &H2&
Public Const BF_RIGHT = &H4&
Public Const BF_BOTTOM = &H8&
Public Const BF_RECT = BF_LEFT Or BF_TOP Or BF_RIGHT Or BF_BOTTOM
Public Const BF_SOFT = &H1000& ' For softer buttons

'-------------------------------------------------------
' Api Types....
'-------------------------------------------------------
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 Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Public PrevWndProc As Long

'------------------------------------------------------------
Public Function SubWndProc(ByVal hwnd As Long, ByVal MSG As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'------------------------------------------------------------
' This is the control subclassed window proc.
'------------------------------------------------------------
Dim SysTray As cSysTray ' SysTray class variable
Dim ClassAddr As Long ' long pointer to class object
'------------------------------------------------------------
Select Case MSG ' Determine
Case TRAY_CALLBACK ' Callback message received when user clicks on system tray...
' Retrieve long pointer to class object, this was saved in the _
USERDATA of the window struct. after the user control was subclassed...
ClassAddr = GetWindowLong(hwnd, GWL_USERDATA) ' get pointer to object
CopyMemory SysTray, ClassAddr, 4 ' Copy an unreferenced pointer to object into variable

SysTray.SendEvent lParam, wParam ' Send windows message\user event to control

CopyMemory SysTray, 0&, 4 ' Nullify object pointer
End Select

' Forward all messages to previous window procedure...(This must be done)
SubWndProc = CallWindowProc(PrevWndProc, hwnd, MSG, wParam, lParam)
'------------------------------------------------------------
End Function
'------------------------------------------------------------

[Bardo]

VERSION 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 Explicit

Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long

Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long

Const SW_RESTORE = 9

Const SW_SHOWNORMAL = 1

Private 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 Sub

Private Sub mnuAbout_Click()

frmAbout.Show

End Sub

Private 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 Me

End Sub



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 NOTIFYICONDATA