Discussion :

[pepito62]

Bonjour,

Dans un TpopupMenu, j'aimerais savoir comment agrandir la hauteur de chaque Item.

As t-on une possibilité de faire ceci ? Avez-vous des idées à me proposer ? Peut-être un autre composant ? Peut-être redessiner le popupMenu ? Dans le dernier cas, comment faire ?

Merci beaucoup

PS : Nécessaire pour une appli tactile

[ero-sennin]

Salut,

Tu peux le faire très facilement en suivant les étapes ci-dessus...
Tu dois d'abord mettre la propriété OwerDraw du TPopupMenu à true...
Ensuite, tu dois (pas obligé, mais c'est plus simple par la suite), déclarer une procédure dans la partie interface comme suit (partie private par exemple) :

Code :

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

procedure DessinerItem(Sender: TObject; PositionX: integer;ACanvas: TCanvas;ARect: TRect;Texte: string);

Ensuite, tu implémentes la méthodes :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
procedure TForm1.DessinerItem(PositionX: integer; ACanvas: TCanvas;
  ARect: TRect; Texte: string);
begin
  ARect.Left := PositionX;
  // Dessine le texte sur le canvas 
  //DT_LEFT : Texte à gauche en X
  // DT_VCENTER : Texte centrer en Y
  // DT_SINGLELINE : Multiligne non autorisé
  //DT_NOCLIP : Dessiner sans scintillement 
  DrawText(ACanvas.Handle, Texte , -1, ARect, DT_LEFT or DT_VCENTER or DT_SINGLELINE or DT_NOCLIP);
end;

La méthode étant faite, il ne te reste plus l'utiliser :
Dans l'événement OnDrawItem :

Code :

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

1
2
3
4
5
6
7
8
9
procedure TForm1.test1DrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect;
  Selected: Boolean);
begin
  // Pour qu'on puisse avoir le focus sur toute la ligne
  // Lorsque l'on passe la souris sur l'item
  ACanvas.FillRect(ARect);
  // On dessine , l'item 
  DessinerItem(15,ACanvas,ARect,'Test1');
end;

On peut encore faire plus court pour éviter de devoir remettre le texte, mais bon, dans un premier temps, je te laisse comprendre le code.
Dernière chose à faire, on va modifier la hauteur et largeur de nos items grâce à l'événement OnMeasureItem :
Par exemple :

Code :

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

1
2
3
4
5
6
procedure TForm1.test1MeasureItem(Sender: TObject; ACanvas: TCanvas; var Width,
  Height: Integer);
begin
  Height := 45;
  Width := 150;
end;

Bien évidemment, ce code est à répéter pour chacun des items du PopupMenu ...

Voilà, j'espère que ça était clair et que ça répond à ton besoin
A+

[pepito62]

Merci

Ca fonctionne du feu de dieu .

Par contre, j'ai corrigé 2 bricole dans ton exemple car j'avais une erreur à la compilation.
=> Quand tu utilise la procédure DrawText, il faut caster la variable "Texte" de type string en PChar.
=> Quand tu lance la procédure DessinerItem, tu as oublié de mettre le Sender. Quoi que...t'en a pas besoin, il suffit de le virer de la procédure

Voilou, @part ça, c'est niquel. Merci beaucoup.

Sinon, c'est quoi ta méthode pour faire plus court sans devoir remettre le texte ?

[ero-sennin]

Salut,

Effectivement, je n'ai pas fait attention (un copier coller trop rapide )
Ah oui, pour le Sender en fait, j'étais déjà entrain de modifier pour l'optimiser mais j'avais pas remis le texte dans son état d'origine

Pour ne pas être obligé de remettre le texte, suffit de modifier la méthode comme suit :

Interface :

Code :

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

procedure DessinerItem(Sender: TObject; PositionX: integer;ACanvas: TCanvas;ARect: TRect);

implémentation :

Code :

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

1
2
3
4
5
6
7
8
9
10
procedure TForm1.DessinerItem(Sender: TObject;PositionX: integer; ACanvas: TCanvas; ARect: TRect);
begin
  ARect.Left := PositionX;
  // Dessine le texte sur le canvas 
  //DT_LEFT : Texte à gauche en X
  // DT_VCENTER : Texte centrer en Y
  // DT_SINGLELINE : Multiligne non autorisé
  //DT_NOCLIP : Dessiner sans scintillement 
  DrawText(ACanvas.Handle, PChar(TMenuItem(Sender).Caption) , -1, ARect, DT_LEFT or DT_VCENTER or DT_SINGLELINE or DT_NOCLIP);
end;

Utilisation :

Code :

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

1
2
3
4
5
6
7
8
9
procedure TForm1.test1DrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect;
  Selected: Boolean);
begin
  // Pour qu'on puisse avoir le focus sur toute la ligne
  // Lorsque l'on passe la souris sur l'item
  ACanvas.FillRect(ARect);
  // On dessine , l'item 
  DessinerItem(Sender,15,ACanvas,ARect);
end;

Voilà.
Comme ça, tu écris ton texte en Design Time, et tu ne te soucis pas de devoir les réécrire une fois de plus dans la méthode
Fais attention car la méthode de dessin ne fonctionnera que pour les TMenuItem ... Hé oui, je fais un Cast dans ce type de class.
On pourrait peut-être l'étendre à plus de contrôle mais j'ai pas mon Delphi sous la main pour tester, donc oublions ce passage

A+

[pepito62]

Oui, c'est ce dont j'ai fait dans mon code.

Merci beaucoup

[pepito62]

Par contre, j'ai un autre petit soucis

Avant d'agrandir la hauteur des lignes, je désactivais certain Item (Enabled:= false) et ça fonctionnais correctement.

Avec la modif sur la hauteur des lignes, j'ai pas accès à l'Item qui est en Enabled:= false. Par contre, l'item reste de la même couleur. (On penserait qu'il n'est pas désactiver)


Pourrais-tu me dire si il est possible de mettre le texte en gris clair lorsque l'Item est désactivé ?

[pepito62]

C'est bon, j'ai trouvé.

Il suffit d'utiliser le canvas, comme ceci par exemple :

Code :

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

1
2
3
if TMenuItem(Sender).Enabled then
       ACanvas.Font.Color:= clBlack
  else ACanvas.Font.Color:= clSilver;

[anapurna]

salut

pour la largeur des lignes la modification ne devrais porter que sur la methode onMeasureItem

la methode DrawItem n'est la que pour personnaliser le dessin de chaque item


@+ Phil

[pepito62]

Lorsque je renseigne uniquement la methode onMeasureItem, j'ai bien la bonne largeur des lignes. Par contre, je n'ai aucun texte de visible.

[anapurna]

salut

je vient de faire le test les modif sont correctement prise .

je suppose que le ownDrawItem a été supprimer ?


@+pHIL