Juin
23
|
Mise en œuvre des fonctions ThumbBarSetImageList, ThumbBarAddButtons & ThumbBarUpdateButtons
J’ai ajouté deux TButton
sur la fiche et un TImageList
.
J’ajoute trois icônes dans le TImageList
.
Je définis deux constantes qui contiendront le texte de mes info-bulles :
1 2 3 4 | const TEXT_0 = 'Vert'; TEXT_1 = 'Jaune'; TEXT_2 = 'Rouge'; |
Les événements OnClick
sont codés ainsi :
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 | procedure TfrmMain.btnDisplayThumbButtonsClick(Sender: TObject); var abtnButtons: array[0..2] of TThumbButton; begin // Spécification des boutons à ajouter https://msdn.microsoft.com/en-us/library/dd391559%28v=vs.85%29.aspx abtnButtons[0].iId := 0; // Un identifiant unique abtnButtons[0].iBitmap := 0; // L'index dans le TImageList utilisé StrCopy(abtnButtons[0].szTip, PChar(TEXT_0)); // L'info-bulle du bouton abtnButtons[0].dwMask := THB_BITMAP or THB_TOOLTIP or THB_FLAGS; // Une image avec une info-bulle https://msdn.microsoft.com/en-us/library/dd562322%28v=vs.85%29.aspx abtnButtons[0].dwFlags := THBF_ENABLED or THBF_NOBACKGROUND; // Voir les différents flags possible https://msdn.microsoft.com/en-us/library/dd562321%28v=vs.85%29.aspx abtnButtons[1].iId := 1; abtnButtons[1].iBitmap := 1; abtnButtons[1].dwMask := THB_BITMAP or THB_TOOLTIP or THB_FLAGS; abtnButtons[1].dwFlags := THBF_ENABLED or THBF_DISMISSONCLICK; StrCopy(abtnButtons[1].szTip, PChar(TEXT_1)); abtnButtons[2].iId := 2; abtnButtons[2].iBitmap := 2; abtnButtons[2].dwMask := THB_BITMAP or THB_TOOLTIP or THB_FLAGS; abtnButtons[2].dwFlags := THBF_DISABLED; StrCopy(abtnButtons[2].szTip, PChar(TEXT_2)); // Premier affichage ou mise à jour if (btnDisplayThumbButtons.Tag = 0) then begin // TImageList à utiliser tbl3.ThumbBarSetImageList(Self.Handle, imglThumbs.Handle); // Ajout de 3 boutons tbl3.ThumbBarAddButtons(Self.Handle, 3, @abtnButtons); end else begin // Mise à jour des boutons prédédemment créés tbl3.ThumbBarUpdateButtons(Self.Handle, 3, @abtnButtons); end; btnDisplayThumbButtons.Enabled := False; btnHideThumbButtons.Enabled := True; btnDisplayThumbButtons.Tag := btnDisplayThumbButtons.Tag + 1; end; |
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 | procedure TfrmMain.btnHideThumbButtonsClick(Sender: TObject); var abtnButtons: array[0..2] of TThumbButton; begin abtnButtons[0].iId := 0; abtnButtons[0].dwMask := THB_FLAGS; abtnButtons[0].dwFlags := THBF_HIDDEN; // Bouton masqué abtnButtons[1].iId := 1; abtnButtons[1].dwMask := THB_FLAGS; abtnButtons[1].dwFlags := THBF_HIDDEN; abtnButtons[2].iId := 2; abtnButtons[2].dwMask := THB_FLAGS; abtnButtons[2].dwFlags := THBF_HIDDEN; tbl3.ThumbBarUpdateButtons(Self.Handle, 3, @abtnButtons); btnDisplayThumbButtons.Enabled := True; btnHideThumbButtons.Enabled := False; end; |
Lorsque des boutons sont créés, ils sont persistants tant qu’on ne supprime pas la tâche, comme on l’a vu en page 2. C’est pourquoi, lorsque je veux les cacher, je modifie simplement une de leurs propriétés : abtnButtons[0].dwFlags := THBF_HIDDEN
Si l’on teste l’application telle qu’elle est actuellement, les boutons sont visibles, mais aucun événement ne leur est encore associé.
Pour leur associer du code, il faut ajouter une procédure qui va utiliser les identifiants uniques que l’on a définis sur chaque bouton :
1 2 | protected procedure WMCommand(var Message: TWMCommand); message WM_COMMAND; |
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 | procedure TfrmMain.WMCommand(var Message: TWMCommand); var sMsg: string; begin // Clic un bouton de la tâche if Message.NotifyCode = THBN_CLICKED then begin // Test de l'identifiant du bouton case Message.ItemID of 0: sMsg := TEXT_0; 1: sMsg := TEXT_1; 2: sMsg := TEXT_2; end; MessageDlg('Vous avez cliqué sur l''icône ' + sMsg + ' !', mtInformation, [mbOK], 0); end; inherited; end; |
Si l’on teste l’application, un message est effectivement affiché lorsque l’on clique sur un des deux premiers boutons :
Cependant, si on exécute l’application en tant qu’administrateur, l’événement du bouton n’est pas déclenché.
En effet, la tâche ne faisant pas partie de l’application elle-même, l’événement qu’elle envoie lors d’un clic à l’application est ignoré du fait de l’isolation entre le profil normal et celui de l’administrateur. Pour que cet événement soit transmis à l’application, celle-ci doit spécifier qu’elle accepte cet événement.
Pour cela, j’ai ajouté une constante et modifié le code de l’événement
OnCreate
de la fiche principale :1 2 | const MSGFLT_ADD = 1; |
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 | procedure TfrmMain.FormCreate(Sender: TObject); type // Pour obtenir les notifications des boutons de la tâche lorsque l'application est lancée en tant qu'administrateur TChangeWindowMessageFilterFunction = function(msg: Cardinal; action: Word): BOOL; stdcall; var hUser32 : Cardinal; ChangeWindowMessageFilter: TChangeWindowMessageFilterFunction; iLoop, iMax : Integer; begin // Windows 7 if CheckWin32Version(6, 1) then begin // Création des objets nécessaires tbl := CreateComObject(CLSID_TaskbarList) as ITaskbarList; tbl.HrInit; // Initialisation Supports(tbl, IID_ITaskbarList3, tbl3); // Appel dynamique pour permettre le "fonctionnement" sous XP, ... hUser32 := LoadLibrary('user32.dll'); if (hUser32 <> 0) then begin @ChangeWindowMessageFilter := GetProcAddress(hUser32, 'ChangeWindowMessageFilter'); if Assigned(ChangeWindowMessageFilter) then begin // Pour obtenir les notifications des boutons de la tâche lorsque l'application est lancée en tant qu'administrateur ChangeWindowMessageFilter(WM_COMMAND, MSGFLT_ADD); end else begin MessageDlg('Les messages des boutons de la tâche ne peuvent pas fonctionner si l''application est exécutée en tant qu''administrateur !', mtWarning, [mbOK], 0); end; FreeLibrary(hUser32); end else begin MessageDlg('User32.dll n''a pas été trouvé !', mtWarning, [mbOK], 0); end; end else begin // On n'est pas sous Windows 7 ; les composants sont désactivés iMax := Pred(ControlCount); for iLoop := 0 to iMax do begin if (Controls[iLoop] is TButton) then begin TButton(Controls[iLoop]).Enabled := False; end; end; trckbrProgress.Enabled := False; MessageDlg('Ces exemples ne fonctionnent que sous Windows 7 !', mtInformation, [mbOK], 0); end; end; |
Sur la dernière page, vous pourrez télécharger une archive avec le code source de l’application utilisée pour les captures d’écran de cet article…
Si vous cherchez encore plus d’informations, vous pourrez en trouver sur ces excellents articles :