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é.

Boutons

Boutons

 
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 :

Message

Message

Cependant, si on exécute l’application en tant qu’administrateur, l’événement du bouton n’est pas déclenché.

Exécuter en tant qu'administrateur

Exécuter en tant qu'administrateur


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…

Share

Pages : 1 2 3 4 5 6

Lien permanent vers Maximiser l’utilisation de la barre des tâches de Windows 7 avec Delphi Rédigé par Whiler \\ Tags : , , , , ,

Une réponse pour “Maximiser l’utilisation de la barre des tâches de Windows 7 avec Delphi”

Laisser une réponse

(requis)

(requis)

*

;) (lol) (y) |-( (hi) 8-) (angel) :s (clap) (bow) (tmi) (:| plus »

Ce site utilise Akismet pour réduire les indésirables. En savoir plus sur comment les données de vos commentaires sont utilisées.