Discussion :

[illuch]

Bonjour à tous,
Voici mon problème sur lequel je bute depuis plusieurs jours.

Je créé dynamiquement un PopupMenu.
ça fonctionne parfaitement : si je clique dessus, la coche apparait ou disparait selon le cas

je mets la propriété OwnerDraw à True et je dessine mon menu avec différentes couleurs, mais dans ce cas, les coches ont disparues et le click sur le popupmenu est sans effet.

Merci de votre aide

JLouis

[ShaiLeTroll]

C'est un peu le concept du OwnerDraw, le programme prend la responsabilité de tout le dessin

A savoir que la case à cocher c'est dessiné comme si c'était un glyph OBM_CHECK pour Windows et DrawElement si les thèmes sont actifs (tmPopupGutter, tmPopupCheckBackgroundNormal), tu vas devoir le recoder.

C'est AutoCheck à True qui provoque la permutation de Checked automatiquement.

[illuch]

Merci pour la réponse,

C'est un peu le concept du OwnerDraw, le programme prend la responsabilité de tout le dessin
.... tu vas devoir le recoder.
.

J'avais bien compris qu'il faudrait surement que je recode la coche,

Mais ce qui me préoccupe, c'est que dès je mets OwnerDraw à True, de ne plus pouvoir me servir du click sur le popupmenu.

J'ai du code associé à chaque Item du menu et ça ne fonctionne plus.

JL

[ShaiLeTroll]

C'est déjà plus curieux car j'ai fait le test, sur D10, cela conserve le OnClick (même avec un texte vide car j'ai pas chercher à coder l'event)

Delphi ? la Version ?
En XE2, par exemple, les thèmes n'étaient pas appliqué sur le PopupMenu, cela te laisse une liberté pour "Hacker" la méthode protégée AdvancedDrawItem en jouant sur le Canvas

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
  TMenuItem = class(Vcl.Menus.TMenuItem)
  public
    procedure DrawColorMenu(AFontColor, ABrushColor: TColor; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState);
  end;

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
 
procedure TForm1.Menu1AdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState);
begin
  TMenuItem(Sender).DrawColorMenu(clWhite, clBlue, ACanvas, ARect, State);
end;
 
//------------------------------------------------------------------------------
procedure TMenuItem.DrawColorMenu(AFontColor, ABrushColor: TColor; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState);
var
  OldAMDIE: TAdvancedMenuDrawItemEvent;
begin
  ACanvas.Font.Color := AFontColor;
  ACanvas.Brush.Color := ABrushColor;
 
  OldAMDIE := OnAdvancedDrawItem;
  OnAdvancedDrawItem := nil;
  try
    AdvancedDrawItem(ACanvas, ARect, State, GetParentComponent() is TMainMenu)
  finally
    OnAdvancedDrawItem := OldAMDIE;
  end;
end;

En D10, cela ne fonctionne plus !
Déjà les menus ont un thème VCL actif
La fonction AdvancedDrawItem recalcule les couleurs de ACanvas dont cette vieille tricherie ne fonctionne plus ...
D'ailleurs, en thème VCL actif, en OwnerDraw à True et sans code dans AdvancedDrawItem ... le Background du thème est dessiné, donc il y a déjà des éléments présents, il faut donc dessiner par dessus en Transparence.

Je dois avoir un code plus vieux pour BCB6 ... si je le retrouve.

[ShaiLeTroll]

J'ai retrouvé une version d'un EXE compilé XE2, et je confirme, les menus n'étaient pas thêmés et facilement redessinable
Même Projet plus récent (juste plus le même SGBD cible) mais depuis repris en D10, on voit le thème appliqué

[illuch]

Bonjour à tous,
Je reprends la discussion car je ne suis pas encore arrivé à mon but.

j'arrive sans problème à colorier les items de mon popupmenu en fonction de l'état coché ou non coché.
Voici le résultat :

sans sans rien faire j'obtiens ceci :

Je voudrais que mon menu colorié comporte les coches;

voici mon code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
procedure TForm1.PopItemDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect;Selected: Boolean);
var  Y:integer;
     i:integer;
     MonImage:string;
begin
 MonImage:='C:\...\MyCoche.bmp';
 if  not selected then  begin
   for i:=0 to 4 do begin // affichage de tous les éléments de menu
       Y :=5+21*i;
       if PopupMenu1.Items[i].Checked=True then  begin
        Acanvas.Pen.Color := clWhite;
        Acanvas.Brush.Color := clAqua;
        Acanvas.TextOut(20,Y,PopupMenu1.Items[i].Caption);
       end else begin
         Acanvas.Pen.Color := clBlack;
         Acanvas.Brush.Color := clLime;
         Acanvas.TextOut(20,Y,PopupMenu1.Items[i].Caption);
        end;
   end;
 end  ; // fin de if not selected then  begin
end;

Merci de votre aide

JL

[ShaiLeTroll]

Comme évoqué, vous devez le redessiner vous même ou en XE2 (sachant que cela fonctionnera plus en D10),
Pouvez-vous utiliser l'astuce de AdvancedDrawItem via DrawColorMenu dans le message précédent ?

Si cela fonctionne avec DrawColorMenu fourni ci-dessus, pas besoin de faire le dessin.

Sinon, si vous souhaitez le faire manuellement, c'est à vous de tout refaire, une astuce est d'utiliser une image transparente pour dessiner la coche, utiliser un TBitmap, LoadFromFile, DrawTo ... ce n'est pas en mettant le nom d'un fichier que cela va se faire tout seul.

N'oubliez pas le OnMesureItem pour avoir la bonne largeur laissant la place pour dessiner la case à cocher.

La boucle me choque un peu !
OnDrawItem est appelé pour chaque item déjà ! non ?

[ShaiLeTroll]

Pendant une réunion inutile, j'en profite pour me détendre avec ce code en D10

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
54
55
56
57
58
59
60
61
62
63
64
65
66
67
 
procedure TForm1.mnuDessinAllAdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState);
 
  procedure DrawChecked();
  var
    Glyph: TBitmap;
    OldBrushColor: TColor;
    GlyphRect: TRect;
  begin
    Glyph := TBitmap.Create;
    try
      Glyph.Transparent := True;
 
      Glyph.Handle := LoadBitmap(0, PChar(OBM_CHECK));
      OldBrushColor := ACanvas.Font.Color;
      try
        ACanvas.Font.Color := clRed; // Oui la couleur de la case à cocher est modifié par Font ou Pen Color ... étrange mais bon ça fonctionne
 
        GlyphRect.Left := ARect.Left + 1;
        GlyphRect.Top := ARect.Top + 1;
        GlyphRect.Right := GlyphRect.Left + 16;
        GlyphRect.Bottom := GlyphRect.Top + 16;
 
        ACanvas.Draw(
          GlyphRect.Left + (GlyphRect.Right - GlyphRect.Left - Glyph.Width) div 2 + 1,
          GlyphRect.Top + (GlyphRect.Bottom - GlyphRect.Top - Glyph.Height) div 2 + 1,
          Glyph);
      finally
        ACanvas.Font.Color := OldBrushColor;
      end;
    finally
      Glyph.Free();
    end;
  end;
 
const
  PEN_COLORS: array[Boolean] of TColor = (clBlack, clYellow);
  BRUSH_COLORS: array[Boolean] of TColor = (clLime, clAqua);
var
  MenuRect: TRect;
  DrawStyle: Longint;
  Text: string;
begin
  ACanvas.Font.Color := PEN_COLORS[TMenuItem(Sender).Checked];
  ACanvas.Pen.Color := PEN_COLORS[TMenuItem(Sender).Checked];
  ACanvas.Brush.Color := BRUSH_COLORS[TMenuItem(Sender).Checked];
 
  if odSelected in State then
    ACanvas.Rectangle(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom)
  else
    ACanvas.FillRect(ARect);
 
  if TMenuItem(Sender).Checked then
    DrawChecked();
 
  ARect.Left := ARect.Left + 1 + 16*2 + 2;
  DrawStyle := DT_EXPANDTABS or DT_SINGLELINE or DT_LEFT;
 
  Text := TMenuItem(Sender).Caption;
  ARect.Top := ARect.Top + 2;
  DrawText(ACanvas.Handle, Text, Length(Text), ARect, DrawStyle);
end;
 
procedure TForm1.mnuDessinAllMeasureItem(Sender: TObject; ACanvas: TCanvas; var Width, Height: Integer);
begin
  Width := Width + 16;
end;

Très important, l'affectation des Gestionnaires:

Code dfm :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
object MainMenu1: TMainMenu
    OwnerDraw = True
    Left = 192
    Top = 88
    object mnuFichier: TMenuItem
      Caption = 'Fichier'
    end
    object mnuDessin: TMenuItem
      Caption = 'Dessin'
      object mnuDessinUn: TMenuItem
        AutoCheck = True
        Caption = 'Un'
        OnAdvancedDrawItem = mnuDessinAllAdvancedDrawItem
        OnMeasureItem = mnuDessinAllMeasureItem
      end
      object mnuDessinDeux: TMenuItem
        AutoCheck = True
        Caption = 'Deux'
        OnAdvancedDrawItem = mnuDessinAllAdvancedDrawItem
        OnMeasureItem = mnuDessinAllMeasureItem
      end
      object mnuDessinTrois: TMenuItem
        AutoCheck = True
        Caption = 'Trois'
        OnAdvancedDrawItem = mnuDessinAllAdvancedDrawItem
        OnMeasureItem = mnuDessinAllMeasureItem
      end
      object mnuDessinQuatre: TMenuItem
        AutoCheck = True
        Caption = 'Quatre'
        OnAdvancedDrawItem = mnuDessinAllAdvancedDrawItem
        OnMeasureItem = mnuDessinAllMeasureItem
      end
      object mnuDessinCinq: TMenuItem
        AutoCheck = True
        Caption = 'Cinq'
        OnAdvancedDrawItem = mnuDessinAllAdvancedDrawItem
        OnMeasureItem = mnuDessinAllMeasureItem
      end
      object mnuDessinSep: TMenuItem
        Caption = '-'
      end
      object mnuDessinPlus: TMenuItem
        Caption = 'Plus'
      end
    end
  end

[illuch]

Comme évoqué, vous devez le redessiner vous même ou en XE2 (sachant que cela fonctionnera plus en D10),N'oubliez pas le OnMesureItem pour avoir la bonne largeur laissant la place pour dessiner la case à cocher.

Je suis arrivé à afficher les menus de différentes couleurs ainsi que les coches.
Mais je n'arrive pas à utiliser le "OnMesureItem".
Et je ne trouve rien sur internet
Un exemple serait le bien venu
Merci
JL

[illuch]

La discussion est résolue.
Les espaces entre les items sont volontaires pour une meilleure visibilité.
j'ai redessiné aussi les barres de séparation.

Merci de votre aide.