--- Soumis par Dev Ashish ---
Sous-classement pour fonctionnalité du SysTray
Afficher des icônes de tâches dans le TaskBar est un des traits caractéristiques de Windows 98, Windows 95, et Windows NT 4.0. Pour manipuler un icône dans le Taskbar Status Area, on peut utiliser la fonction de l'API de Windows Shell_NotifyIcon du dll Shell32. Cette fonction nous permet d'ajouter, de modifier, d'effacer, d'ajouter un ToolTip et d'envoyer un message (callback) pour exécuter un événement pour la souris.
Cependant, puisque les formulaires d'Access sont déjà fortement sous-classés, il est nécessaire d'écrire du code supplémentaire pour réagir avec succès aux messages provenant du System Tray. Prendre note que la technique montrée ici n'est ni documentée, ni supportér, dans l'environement de Microsoft Office 97.
Note: Pour tester le code de cet article, vous devez avoir également le code pour AddressOf.
Créer un nouveau formulaire avec deux botuons, cmdStartDemo et cmdEndDemo, puis ajouter le code suivant dans le module de ce formulaire..
'************** Code Start ************* ' 'Si vrai, la fenêtre du formulaire est déjà sous-classée Private mblnSubclassed As Boolean Private Sub cmdEndDemo_Click() 'Décrocher le sous-classement Call sUnhookTrayIcon(Me) mblnSubclassed = False End Sub Private Sub cmdStartDemo_Click() If Not mblnSubclassed Then 'Ne pas essauer, et sous-classe deux fois Call sHookTrayIcon(Me, "fWndProcTray", "Hello World") 'si vous avez un icône en main, 'vous appelez plutôt sHookTrayIcon comme suit 'Call sHookTrayIcon(Me, "fWndProcTray", _ "Hello World", "D:\install\temp\face.ico") mblnSubclassed = True Else 'si déjà sous-classé, alors 'simplement cacher la fenête à nouveau Me.Visible = False End If End Sub Private Sub Form_Close() If mblnSubclassed Then 'décroche le sous-clasement et nettoyage Call sUnhookTrayIcon(Me) End If End Sub '************** Code End *************Create a new module and paste this code in it.
'************** Code Start ************* ' '------------------------------ ' Ne PAS parcourir ce code PAS-À-PAS. ' Entrer dans le mode de déverminage ' causera une erreur, GPF, si la fenêtre est ' sous-classée. '------------------------------ '//LoadImage flags Private Const WM_GETICON = &H7F 'un message est envoyé pour retrouver un handle _ à un petit ou à un grand icône associé à une fenêtre Private Const WM_SETICON = &H80 'message pour associer un icône à une fenêtre Private Const IMAGE_BITMAP = 0 'Charge un bitmap. Private Const IMAGE_ICON = 1 ' Charge un icône. Private Const IMAGE_CURSOR = 2 'Charge un curseur. Private Const LR_LOADFROMFILE = &H10 'Charge l'image du fichier spécifié par le _ paramètre lpszName. Si non spécifié _ lpszName est le nom d"une ressource Private Const ICON_SMALL = 0& 'Ramène le petit icône de la fenêtre. Private Const ICON_BIG = 1& 'Ramène le gros icône de la fenêtre. 'charge un icône, un curseur, ou un bitmap Private Declare Function apiLoadImage Lib "user32" _ Alias "LoadImageA" _ (ByVal hInst As Long, _ ByVal lpszName As String, _ ByVal uType As Long, _ ByVal cxDesired As Long, _ ByVal cyDesired As Long, _ ByVal fuLoad As Long) _ As Long Private Declare Function apiSendMessageLong Lib "user32" _ Alias "SendMessageA" _ (ByVal hWnd As Long, _ ByVal wMsg As Long, _ ByVal wParam As Long, _ ByVal lParam As Long) _ As Long '//SHGetFileInfo flags Private Const SHGFI_ICON = &H100 '// obtenir un icône Private Const SHGFI_DISPLAYNAME = &H200 '// obtenir le nom du display Private Const SHGFI_TYPENAME = &H400 '// obtenir le nom du type Private Const SHGFI_ATTRIBUTES = &H800 '// obtenir les attributs Private Const SHGFI_ICONLOCATION = &H1000 '// obtenir la localisation de l'icône Private Const SHGFI_EXETYPE = &H2000 '// retour d'un type exe Private Const SHGFI_SYSICONINDEX = &H4000 '// obtenir l'index de l'icône Private Const SHGFI_LINKOVERLAY = &H8000 '// place un lien (link overlay) sur l'icône Private Const SHGFI_SELECTED = &H10000 '// montrer l'icône en mode choisi Private Const SHGFI_ATTR_SPECIFIED = &H20000 '// obtenir seulement les attributs spécifiés Private Const SHGFI_LARGEICON = &H0 '// obtenir le gros icône Private Const SHGFI_SMALLICON = &H1 '// obtenir le petit icône Private Const SHGFI_OPENICON = &H2 '// get open icon Private Const SHGFI_SHELLICONSIZE = &H4 '// get shell size icon Private Const SHGFI_PIDL = &H8 '// pszPath is a pidl Private Const SHGFI_USEFILEATTRIBUTES = &H10 '// use passed dwFileAttribute Private Const FILE_ATTRIBUTE_NORMAL = &H80 Private Const MAX_PATH = 260 Private Type SHFILEINFO hIcon As Long 'Handle de l'icône représenté par le fichier iIcon As Long 'Index de l'image de l'icône dnas la liste _ d'images du système dwAttributes As Long 'Vecteur indicant les attributs _ de l'objet-fichier szDisplayName As String * MAX_PATH 'Chaîne contenant le nom du _ fichier tel qu'il appraît dans le shell de Windows szTypeName As String * 80 'Chaîne décrivant le type de fichier End Type 'Repère l'information relative à un objet dans le système de fichiers, 'tel qu'un fichier, un répertoire, une racine, ... Private Declare Function apiSHGetFileInfo Lib "shell32.dll" _ Alias "SHGetFileInfoA" _ (ByVal pszPath As String, _ ByVal dwFileAttributes As Long, _ psfi As SHFILEINFO, _ ByVal cbSizeFileInfo As Long, _ ByVal uFlags As Long) _ As Long Private Declare Function apiDestroyIcon Lib "user32" _ Alias "DestroyIcon" _ (ByVal hIcon As Long) _ As Long 'On le déclare ici de sorte qu'on puisse utiliser DestroyIcon plus loin Private psfi As SHFILEINFO '//ShowWindow flags Private Const SW_HIDE = 0 Private Const SW_SHOWNORMAL = 1 Private Const SW_SHOWMINIMIZED = 2 Private Const SW_SHOWMAXIMIZED = 3 'choisir l'état voulu de la fenêtre Private Declare Function apiShowWindow Lib "user32" _ Alias "ShowWindow" _ (ByVal hWnd As Long, _ ByVal nCmdShow As Long) _ As Long '//Shell_NotifyIcon Flags Private Const NIM_ADD As Long = &H0 'Ajouter un icône dans la zone du statut Private Const NIM_MODIFY As Long = &H1 'Modifier un icône dans la zone du statut Private Const NIM_DELETE As Long = &H2 'Efface un icône de la zone de statut '//NOTIFYICONDATA flags Private Const NIF_TIP As Long = &H4 ' szTip member est valide. Private Const NIF_MESSAGE As Long = &H1 'uCallbackMessage est valide Private Const NIF_ICON As Long = &H2 ' hIcon est valide '//Messages Private Const WM_MOUSEMOVE = &H200 'posté à une fenêtre lorsque le curseur bouge Private Const WM_LBUTTONDBLCLK = &H203 ' Double-clic gauche Private Const WM_LBUTTONDOWN = &H201 ' Bouton gauche enfoncé Private Const WM_LBUTTONUP = &H202 'Bouton gauche relâché Private Const WM_RBUTTONDBLCLK = &H206 ' Double-clic droit Private Const WM_RBUTTONDOWN = &H204 ' Bouton droit enfoncé Private Const WM_RBUTTONUP = &H205 ' Bouton droit relâché Private Type NOTIFYICONDATA cbSize As Long 'Dimension de cette structure, en octets hWnd As Long 'Handle de la fenêtre qui recevra _ le message de notification associé à un _ icône dans la zone du statut du taskbar uID As Long 'Icône d'dentification maison de l'application, _ sur le taskbar. uFlags As Long 'Vecteur de flags indiquant lequel des membres de la _ structure contient des données valides uCallbackMessage As Long 'Message callback défini par l'application hIcon As Long 'Handle de l'icône à ajouter, modifier, ou effacer szTip As String * 64 'Pointeur à une chaîne, terminée par le caractère null, _ fournissant le texte du ballon flottant d'aide (tooltip). End Type 'Envoie un message à la zone du statut du taskbar Private Declare Function apiShellNotifyIcon Lib "shell32.dll" _ Alias "Shell_NotifyIconA" _ (ByVal dwMessage As Long, _ lpData As NOTIFYICONDATA) _ As Long 'passe l'information du message à la procédure spécifiée Private Declare Function apiCallWindowProc 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 'change un attribut de la fenêtre spécifiée Private Declare Function apiSetWindowLong Lib "user32" _ Alias "SetWindowLongA" _ (ByVal hWnd As Long, _ ByVal nIndex As Long, _ ByVal wNewWord As Long) _ As Long Private nID As NOTIFYICONDATA Private lpPrevWndProc As Long Private mblnCustomIcon As Boolean Private Const GWL_WNDPROC As Long = (-4) 'Nouvelle addresse pour la procédure Function fWndProcTray(ByVal hWnd As Long, _ ByVal uMessage As Long, _ ByVal wParam As Long, _ ByVal lParam As Long) _ As Long 'reçoit le message indirectement depuis le système d'exploitation 'mais nou permet d'effectuer du travail supplémentaire 'pour quelques uns de ces messages ' On Error Resume Next Select Case lParam Case WM_LBUTTONUP: ' Bouton gauche relâché Call apiShowWindow(hWnd, SW_SHOWNORMAL) Case WM_LBUTTONDBLCLK: 'Bouton gauche, Double clic Call apiShowWindow(hWnd, SW_SHOWNORMAL) Case WM_LBUTTONDOWN: 'Bouton gauche enfoncé 'Debug.Print "Left Button Down" Case WM_RBUTTONDBLCLK: ' Double-clic droit 'Debug.Print "Right Button Double Click" Case WM_RBUTTONDOWN: 'Bouton droit, enoncé 'Debug.Print "Right button Down" Case WM_RBUTTONUP: 'Bouton droit, relâché Call apiShowWindow(hWnd, SW_SHOWNORMAL) End Select 'réflète les messages fWndProcTray = apiCallWindowProc( _ ByVal lpPrevWndProc, _ ByVal hWnd, _ ByVal uMessage, _ ByVal wParam, _ ByVal lParam) End Function Sub sHookTrayIcon(frm As Form, _ strFunction As String, _ Optional strTipText As String, _ Optional strIconPath As String) 'Initialise l'icône du tray If fInitTrayIcon(frm, strTipText, strIconPath) Then 'cacher le formulaire frm.Visible = False 'addresse du nouvau message handler pour Windows lpPrevWndProc = apiSetWindowLong(frm.hWnd, _ GWL_WNDPROC, _ AddrOf(strFunction)) End If End Sub Sub sUnhookTrayIcon(frm As Form) 'Restaure le message handler original Call apiSetWindowLong(frm.hWnd, _ GWL_WNDPROC, _ lpPrevWndProc) 'Enlève l'icône du SysTray Call apiShellNotifyIcon(NIM_DELETE, nID) 'Si un icône maison était utilisé, rétablir l'icône If mblnCustomIcon Then Call fRestoreIcon(frm.hWnd) End If 'Détruire l'icône Call apiDestroyIcon(psfi.hIcon) End Sub Private Function fExtractIcon() As Long ' Extraire l'icône associé au formulaire Access ' On Error GoTo ErrHandler Dim hIcon As Long 'Don't need the full file name as Access form shortcuts 'have MAF extension. The SHGFI_USEFILEATTRIBUTES 'lets us pass an "invalid" file name to SHGetFileInfo hIcon = apiSHGetFileInfo(".MAF", FILE_ATTRIBUTE_NORMAL, _ psfi, LenB(psfi), _ SHGFI_USEFILEATTRIBUTES Or _ SHGFI_SMALLICON Or SHGFI_ICON) 'S'assurer qu'il n'y a pas d'erreur If Not hIcon = 0 Then fExtractIcon = psfi.hIcon ExitHere: Exit Function ErrHandler: fExtractIcon = False Resume ExitHere End Function Private Function fRestoreIcon(hWnd As Long) 'Charger l'icône du formulaire, et l'assigner à la fenêtre Call apiSendMessageLong(hWnd, WM_SETICON, 0&, fExtractIcon()) End Function Private Function fSetIcon(frm As Form, strIconPath As String) As Long Dim hIcon As Long 'Icône 16x16 depuis un fichier hIcon = apiLoadImage(0&, strIconPath, IMAGE_ICON, 16&, 16&, LR_LOADFROMFILE) If hIcon Then 'S'occuper de l'icône du formulaire Call apiSendMessageLong(frm.hWnd, WM_SETICON, 0&, hIcon&) 'Se rappeler s'il faut rétablir l'icône mblnCustomIcon = True 'et retourner hIcon fSetIcon = hIcon End If End Function Private Function fInitTrayIcon(frm As Form, strTipText As String, strIconPath As String) As Boolean Dim hIcon As Long 'Utiliser une chaîne par défaut si l'usager n'en spécifie pas pour le tooltip If strTipText = vbNullString Then strTipText = "MSAccess Form" If (strIconPath = vbNullString) Or (Dir(strIconPath) = vbNullString) Then 's'il n'y a pas d'icône de spécifié, utiliser celui du formulaire hIcon = fExtractIcon() Else 'charge et afficher l'icône hIcon = fSetIcon(frm, strIconPath) End If 'Si tout va bien jusqu'à maintenant, continuer en 'plaçant l'icône dans le system tray If hIcon Then With nID .cbSize = LenB(nID) .hWnd = frm.hWnd .uID = vbNull .uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE .uCallbackMessage = WM_MOUSEMOVE .hIcon = hIcon .szTip = strTipText & vbNullChar End With Call apiShellNotifyIcon(NIM_ADD, nID) fInitTrayIcon = True End If End Function '************** Code End *************