Discussion :

[sfpx]

Merci bien de tes efforts
J'aimerais bien avoir le code ici ou par courrier au softprog@sympatico.ca

[sfpx]

J'avance tout près de la solution
Code du ondrawitem

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
 
 var dc:hdc;
   i:integer;
begin
acanvas.Refresh;
  dc:=acanvas.Handle;
acanvas.font.color:=clwhite;
if Selected then
   ACanvas.Brush.Color := clred
  else
   ACanvas.Brush.Color := clblue;
 
  ACanvas.FillRect(ARect);
  acanvas.textout(1,arect.Top,tmenuitem(sender).Caption);
 
  if GetSubMenu(popupmenu1.Handle,tmenuitem(sender).menuindex)<>0
  then
  begin
  ExcludeClipRect(dc,arect.Left,arect.Top,arect.Right,arect.Bottom);
  acanvas.Brush.Color:=clblue;
  if tmenuitem(sender).MenuIndex<popupmenu1.Items.Count-1 then
  for i:=tmenuitem(sender).MenuIndex+1 to popupmenu1.Items.Count-1 do
   begin
     arect.Top:=arect.Top+19;
     arect.Bottom:=arect.Bottom+19;
     acanvas.FillRect(arect);
     acanvas.TextOut(1,arect.Top,popupmenu1.Items[i].Caption);
   end;
  ReleaseDc(0, dc);
  end;
 
 
end;

Le seul problème est celui illustré dans l'image suivante
http://img270.imageshack.us/img270/9066/menu34dm.jpg

Lorsqu'on fait afficher un sous-menu et qu'on descend sur l'item suivant ce dernier a quelques pixels (voire même un seul) qui ne sont pas dessinés. Ça correspond à l'intersection entre la fenêtre de sous-menu et le menu parent.

[sfpx]

Code mis à jour avec la nouvelle image de la flèche

(Code complet de la forme)

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
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
 
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, StdCtrls, ExtCtrls;
 
type
  TForm1 = class(TForm)
    PopupMenu1: TPopupMenu;
    a1: TMenuItem;
    b1: TMenuItem;
    c1: TMenuItem;
    fff1: TMenuItem;
    adsdk1: TMenuItem;
    test51: TMenuItem;
    Image1: TImage;
    procedure b1AdvancedDrawItem(Sender: TObject; ACanvas: TCanvas;
      ARect: TRect; State: TOwnerDrawState);
    procedure b1DrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect;
      Selected: Boolean);
    procedure fff1MeasureItem(Sender: TObject; ACanvas: TCanvas; var Width,
      Height: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
 
implementation
 
{$R *.dfm}
 
procedure TForm1.b1AdvancedDrawItem(Sender: TObject; ACanvas: TCanvas;
  ARect: TRect; State: TOwnerDrawState);
var 
dc:hdc;
begin
 
end;
 
procedure TForm1.b1DrawItem(Sender: TObject; ACanvas: TCanvas;
  ARect: TRect; Selected: Boolean);
  var dc:hdc;
   i:integer;
begin
acanvas.Refresh;
  dc:=acanvas.Handle;
acanvas.font.color:=clwhite;
if Selected then
   ACanvas.Brush.Color := clred
  else
   ACanvas.Brush.Color := clblue;
 
  ACanvas.FillRect(ARect);
  acanvas.textout(1,arect.Top,tmenuitem(sender).Caption);
 
  if GetSubMenu(popupmenu1.Handle,tmenuitem(sender).menuindex)<>0
  then
  begin
  acanvas.Draw(arect.Right-image1.Width,arect.Top,image1.Picture.Graphic);
  ExcludeClipRect(dc,arect.Left,arect.Top,arect.Right,arect.Bottom);
  acanvas.Brush.Color:=clblue;
  if tmenuitem(sender).MenuIndex<popupmenu1.Items.Count-1 then
  for i:=tmenuitem(sender).MenuIndex+1 to popupmenu1.Items.Count-1 do
   begin
    arect.Top:=arect.Top+19;
     arect.Bottom:=arect.Bottom+19;
     acanvas.FillRect(arect);
     acanvas.TextOut(1,arect.Top,popupmenu1.Items[i].Caption);
     if GetSubMenu(popupmenu1.Handle,i)<>0
   then
   acanvas.Draw(arect.Right-image1.Width,arect.Top,image1.Picture.Graphic);
 
   end;
  ReleaseDc(0, dc);
  end;
 
 
end;
 
procedure TForm1.fff1MeasureItem(Sender: TObject; ACanvas: TCanvas;
  var Width, Height: Integer);
begin
width:=40;
end;
 
end.

Nouvelle image (avec toujours le même petit problème)
http://img250.imageshack.us/img250/4935/menu46ka.jpg

[sfpx]

La solution du paresseux serait la suivante. Elle ne solutionne pas le problème mais l'évite. C'est pas l'idéal mais bon c'est mieux que rien.

1. On laisse une marge à gauche et à droite
2. On commence à écrire le caption à X=4
3. Le cadre de sélection ne touche pas aux marges

Les seuls changements se trouvent au début du code précédent

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
 var dc:hdc;
   i:integer;
   selectrect:trect;
begin
acanvas.Refresh;
  dc:=acanvas.Handle;
acanvas.font.color:=clwhite;
ACanvas.Brush.Color := clblue;
ACanvas.FillRect(ARect);
selectrect:=arect;
selectrect.Left:=selectrect.Left+2;
selectrect.Right:=selectrect.Right-3;
if Selected then
   begin
   ACanvas.Brush.Color := clred;
   ACanvas.FillRect(selectrect);
   end;

Pour le reste c'est pareil sauf pour les "textout" qui doivent avoir 4 comme paramètre de X au lieu de 1.

Et le résultat final donne

http://img176.imageshack.us/img176/8566/menu51sr.jpg

[sfpx]

Bon alors même si j'ai "triché" un peu je suis content du résultat final que voici.



L'ajout d'une marge dans mon code évite le problème des pixels manquants et dans le fond, avec une couleur différente cela donne un look intéressant

Si vous êtes intéressé par le code final faites-le moi savoir je le nettoierai un peu et le copierai ici.

Merci encore à ceux qui m'ont aidé

[Lung]

Si vous êtes intéressé par le code final faites-le moi savoir je le nettoierai un peu et le copierai ici.

Ca m'intéresse.
Surtout la partie qui gère la flèche. J'ai du mal à gérer la sélection du menu.

[sfpx]

Voici le résultat final avec quelques commentaires ajoutés

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
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, StdCtrls, ExtCtrls;
 
type
  TForm1 = class(TForm)
    PopupMenu1: TPopupMenu;
    Menu1: TMenuItem;
    Menu2: TMenuItem;
    Menu3: TMenuItem;
    Menu4: TMenuItem;
    Menu5: TMenuItem;
    Menu8: TMenuItem;
    Image1: TImage;
    Menu6: TMenuItem;
    Menu7: TMenuItem;
    procedure MenuDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect;
      Selected: Boolean);
    procedure MenuMeasureItem(Sender: TObject; ACanvas: TCanvas; var Width,
      Height: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
const
MargeMenu=7;//ne pas utiliser une marge inférieure à 3
 
implementation
 
{$R *.dfm}
 
procedure TForm1.MenuDrawItem(Sender: TObject; ACanvas: TCanvas;
  ARect: TRect; Selected: Boolean);
  var dc:hdc;
  i:integer;
  hauteuritem:integer;
function RectInterne(srcrect:trect):trect;
   begin
     result:=srcrect;
     result.Left:=srcrect.Left+MargeMenu;
     result.Right:=srcrect.Right-MargeMenu;
   end;
begin
  hauteuritem:=arect.Bottom-arect.Top;
 
  acanvas.font.color:=clwhite;
 
  //Sélection de la couleur des marges
 
  acanvas.Brush.Color := $00FF8080;
 
  //Remplissage du rectangle total de l'item
  acanvas.FillRect(ARect);
 
  //Sélection de la couleur du cadre intérieur
  if Selected then ACanvas.Brush.Color := clred
      else  ACanvas.Brush.Color := clnavy;
 
  //Remplissage du cadre intérieur
  acanvas.FillRect(RectInterne(arect));
 
  //Écriture du caption de l'item
  acanvas.textout(MargeMenu+2,arect.Top,tmenuitem(sender).Caption);
 
  {Si le menu a un sous-menu,
  1. on dessine la nouvelle flèche de sous-menu
  2. On empêche le dessin automatique de la flèche de sous-menu de Windows
     avec la fonction ExcludeClipRect
  3. On dessine les items suivants car l'ExcludeclipRect semble empêcher
     leur traitement normal dans le ondrawitem
  4. On libère le DC
 
  }
  if GetSubMenu(popupmenu1.Handle,tmenuitem(sender).menuindex)<>0
  then
  begin
  dc:=acanvas.Handle;
  acanvas.Draw(Margemenu+1+acanvas.TextWidth(tmenuitem(sender).Caption),arect.Top,image1.Picture.Graphic);
  ExcludeClipRect(dc,arect.Left,arect.Top,arect.Right,arect.Bottom);
 
  if tmenuitem(sender).MenuIndex<popupmenu1.Items.Count-1 then
  for i:=tmenuitem(sender).MenuIndex+1 to popupmenu1.Items.Count-1 do
   begin
     acanvas.Brush.Color:=$00FF8080;
     arect.Top:=arect.Top+hauteuritem;
     arect.Bottom:=arect.Bottom+hauteuritem;
     acanvas.FillRect(arect);
     acanvas.Brush.color:=clnavy;
     acanvas.FillRect(RectInterne(arect));
     acanvas.TextOut(MargeMenu+2,arect.Top,popupmenu1.Items[i].Caption);
     if GetSubMenu(popupmenu1.Handle,i)<>0
   then
   acanvas.Draw(Margemenu+1+acanvas.TextWidth(popupmenu1.Items[i].Caption),arect.Top,image1.Picture.Graphic);
 
   end;
  ReleaseDc(0, dc);
  end;
 
 
end;
 
procedure TForm1.MenuMeasureItem(Sender: TObject; ACanvas: TCanvas;
  var Width, Height: Integer);
var i:integer;
max:integer;
PlusLongMenu :integer;
begin
   {On calcule la longueur du plus long texte de menu
   afin de s'assurer que le canvas soit assez large pour contenir
   tout le texte plus les marges.
   Une version améliorée de cette procédure pourrait aussi considérer la longueur
   de l'image de la flèche de sous-menu que l'on voudra dessiner
   si celle-ci est particulièrement large.
   }
 
   max:=0;
    for i:=0 to tmenuitem(sender).Parent.count-1 do
    begin
     if length(tmenuitem(sender).Parent[i].Caption)>max then
                begin
                max:=length(tmenuitem(sender).Parent[i].Caption);
                PlusLongMenu:=i;
                end;
 
    end;
    width:=acanvas.TextWidth(tmenuitem(sender).Parent[PlusLongMenu].Caption)+(MargeMenu*2)+1;
 
end;
 
end.

[Lung]

Merci.
Je regarde ca.