il faut faire un setforegroundwindow avant l'appel afin d'éviter ces désagréments...
Me.PopupMenu Form2.mnuFichier, vbPopupMenuRightButton
SetForegroundWindow me.hwnd
''****************************************************************** Déclaration des variable ***************************************************************** Public Const NOTIFYICON_VERSION = 3 Public Const NOTIFYICON_OLDVERSION = 0 Public Const NIM_ADD = &H0 Public Const NIM_MODIFY = &H1 Public Const NIM_DELETE = &H2 Public Const NIM_SETFOCUS = &H3 Public Const NIM_SETVERSION = &H4 Public Const NIF_MESSAGE = &H1 Public Const NIF_ICON = &H2 Public Const NIF_TIP = &H4 Public Const NIF_STATE = &H8 Public Const NIF_INFO = &H10 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 Public tooltip As String '*********************************************************************** Déclaration des fonction ************************************************************ 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 '************************************************************************ Déclaration d'objet ***************************************************************** Public m_IconData As NOTIFYICONDATA Public Type NOTIFYICONDATA cbSize As Long hwnd As Long uID As Long uFlags As Long uCallbackMessage As Long hIcon As Long szTip As String * 128 dwState As Long dwStateMask As Long szInfo As String * 256 uTimeout As Long szInfoTitle As String * 64 dwInfoFlags As Long End Type Public Sub unlodf() On Error Resume Next With m_IconData .cbSize = Len(m_IconData) .hwnd = Form2.hwnd .uID = vbNull .uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP .uCallbackMessage = WM_MOUSEMOVE .hIcon = Form2.Icon .szTip = "ChaT-Land" & vbNullChar .dwState = 0 .dwStateMask = 0 .dwInfoFlags = 1 .uTimeout = 3000 End With End Sub Public Sub bulleinfo() On Error Resume Next Dim s As String s = "" 'tooltip = "" tooltip = "TG continuera de fonctionner de sorte que vous puissiez relooker votre PC à tout moment." With m_IconData .cbSize = Len(m_IconData) .hwnd = Form2.hwnd .uID = vbNull .uFlags = NIF_ICON Or NIF_INFO Or NIF_MESSAGE Or NIF_TIP .uCallbackMessage = WM_MOUSEMOVE .hIcon = Form2.Icon .szTip = "TG" & vbNullChar .dwState = 0 .dwStateMask = 0 .szInfo = tooltip & Chr(0) .szInfoTitle = "TG est toujours en cours d'exécution" & Chr(0) .dwInfoFlags = 1 .uTimeout = 3000 End With Shell_NotifyIcon NIM_MODIFY, m_IconData End Sub Public Sub syst() Call unlodf Shell_NotifyIcon NIM_ADD, m_IconData Call bulleinfo End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) dim Msg As Long Msg = X / Screen.TwipsPerPixelX Select Case Msg Case WM_LBUTTONDBLCLK: tous_invi Image9.Visible = True lsitdmarge.Visible = True Form2.Show listapp.Nodes(listapp.Nodes.Count).Selected = True Case WM_LBUTTONDOWN: Case WM_LBUTTONUP: Case WM_RBUTTONDBLCLK: Case WM_RBUTTONDOWN: Case WM_RBUTTONUP: Me.PopupMenu Form2.mnuFichier, vbPopupMenuRightButton End Select End Sub
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre questionShell_NotifyIcon NIM_DELETE, m_IconData
.uID = vbNull
Private Sub quiter_Click() Shell_NotifyIcon NIM_DELETE, m_IconData end sub