Voilà ce aue j'utilise pour une appli genre server avec menu Start, Pause, Stop
Private Sub Form_Load()
On Error GoTo errHandler
' Hide the form to show only the systray icon.
Me.Visible = False
' Define the Tray options.
With nid
.cbSize = Len(nid)
.hWnd = Me.hWnd
.uId = vbNull
.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
.uCallBackMessage = WM_MOUSEMOVE
.hIcon = Me.Icon
.szTip = "My Application is running in the systray" & vbNullChar
End With
' Launch the Tray 'iconification'.
Shell_NotifyIcon NIM_ADD, nid
exit sub
errHandler:
debug.print "gestion generique des erreurs"
end sub
' This procedure receives the callbacks from the System Tray icon.
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Const PROC_NAME = "frmTray.Form_MouseMove"
On Error GoTo errHandler
Dim Result As Long
Dim Msg As Long
' The value of X will vary depending upon the scalemode setting
If Me.ScaleMode = vbPixels Then
Msg = x
Else
Msg = x / Screen.TwipsPerPixelX
End If
Select Case Msg
Case WM_RBUTTONUP '517 display popup menu by right-click
Result = SetForegroundWindow(Me.hWnd)
Me.PopupMenu mnuSysTray
End Select
Exit Sub
errHandler:
Screen.MousePointer = vbNormal
End Sub
' system management menus.
Private Sub mnuStart_Click()
On Error GoTo errHandler
' Update menus options.
mnuStart.Enabled = False
mnuStart.Caption = "&Start"
mnuPause.Enabled = True
mnuStop.Enabled = True
' Update tray icon.
nid.szTip = "Manager started" & vbNullChar
Shell_NotifyIcon NIM_MODIFY, nid
Exit Sub
errHandler:
Screen.MousePointer = vbNormal
End Sub
Private Sub mnuPause_Click()
On Error GoTo errHandler
' Update menus options.
mnuStart.Enabled = True
mnuStart.Caption = "&Resume"
mnuPause.Enabled = False
mnuStop.Enabled = True
' Update tray icon.
nid.szTip = "Manager paused" & vbNullChar
Shell_NotifyIcon NIM_MODIFY, nid
Exit Sub
errHandler:
Screen.MousePointer = vbNormal
End Sub
Private Sub mnuStop_Click()
On Error GoTo errHandler
' Update menus options.
mnuStart.Enabled = True
mnuStart.Caption = "&Start"
mnuPause.Enabled = False
mnuStop.Enabled = False
' Update tray icon.
nid.szTip = "Manager stopped" & vbNullChar
Shell_NotifyIcon NIM_MODIFY, nid
Exit Sub
errHandler:
Screen.MousePointer = vbNormal
End Sub
' Alert parameterizations menu.
Private Sub mnuQuit_Click()
On Error GoTo errHandler
If (MsgBox("Do you really want to shutdown the Server ?", vbQuestion + vbYesNo + vbDefaultButton2, "Diary Alert") = vbYes) Then
Shell_NotifyIcon NIM_DELETE, nid
Unload Me
End If
Exit Sub
errHandler:
Screen.MousePointer = vbNormal
Debug.Print "frmTray:mnuQuit_Click", Err.Number, Err.Description, Err.Source
End Sub
module basTray.bas
'this file is needed for the tray icon
'user defined type required by Shell_NotifyIcon API call
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
'constants required by Shell_NotifyIcon API call:
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 'Button down
Public Const WM_LBUTTONUP = &H202 'Button up
Public Const WM_LBUTTONDBLCLK = &H203 'Double-click
Public Const WM_RBUTTONDOWN = &H204 'Button down
Public Const WM_RBUTTONUP = &H205 'Button up
Public Const WM_RBUTTONDBLCLK = &H206 'Double-click
Public Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long
Public Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
Public nid As NOTIFYICONDATA
Avec çà, tu aura une icone dans le systray et tu peux affecter un menu (cache) à ton form pour utilisation en click droit !
Datatunning (Bruno)
|