Bonjour,

Je vous soumets un problème que je rencontre lors de la création d'un menu popup avec OwnerDraw True.

En Rad, je crée une form vide Form1.

Je crée un menu popup et je renseigne ses MenuItems lors de l'événement FormActivate.

Voici le code (succint) de mon unité qui inclut aussi les procédures nécessaires au fonctionnement du menu popup.

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
 
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, Menus;
 
type
  TForm1 = class(TForm)
    procedure FormActivate(Sender: TObject);
  private
    { Déclarations privées }
    procedure PopupMenuClick(Sender: TObject);
    procedure PopupMenuMeasureItem(Sender: TObject; ACanvas: TCanvas; var Width, Height: Integer);
    procedure PopupMenuAdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState);
  public
    { Déclarations publiques }
    PopupMenu : TPopupMenu;
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.FormActivate(Sender: TObject);
var
  i : integer;
  MI : TMenuItem;
begin
  PopupMenu := TPopupMenu.Create(Form1);
  with PopupMenu do begin
    for i := 1 to 3 do begin
      MI := TMenuItem.Create(PopupMenu);
      MI.Caption := format('Item %d', [i]);
      MI.Name := format('Item%d', [i]);
      MI.Tag := i;
      MI.OnClick := PopupMenuClick;
      MI.OnMeasureItem := PopupMenuMeasureItem;
      MI.OnAdvancedDrawItem := PopupMenuAdvancedDrawItem;
      Items.Add(MI);
    end;
    OwnerDraw := True;
  end;
  Form1.PopupMenu := PopupMenu;
end;
 
procedure TForm1.PopupMenuClick(Sender: TObject);
begin
  with (Sender as TMenuItem) do
    ShowMessage(format('Clic sur PopupMenu Item %d', [Tag]));
end;
 
procedure TForm1.PopupMenuMeasureItem(Sender: TObject; ACanvas: TCanvas; var Width, Height: Integer);
var
  ts : TSize;
begin
  with (Sender as TMenuItem) do
    ts := ACanvas.TextExtent(format('PopupMenu Item %d', [Tag]));
  Width := ts.cx;
  Height := ts.cy;
end;
 
procedure TForm1.PopupMenuAdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState);
begin
  with (Sender as TMenuItem) do
    ACanvas.TextOut(0, 0, format('PopupMenu Item %d', [Tag]));
end;
 
end.
A l'exécution, je devrais voir apparaître le popup avec trois items l'un au dessus des autres : Popup Item 1, Popup Item 2, Popup Item 3.

Or un clic droit fait apparaître un cadre blanc susceptible d'afficher les trois lignes correspondant aux trois items voulus, avec UN SEUL item est qui est affiché tout en haut et dont le numéro correspond à la position approximative du curseur sur le menu (donc PopupMenu Item 1, 2, ou 3),

Pourtant, si je clique en bas du menu popup, je vois que mon ShowMessage m'affiche comme il se doit Clic sur PopupMenu Item 3.

Mon problème est donc un problème d'affichage des items dessinés à la volée dont les libellés s'empilent tous sur le premier item.

Qu'ai-je manqué dans mon code que je compile sous D6 ?

Merci d'avoir pris le temps de me lire.

....et meilleurs voeux pour 2005.