Mettre une icônes dans la barre de taches
Soyez le premier à donner votre avis sur cette source.
Snippet vu 17 717 fois - Téléchargée 70 fois
Contenu du snippet
Prenez un module, une form avec un bouton et mettez une icone a votre form.
Source / Exemple :
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
A voir également
- Wm_rbuttondown
- Setmenudefaultitem - Meilleures réponses
- Shell_notifyicona - Meilleures réponses
- C / C++ / C++.NET : Icone dans la barre des taches avec menu (vc++) - CodeS SourceS - Guide
- Delphi / Pascal : Icone dans la barre des taches - CodeS SourceS - Guide
- Delphi / Pascal : Mettre un icone dans la barre des taches , enlever , mettre ect... source + progra - Guide
- Delphi / Pascal : Trayicon - votre icone dans la barre des taches - CodeS SourceS - Guide
- Mettre un icone dans la barre des taches ✓ - Forum - C# / .NET
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
- Messages postés
-
780
- Date d'inscription
- lundi 16 décembre 2002
- Statut
- Membre
- Dernière intervention
- 16 avril 2009
1Merci
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.