Discussion :

[Chrispi]

Bonjour,

En m'inspirant de http://delphipage.free.fr/pboutons.html, je vous propose deux méthodes pour créer un bouton rond.

1^ère méthode

Sur une forme, déposer un composant TButton et en faire un bouton carré. Ici les dimensions sont 60 x 60.



Ensuite appliquer le code sur l'évènement OnCreate de la forme.

Code :

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

1
2
3
4
5
6
7
8
9
10
procedure TForm1.FormCreate(Sender: TObject);
var rgn : hrgn;
begin
//Changement du bouton carré vers rond
with Form1.Btn1 do //Sur le bouton
begin
  rgn:=CreateRoundRectRgn(1,1,width,height,120,120); //Arrondir les angles du bouton
  SetWindowRgn(handle, rgn, true);
end;
end;

On notera qu'il faut que la taille des arrondis (ici 120) soit bien supérieure à la taille des côtés du bouton (ici 60).

Ensuite, on applique le code sur l'évènement OnPaint de la forme.

Code :

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

1
2
3
4
5
6
7
procedure TForm1.FormPaint(Sender: TObject); //Cercler le bouton
begin
  Canvas.Pen.Width:=2; //Taille du trait
  Canvas.Pen.Color:=clActiveBorder; //Choix de la couleur
  with Form1.Btn1 do //Sur le bouton
  Canvas.Ellipse(left,top,width+left,height+top); //Forme ronde
end;

Résultat après compilation :




2^ème méthode

Sur une forme déposer deux composants TShape pris dans l'onglet Additional.
Il faut qu'ils aient absolument la même taille et mettre la propriété Shape à stCircle. Ici aussi les dimensions des TShape sont 60 x 60.
Il vaut mieux qu'ils soient de couleurs différentes. On jouera sur les propriétés Brush pour la couleur du fond et Pen pour la taille du trait (ici 1) de contour et sa couleur. Le premier TShape est de la couleur avant clic et l'autre de la couleur quand on clique dessus.


Ensuite, les deux TShape doivent être superposés exactement au même endroit sur la forme pour constituer un bouton unique. Le premier TShape doit être mis en avant du second.
Sur le nouveau bouton, on peut déposer un TLabel pour donner un intitulé au bouton.



Le code du bouton créé sera appliqué sur les évènements OnMouse du premier TShape.

Pour clic sur bouton :

Code :

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

1
2
3
4
5
6
procedure TForm1.Shape1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin //Clic sur bouton
  Shape2.Visible:=True; //Apparence bouton appuyé visible
  Shape1.Visible:=False; //Apparence bouton relâché invisible
end;

Pour clic relâché (On notera que c'est à ce niveau que sera lancée l'opération à effectuer.) :

Code :

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

1
2
3
4
5
6
7
8
procedure TForm1.Shape1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin //Clic relâché
  Shape2.Visible:=False; //Apparence bouton appuyé invisible
  Shape1.Visible:=True; //Apparence bouton relâché visible
  //Opération à effectuer
  ShowMessage('Le bouton fonctionne !') //Exemple d'opération à effectuer
end;

Si le pointeur est positionné sur le bouton, ce dernier change de couleur.

Code :

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

1
2
3
4
procedure TForm1.Shape1MouseEnter(Sender: TObject);
begin //Pointeur sur bouton
  Shape1.Brush.Color:=$00FFFFDD; //Choix couleur
end;

Quand le pointeur n'est plus positionné sur le bouton, ce dernier doit revenir à sa couleur initiale si c'est celle qui a été choisie.

Code :

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

1
2
3
4
procedure TForm1.Shape1MouseLeave(Sender: TObject);
begin //Pointeur plus sur bouton
  Shape1.Brush.Color:=cl3DLight; //Choix couleur
end;

Résultat après compilation :




Pour conclure, la première méthode est rapide mais le résultat est un peu moins fin que pour la deuxième. Dans cette dernière, si on clique sur l'intitulé du bouton, le clic est sans effet. Il faut cliquer un peu à côté de l'intitulé. Ce petit souci peut être contourné en mettant la propriété Enabled du TLabel à False mais du coup l'intitulé apparaît dans une coloration atténuée. C'est possible aussi de mettre une image, une icône,..., en utilisant un composant TImage et la propriété Enabled peut être passée à False sans incidence sur l'aspect de l'image. Avec la deuxième méthode, on peut aussi par exemple réaliser un bouton triangulaire...

Résultat avec l'icône de Lazarus :

[Andnotor]

Sur le principe la 1ère méthode est correct. Tu devrais cependant dériver un nouveau composant de TButton et gérer l'ensemble depuis là. Ca te permettrait par exemple de changer la couleur de la bordure au survol (sans invalider la fiche).

Sous Delphi, je ferais ainsi (à adapter pour Lazarus) :

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
type
  TButton = class(vcl.StdCtrls.TButton)
  private
    PenColor :TColor;
  protected
    procedure WMPaint(var Message :TWMPaint); message WM_PAINT;
    procedure WMSize(var Message :TWMSize); message WM_SIZE;
    procedure CMMouseEnter(var Message :TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message :TMessage); message CM_MOUSELEAVE;
  public
    constructor Create(aOwner :TComponent); override;
  end;
 
constructor TButton.Create(aOwner: TComponent);
begin
  inherited;
  PenColor := clActiveBorder;
end;
 
procedure TButton.CMMouseEnter(var Message: TMessage);
begin
  inherited;
  PenColor := clHotLight;
end;
 
procedure TButton.CMMouseLeave(var Message: TMessage);
begin
  inherited;
  PenColor := clActiveBorder;
end;
 
procedure TButton.WMPaint(var Message: TWMPaint);
begin
  inherited;
 
  with TControlCanvas.Create do
  try
    Control := Self;
 
    Pen.Width   := 4;
    Pen.Color   := PenColor;
    Brush.Style := bsClear;
 
    Ellipse(ClientRect);
 
  finally
    Free;
  end;
end;
 
procedure TButton.WMSize(var Message: TWMSize);
var
  Rgn :hRgn;
begin
  inherited;
 
  Rgn := CreateRoundRectRgn(1, 1, Width, Height, Width*2, Height*2);
  SetWindowRgn(Handle, Rgn, FAlSE);
end;

J'aime moins la 2e méthode. Il serait plus logique d'utiliser un TPaintBox et d'adapter le dessin en fonction des différents critères.

Mais dans tous les cas, tu devrais aussi utiliser une région afin de limiter le clic à la surface ronde. Le composant reste rectangulaire et sans région rien n'interdit de cliquer à l'extérieur du "bouton". Par contre la tâche sera un peu plus ardue.