1. Accueil
  2. Tous les snippets
  3. Snippets Visual Basic / VB.NET
  4. Mettre une icônes dans la barre de taches

Mettre une icônes dans la barre de taches

4/5 (16 avis)

Snippet vu 17 991 fois - Téléchargée 72 fois

Commenter

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

Ajouter un commentaire Commentaires
cs_Mauricet Messages postés 89 Date d'inscription lundi 3 mars 2003 Statut Membre Dernière intervention 28 juillet 2008
25 févr. 2006 à 16:00
Bonjour
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
brahim431 Messages postés 1 Date d'inscription vendredi 29 avril 2005 Statut Membre Dernière intervention 13 mai 2005
13 mai 2005 à 17:44
mais ou est le zip stp
cs_Urgo Messages postés 780 Date d'inscription lundi 16 décembre 2002 Statut Membre Dernière intervention 16 avril 2009 1
5 avril 2003 à 14:47
LE ZIPPPPPPP PLEASE !!!!!
moaleboss Messages postés 19 Date d'inscription lundi 20 janvier 2003 Statut Membre Dernière intervention 24 juillet 2007
31 janv. 2003 à 13:41
Ton code est vraiment super, mais si tu y metteia un zip ou quelque chose dans le genre, ca serai super.
Merci
cs_blabla Messages postés 112 Date d'inscription mercredi 28 août 2002 Statut Membre Dernière intervention 13 mars 2004
1 déc. 2002 à 14:53
vi .. le zip please
Afficher les 16 commentaires
S'inscrire maintenant

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.

Du même auteur (cs_Zarbiboss)