Soyez le premier à donner votre avis sur cette source.
Snippet vu 17 717 fois - Téléchargée 70 fois
A mettre dans un module : 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 Const NIM_ADD = 0 Public Const NIM_MODIFY = 1 Public Const NIM_DELETE = 2 Public Const NIF_MESSAGE = 1 Public Const NIF_ICON = 2 Public Const NIF_TIP = 4 ' Public Const GWL_WNDPROC = -4 ' Public Const WM_LBUTTONDOWN = &H201 Public Const WM_RBUTTONDOWN = &H204 Public Const WM_LBUTTONDBLCLK = &H203 Public Const TPM_RIGHTALIGN = &H8& ' Public lpPrevWndProc As Long Public ghWnd As Long ' Declare Function Shell_NotifyIconA Lib _ "shell32" (ByVal dwMessage As Long, _ lpData As NOTIFYICONDATA) As Integer ' '*** Fonctions Windows *** ' 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 Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long Declare Function SetMenuDefaultItem Lib "user32" (ByVal hMenu As Long, ByVal uItem As Long, ByVal fByPos As Long) As Long Declare Function TrackPopupMenu Lib "user32" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal x As Long, ByVal y As Long, ByVal nReserved As Long, ByVal hwnd As Long, lprc As Any) As Long '************************* Public Sub IconToTray(frx As Form, msgTip$, Flag As Boolean) Dim nd As NOTIFYICONDATA Dim dMSG As Long Dim RetVal As Integer ' With nd .szTip = msgTip$ & Chr$(0) .cbSize = Len(nd) .hwnd = frx.hwnd .uID = 1 .uCallbackMessage = WM_LBUTTONDOWN .hIcon = frx.Icon .uFlags = NIF_MESSAGE Or NIF_ICON Or NIF_TIP End With ' If Flag Then dMSG = NIM_ADD Else dMSG = NIM_DELETE RetVal = Shell_NotifyIconA(dMSG, nd) End Sub Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long If hw = Form1.hwnd Then If lParam = WM_LBUTTONDBLCLK Then Form1.Show vbModeless ElseIf lParam = WM_RBUTTONDOWN Then MontrerMenu Else WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam) End If Else WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam) End If End Function Public Sub HookWindow() lpPrevWndProc = SetWindowLong(ghWnd, GWL_WNDPROC, AddressOf WindowProc) End Sub Public Sub Unhookwindow() Dim RetVal As Long ' RetVal = SetWindowLong(ghWnd, GWL_WNDPROC, lpPrevWndProc) End Sub Public Sub MontrerMenu() Dim hMenu As Long Dim hSousMenu As Long Dim RetVal As Long ' hMenu = GetMenu(frmMenu.hwnd) hSousMenu = GetSubMenu(hMenu, 0) ' SetMenuDefaultItem hSousMenu, 0, True With Screen w& = (.Width \ .TwipsPerPixelX) * 0.8 h& = (.Height \ .TwipsPerPixelY) End With RetVal = TrackPopupMenu(hSousMenu, TPM_RIGHTALIGN, w&, h&, 0&, frmMenu.hwnd, ByVal 0&) End Sub A mettre dans votre form : Option Explicit Private Sub Command1_Click() Unload Me End Sub Private Sub Form_Load() ghWnd = Me.hwnd HookWindow IconToTray Me, "CECI est un Test", True Me.Hide End Sub Private Sub Form_Unload(Cancel As Integer) IconToTray Me, "", False Unhookwindow End Sub
Beaucoup de fautes d'orthographe et de précipitations pour rien
Cela ne fonctionne pas
Le bon code avec Explicit
Public Sub MontrerMenu()
Dim hMenu As Long
Dim hSousmenu As Long
Dim RetVal As Long
Dim p As POINT_TYPE
Dim w As Long
Dim h As Long
GetCursorPos p
hMenu = GetMenu(frmmenu.hwnd)
hSousmenu = GetSubMenu(hMenu, 0)
'
SetMenuDefaultItem hSousmenu, 0, True
With Screen
w = p.x
h = p.y
End With
RetVal = TrackPopupMenu(hSousmenu, TPM_RIGHTALIGN, w&, h&, 0&, frmmenu.hwnd, ByVal 0&)
End Sub
Maurice
Merci
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.