Option Explicit
 
' Konstanten für linke Maustaste
Private Const WM_LBUTTONDBLCLK = &H203   ' Doppelklick
Private Const WM_LBUTTONDOWN = &H201     ' Maus gedrückt
Private Const WM_LBUTTONUP = &H202       ' Maus losgelassen
 
' Konstanten für rechte Maustaste
Private Const WM_RBUTTONDBLCLK = &H206   ' Doppelklick
Private Const WM_RBUTTONDOWN = &H204     ' Maus gedrückt
Private Const WM_RBUTTONUP = &H205       ' Maus losgelassen
 
Private Const c_TrayDll As String = "SendToTrayDll.SendToTray"
 
Private m_SendTrayTool As Object
 
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
 
  On Error Resume Next
 
  If UnloadMode = vbFormControlMenu Then
 
 
    Set m_SendTrayTool = CreateObject(c_TrayDll)
    m_SendTrayTool.SendToTray Me
 
    Cancel = True
 
    ' Anwendung jetzt "verstecken"
    Me.Hide
 
  End If
 
End Sub
 
Private Sub Form_MouseMove(Button As Integer, _
  Shift As Integer, X As Single, Y As Single)
 
  ' Das MouseMove Ereignis wird ausgelöst, wenn die
  ' Maus über das Symbol im Systray geführt wird
 
  Dim lMsg As Long
  Dim sFilter As String
 
  lMsg = X / Screen.TwipsPerPixelX
  Select Case lMsg
     Case WM_LBUTTONDOWN
      ' linke Maustaste wird gedrückt
 
     Case WM_LBUTTONUP
      ' linke Maustaste wird losgelassen
 
     Case WM_LBUTTONDBLCLK
      ' linke Maustaste - Doppelklick
      Me.Show
 
     Case WM_RBUTTONDOWN
      ' rechte Maustaste wird gedrückt
 
     Case WM_RBUTTONUP
       ' rechte Maustaste wird losgelassen
       ' (jetzt z.B. Popup-Menü öffnen)
       PopupMenu mnuApp
 
     Case WM_RBUTTONDBLCLK
      ' rechte Maustaste - Doppeklick
 
  End Select
End Sub
 
Private Sub mnuPopup_Click(Index As Integer)
 
  Set m_SendTrayTool = Nothing
 
  Select Case Index
    Case 0
      ' Wiederherstellen
      Me.Show
 
    Case 1
      ' Beenden
      Unload Me
  End Select
 
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
  Set m_SendTrayTool = Nothing
End Sub

Option Explicit
 
'Api stuff
Private 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
 
Private Const NIM_ADD = &H0
Private Const NIM_MODIFY = &H1
Private Const NIM_DELETE = &H2
 
Private Const NIF_MESSAGE = &H1
Private Const NIF_ICON = &H2
Private Const NIF_TIP = &H4
 
Private Const WM_MOUSEMOVE = &H200
 
Private Declare Function Shell_NotifyIcon Lib _
  "shell32" Alias "Shell_NotifyIconA" ( _
  ByVal dwMessage As Long, _
  pnid As NOTIFYICONDATA) As Boolean
 
Private m_nid As NOTIFYICONDATA
Private m_ToBeDeleted As Boolean
 
Public Sub SendToTray(ByRef frm As Object)
 
  Dim myfrm As VB.Form
 
  On Error Resume Next
 
  If TypeOf frm Is VB.Form Then
    Set myfrm = frm
 
    ' Symbol der Anwendung zum SysTray hinzufügen
    With m_nid
      .cbSize = Len(m_nid)
      .hWnd = frm.hWnd
      .uId = vbNull
      .uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
      .uCallBackMessage = WM_MOUSEMOVE
      .hIcon = CopyIcon(frm.Icon)
      .szTip = Trim(frm.Caption) & vbNullChar
    End With
    Shell_NotifyIcon NIM_ADD, m_nid
    m_ToBeDeleted = True
  End If
 
End Sub
 
 
Private Sub Class_Initialize()
  m_ToBeDeleted = False
End Sub
 
Private Sub Class_Terminate()
 
  If m_ToBeDeleted Then
    Shell_NotifyIcon NIM_DELETE, m_nid
    DestroyIcon m_nid.hIcon
  End If
 
End Sub

Gruß
Dirk

--
?Get it right the first time