QUICKLAUCHTRAY (LANCEUR DE LOGICIEL INTELLIGENT DANS LA BARRE DES TÂCHES)

' Conseil : N'utilisé le copier-collé de ce code que si vous êtes en train de visionner la compil, ou que vous êtes hors connexion, autrement, prenez le ZIP !

' Il faut : 	- une form
'		- 4 icônes (pour cet exemple !) : Leurs noms : Photo Gravure Surf Texte
' 		- un menu comprenant 4 menu de bases : Leurs noms : PhotoMenu GravureMenu SurfMenu TexteMenu et leurs sousmenu aux noms des applications
' Et copiez ce code :

Option Explicit
Dim Branche As Integer

Private Type IconeTray
    cbSize As Long      'Taille de l'icône (en octets)
    hWnd As Long        'Handle de la fenêtre chargée de recevoir les messages envoyés lors des évènements sur l'icône (clics, doubles-clics...)
    uID As Long         'Identificateur de l'icône
    uFlags As Long
    uCallbackMessage As Long    'Messages à renvoyer
    hIcon As Long               'Handle de l'icône
    szTip As String * 64        'Texte à mettre dans la bulle d'aide
End Type
Dim IconeT As IconeTray


'Constantes nécessaires
Private Const AJOUT = &H0
Private Const MODIF = &H1
Private Const SUPPRIME = &H2
Private Const MOUSEMOVE = &H200
Private Const MESSAGE = &H1
Private Const Icone = &H2
Private Const TIP = &H4

Private Const DOUBLE_CLICK_GAUCHE = &H203
Private Const BOUTON_GAUCHE_POUSSE = &H201
Private Const BOUTON_GAUCHE_LEVE = &H202
Private Const DOUBLE_CLICK_DROIT = &H206
Private Const BOUTON_DROIT_POUSSE = &H204
Private Const BOUTON_DROIT_LEVE = &H205

'API nécessaire
Private Declare Function Shell_NotifyIcon Lib "Shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As IconeTray) As Boolean

Private Sub Form_Load()
Branche = 1
'Préparation de la variable IconeT
IconeT.cbSize = Len(IconeT) 'Taille de l'icône en octet
IconeT.hWnd = Me.hWnd       'Handle de l'application (pour qu'elle reçoive les messages envoyés lors d'un clic, double-clic...
IconeT.uID = 1&             'Identificateur de l'icône
IconeT.uFlags = Icone Or TIP Or MESSAGE
IconeT.uCallbackMessage = MOUSEMOVE     'Renvoyer les messages concernant l'action de la souris
IconeT.hIcon = Surf.Picture   'Mettre en icône l'image qui est dans le contrôle "Surf"
IconeT.szTip = "" & Chr$(0)    'Texte de la bulle d'aide

'Appel de la fonction pour mettre l'icône dans le système tray
Shell_NotifyIcon AJOUT, IconeT
Me.Hide
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Static rec As Boolean, msg As Long

msg = X / Screen.TwipsPerPixelX
If rec = False Then
    rec = True
    Select Case msg
        Case BOUTON_GAUCHE_LEVE:
            Call Pop
        Case BOUTON_DROIT_LEVE:
            Call Change
    End Select
    rec = False
End If
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
IconeT.cbSize = Len(IconeT)
IconeT.hWnd = Me.hWnd
IconeT.uID = 1&
Shell_NotifyIcon SUPPRIME, IconeT
End Sub

Public Function Pop()
Select Case Branche
    Case 1
        PopupMenu SurfMenu
    Case 2
        PopupMenu GravureMenu
    Case 3
        PopupMenu PhotoMenu
    Case 4
        PopupMenu TexteMenu
End Select
End Function

Public Function Change()
If Branche < 4 Then Branche = Branche + 1 Else Branche = 1
Select Case Branche
    Case 1
        IconeT.hIcon = Surf.Picture
        Shell_NotifyIcon MODIF, IconeT
    Case 2
        IconeT.hIcon = Gravure.Picture
        Shell_NotifyIcon MODIF, IconeT
    Case 3
        IconeT.hIcon = Photo.Picture
        Shell_NotifyIcon MODIF, IconeT
    Case 4
        IconeT.hIcon = Texte.Picture
        Shell_NotifyIcon MODIF, IconeT
End Select
End Function

Private Sub BerlitzInterpreter_Click()
Call Shell("E:\Berlitz Interpreter 2.01\BERL2HEI.EXE", 1)
End Sub

Private Sub BlindRead_Click()
Call Shell("E:\blindwrite\BlindRead.exe", 1)
End Sub

Private Sub BlindWrite_Click()
Call Shell("E:\blindwrite\BlindWrite.exe", 1)
End Sub

Private Sub BlocNotes_Click()
Call Shell("C:\WINDOWS\NOTEPAD.EXE", 1)
End Sub

Private Sub CloneCD_Click()
Call Shell("E:\CloneCD\CloneCD.exe", 1)
End Sub

Private Sub CorelKnockOut_Click()
Call Shell("E:\CorelKnockOut\Programs\KnockOut.exe", 1)
End Sub

Private Sub Exel_Click()
Call Shell("E:\Office2000\Office\exel.exe", 1)
End Sub

Private Sub FlashGet_Click()
Call Shell("E:\KingGet\JetCar.exe", 1)
End Sub

Private Sub GMG3_Click()
Call Shell("E:\GMG3\movgear.exe", 1)
End Sub

Private Sub Goo_Click()
Call Shell("E:\Kai's Power Goo SE\POWERGOO.EXE", 1)
End Sub

Private Sub InternetExplorer_Click()
Call Shell("C:\Program Files\Internet Explorer\IEXPLORE.EXE", 1)
End Sub

Private Sub mIRC_Click()
Call Shell("E:\mIRC\mirc.exe", 1)
End Sub

Private Sub Néro_Click()
Call Shell("C:\Gravure\ahead\Nero\nero.exe", 1)
End Sub

Private Sub Oreka_Click()
Call Shell("c:\windows\notepad.exe C:\WINDOWS\Menu Démarrer\Programmes\Internet\Surf\Oreka.txt", 1)
End Sub

Private Sub OutlookExpress_Click()
Call Shell("C:\Program Files\Outlook Express\MSIMN.EXE", 1)
End Sub

Private Sub Paint_Click()
Call Shell("C:\Program Files\Accessoires\MSPAINT.EXE", 1)
End Sub

Private Sub PaintShopPro7_Click()
Call Shell("E:\Paint Shop Pro 7\psp.exe", 1)
End Sub

Private Sub PhotoDeLuxe_Click()
Call Shell("E:\PhotoDeLuxe\PD4.exe", 1)
End Sub

Private Sub PhotoShop6_Click()
Call Shell("E:\Photoshop6\Photoshp.exe", 1)
End Sub

Private Sub PowerPoint_Click()
Call Shell("E:\Office2000\OfficePowerPnt.exe", 1)
End Sub

Private Sub PrintArtist_Click()
Call Shell("E:\SIERRA\PRTARTST\PRTARTST.EXE", 1)
End Sub

Private Sub Publisher_Click()
Call Shell("E:\Office2000\Office\MsPub.exe", 1)
End Sub

Private Sub QuitterGravure_Click()
Unload Me
End Sub

Private Sub QuitterPhoto_Click()
Unload Me
End Sub

Private Sub QuitterSurf_Click()
Unload Me
End Sub

Private Sub QuitterTexte_Click()
Unload Me
End Sub

Private Sub Sychroniser_Click()
Call Shell("C:\WINDOWS\SYSTEM\MOBSYNC.EXE", 1)
End Sub

Private Sub Word2000_Click()
Call Shell("E:\Office2000\Office\WinWord.exe", 1)
End Sub

Private Sub Word97_Click()
Call Shell("E:\Office\Office\WINWORD.EXE", 1)
End Sub

Private Sub WordPad_Click()
Call Shell("C:\Program Files\Accessoires\WORDPAD.EXE", 1)
End Sub

Private Sub Works_Click()
Call Shell("E:\Works\MSWORKS.EXE", 1)
End Sub 

Télécharger le zip