Fil75 Писал и использовал давно, т.ч. ....
Создаешь модуль с именем systray. В него помещаешь следующее
[more]Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2001 VBnet, Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' You are free to use this code within your own applications,
' but you are expressly forbidden from selling or otherwise
' distributing this source code without prior written consent.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Required Public constants, types & declares
'for the Shell_Notify API method
Public Const NIM_ADD As Long = &H0
Public Const NIM_MODIFY As Long = &H1
Public Const NIM_DELETE As Long = &H2
Public Const NIF_ICON As Long = &H2 'adding an ICON
Public Const NIF_TIP As Long = &H4 'adding a TIP
Public Const NIF_MESSAGE As Long = &H1 'want return messages
'rodent constant we'll need for the callback
Public Const WM_LBUTTONDOWN As Long = &H201
Public Const WM_LBUTTONUP As Long = &H202
Public Const WM_LBUTTONDBLCLK As Long = &H203
Public Const WM_MBUTTONDOWN As Long = &H207
Public Const WM_MBUTTONUP As Long = &H208
Public Const WM_MBUTTONDBLCLK As Long = &H209
Public Const WM_RBUTTONDOWN As Long = &H204
Public Const WM_RBUTTONUP As Long = &H205
Public Const WM_RBUTTONDBLCLK As Long = &H206
'the actual workhorse
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 NID As NOTIFYICONDATA
Declare Function Shell_NotifyIcon Lib "shell32.dll" _
Alias "Shell_NotifyIconA" _
(ByVal dwMessage As Long, _
lpData As NOTIFYICONDATA) As Long[/more]
Еще один с именем winproc. В него помещаешь следующее
[more]Option Explicit
'defWindowProc: Variable to hold the ID of the
' default window message processing
' procedure. Returned by SetWindowLong.
Public defWindowProc As Long
'isSubclassed: flag indicating that subclassing
' has been done. Provides the means
' to call the correct message-handler.
Public isSubclassed As Boolean
'Activates and displays a window.
'If the window is minimized or maximized,
'the system restores it to its original size and position.
'An application should specify this flag when displaying
'the window for the first time.
Public Const SW_SHOWNORMAL = 1
'Private Const SW_HIDE = 0
'Private Const SW_SHOW = 5
Public Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, _
ByVal nCmdShow As Long) As Long
'Get/SetWindowLong messages
Public Const GWL_WNDPROC As Long = (-4)
Public Const GWL_HWNDPARENT As Long = (-8)
Public Const GWL_ID As Long = (-12)
Public Const GWL_STYLE As Long = (-16)
Public Const GWL_EXSTYLE As Long = (-20)
Public Const GWL_USERDATA As Long = (-21)
'general windows messages
Public Const WM_USER As Long = &H400
Public Const WM_MYHOOK As Long = WM_USER + 1
Public Const WM_NOTIFY As Long = &H4E
Public Const WM_COMMAND As Long = &H111
Public Const WM_CLOSE As Long = &H10
Public Declare Function SetForegroundWindow Lib "user32" _
(ByVal hWnd As Long) As Long
Public Declare Function PostMessage Lib "user32" Alias "PostMessageA" _
(ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Any) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" _
(ByVal lpPrevWndFunc As Long, _
ByVal hWnd As Long, _
ByVal uMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
'our own window message procedure
Public Function WindowProc(ByVal hWnd As Long, _
ByVal uMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
'window message procedure
'
'If the handle returned is to our form,
'call a form-specific message handler to
'deal with the tray notifications. If it
'is a general system message, pass it on to
'the default window procedure.
'
'If its ours, we look at lParam for the
'message generated, and react appropriately.
On Error Resume Next
Select Case hWnd
'form-specific handler
Case frmOrder.hWnd
Select Case uMsg
'check uMsg for the application-defined
'identifier (NID.uID) assigned to the
'systray icon in NOTIFYICONDATA (NID).
'WM_MYHOOK was defined as the message sent
'as the .uCallbackMessage member of
'NOTIFYICONDATA the systray icon
Case WM_MYHOOK
'lParam is the value of the message
'that generated the tray notification.
Select Case lParam
Case WM_RBUTTONUP:
'This assures that focus is restored to
'the form when the menu is closed. If the
'form is hidden, it (correctly) has no effect.
Call SetForegroundWindow(frmOrder.hWnd)
'show the menu
frmOrder.PopupMenu frmOrder.mnuPopUp
Case WM_LBUTTONDBLCLK:
frmOrder.mnuPopUpShow_Click
End Select
'handle any other form messages by
'passing to the default message proc
Case Else
WindowProc = CallWindowProc(defWindowProc, _
hWnd, _
uMsg, _
wParam, _
lParam)
Exit Function
End Select
'this takes care of messages when the
'handle specified is not that of the form
Case Else
WindowProc = CallWindowProc(defWindowProc, _
hWnd, _
uMsg, _
wParam, _
lParam)
End Select
End Function[/more]
В проект добавляешь функции. Вызываешь все это функцией AddToTray.
[more]Public Function AddToTray()
'add an icon to the system tray. If is
'is successful (returns 1) then subclass
'to intercept messages
If ShellTrayAdd = 1 Then
'prepare to receive the systray messages
SubClass Me.hWnd
Me.Hide
End If
End Function
Public Function ShellTrayAdd() As Long
'prepare the NOTIFYICONDATA type with the
'required parameters:
'.cbSize: Size of this structure, in bytes.
'
'.hwnd: Handle of the window that will receive
' notification messages associated with
' an icon in the taskbar status area.
'
'uID: Application-defined identifier of
' the taskbar icon. In an application
' with a single tray icon, this can be
' an arbitrary number. For apps with
' multiple icons, each icon ID must be
' different as this member identifies
' which of the icons was selected.
'
'.uFlags: flags that indicate which of the other
' members contain valid data. This member
' can be a combination of the following:
' NIF_ICON hIcon member is valid.
' NIF_MESSAGE uCallbackMessage member is valid.
' NIF_TIP szTip member is valid.
'
'uCallbackMessage: Application-defined message identifier.
' The system uses this identifier for
' notification messages that it sends
' to the window identified in hWnd.
' These notifications are sent when a
' mouse event occurs in the bounding
' rectangle of the icon. (Note: 'callback'
' is a bit misused here (in the context of
' other callback demonstrations); there is
' no systray-specific callback defined -
' instead the form itself must be subclassed
' to respond to this message.
'
'hIcon: Handle to the icon to add, modify, or delete.
'
'szTip: Tooltip text to display for the icon. Must
' be terminated with a Chr$(0).
'Shell_NotifyIcon messages:
'dwMessage: Message value to send. This parameter
' can be one of these values:
' NIM_ADD Adds icon to status area
' NIM_DELETE Deletes icon from status area
' NIM_MODIFY Modifies icon in status area
'
'pnid: Address of the prepared NOTIFYICONDATA.
' The content of the structure depends
' on the value of dwMessage.
strTemp = "abcd"
With NID
.cbSize = LenB(NID)
.hWnd = Me.hWnd
.uID = 125&
.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
.uCallbackMessage = WM_MYHOOK
.hIcon = Me.Icon
If strTemp <> "" Then
.szTip = LoadResString(1192) & "[" & strTemp & "]" & Chr$(0)
Else
.szTip = LoadResString(1192) & Chr$(0)
End If
End With
ShellTrayAdd = Shell_NotifyIcon(NIM_ADD, NID)
End Function
Private Sub SubClass(hWnd As Long)
'assign our own window message
'procedure (WindowProc)
On Error Resume Next
defWindowProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub
Private Sub UnSubClass()
'restore the default message handling
'before exiting
If defWindowProc Then
SetWindowLong frmOrder.hWnd, GWL_WNDPROC, defWindowProc
defWindowProc = 0
End If
End Sub
Private Sub ShellTrayRemove()
'Remove the icon from the taskbar Call Shell_NotifyIcon(NIM_DELETE, NID)
End Sub
Private Sub Form_Resize()
'If Tray = vbChecked Then
If Me.WindowState = vbMinimized Then
AddToTray
End If
'End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
If Tray = vbChecked Then
'Remove the icon added to the taskbar
ShellTrayRemove
'remove subclassing
UnSubClass
End If
'assure unloading proceeds
Cancel = False
End Sub
[/more]