Afficher le Canvas d'un Label, plutôt que son 'Caption'

Version imprimable

1 pièce(s) jointe(s)

Bonjour,
j'ai un label ou je veux afficher le symbole Delta suivi d'un texte.
j'ai donc fait une procédure pour afficher ce symbole avant le texte,
puis centrer le texte horizontalement et verticalement dans le label.

Code:

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
 
//******************************************************************************
//***************   Ajout de 'Delta.' à la chaine de caractère   ***************
//******************************************************************************
Procedure TForm1.AjoutDelta(Lbl: TLabel; Ch: String; Clr: integer);             // Ajout de 'Delta.' à la chaine de caractère
  var
    Offset                   : Tpoint;                                          // décallage du texte, en pixels
    LgTxt                    : Word;                                            // longueur du texte en pixels
    HtTxt                    : Word;                                            // hauteur du texte en pixels
  begin
    With Lbl.Canvas do begin
      brush.Color:=ClBtnFace;                                                   // si la couleur n'est pas celle du fond, ...
      Pen.Color:=ClBtnFace;                                                     // ... un cadre apparaît de la couleur du stylo
      rectangle(0, 0, Lbl.Width, Lbl.Height);                                   // -----> efface le canvas du label
      Font.Style:=[FsBold];
      Font.Color:=Clr;
      Brush.Color:=ClBtnFace;
      LgTxt:=0;                                                                 // initialisation
      HtTxt:=0;                                                                 // ...
      //---------------------------------------------------   Calcul des offsets
      Font.Size:=10;                                                            // longueur/hauteur du Delta
      Font.Name:='Symbol';                                                      // ...
      LgTxt:=TextWidth('D.');                                                   // ...
      HtTxt:=TextHeight('D.');                                                  // ...
      //------
      Font.Name:='Segoe UI';                                                    // longueur du texte
      Font.size:=9;                                                             // ...
      LgTxt:=LgTxt+TextWidth(Ch);                                               // ...
      //------------------------------------------------   Calcul Offset Largeur
      Offset.X:=round((Lbl.Width-LgTxt)/2);
      //------------------------------------------------   Calcul Offset hauteur
      Offset.Y:=round((Lbl.Height-HtTxt)/2)-3;
      //--------------------------------   Affichage de la chaine dans le Canvas
      Font.Size:=11;
      Font.Name:='Symbol';
      TextOut(Offset.X, Offset.y, 'D.');
      Offset:=PenPos;
      Font.Name:='Segoe UI';
      Font.size:=9;
      TextOut(Offset.X, Offset.Y+3, Ch);
    end;
  end;
//******************************************************************************
//***********   Fin de l'ajout de 'Delta.' à la chaine de caractère   **********
//******************************************************************************

je crée dynamiquement le 'Label',
puis j'essaye d'afficher ensuite mon texte contenant le 'Delta'.
mais c'est le 'Caption' qui reste dans le 'Label'

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
 
//******************************************************************************
//************************   Activation de la fenêtre   ************************
//******************************************************************************
procedure TForm1.FormActivate(Sender: TObject);
  begin
    LblDelta:=TLabel.create(Form1);                                             // création dynamique du label
    With LblDelta do begin                                                      // ...
      Parent:=Panel1;                                                           // ...
      Name:='LblDelta';                                                         // ...
      Caption:='Je ne veux pas afficher ce texte !!!';                          // ...
      Font.color:=ClBlack;                                                      // ...
      Align:=AlClient;                                                          // ...
      Font.style:=[FsBold];                                                     // ...
      Enabled:=false;                                                           // ...
      visible:=true;                                                            // ...
    end;                                                                        // ...
    AjoutDelta(LblDelta, ' = //', ClRed);                                       // Ajout de 'Delta.' à la chaine de caractère
  end;
//******************************************************************************
//********************   Fin de l'activation de la fenêtre   *******************
//******************************************************************************

je ne comprends pas pourquoi.
merci pour votre aide
bonne journée

18/02/2020, 09h42
Jon Shannow

Bonjour,

Je ne suis pas un spécialiste, mais je pense que tu devrais surcharger l'évènement Paint du Label pour qu'il ne fasse pas ce qui est prévu qu'il fasse.

JS

Citation:

Envoyé par Jon Shannow

Bonjour,

Je ne suis pas un spécialiste, mais je pense que tu devrais surcharger l'évènement Paint du Label pour qu'il ne fasse pas ce qui est prévu qu'il fasse.

JS

Salut, c'est presque ça, Le TLabel n'as pas d’événement OnPaint, la seule façon est de se créer soi-même un TLabel perso

Voila un petit exemple à l'arrache :zoubi:

Code:

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
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
unit Unit1;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, Forms, Controls,  Graphics, Dialogs, StdCtrls, ExtCtrls;
type
 
  { TMyLabel }
 
  TMyLabel = Class(TCustomLabel)
  private
    FAlternateText : String;
    FAlternate : Boolean;
    FAlternateColor : TColor;
    FBorderColor : TColor;
    procedure SetAlternate(const AValue : Boolean);
  protected
  public
    procedure paint; override;
  published
    property AlternateText : String read FAlternateText write FAlternateText;
    property Alternate : Boolean read FAlternate write SetAlternate;
    property AlternatColor : TColor read FBorderColor write FAlternateColor;
    property BorderColor : TColor read FBorderColor write FBorderColor;
  end;
 
  { TForm1 }
 
  TForm1 = class(TForm)
    Panel1 : TPanel;
    Button1 : TButton;
    procedure FormActivate(Sender : TObject);
    procedure FormClose(Sender : TObject; var CloseAction : TCloseAction);
    procedure Button1Click(Sender : TObject);
  private
 
  public
    LblDelta : TMyLabel
  end;
 
var
  Form1 : TForm1;
 
implementation
 
{$R *.lfm}
 
{ TForm1 }
 
procedure TForm1.FormActivate(Sender : TObject);
begin
  LblDelta:=TMyLabel.create(Self);  // création dynamique du label
   With LblDelta do
   begin
      Parent:= Panel1;
      AutoSize := False;
      Name:='LblDelta';
      Caption:=' Je ne veux pas afficher ce texte !!!';
 
      AlternateText := ' = //';
      Alternate := False;
      AlternatColor := clRed;
      BorderColor := clBlue;
 
      Align:= alClient;
 
      Font.style:=[FsBold];
      Font.color:=ClBlack;
      Font.Name := 'Times New Roman';
 
      Enabled:= True; // Aucune importance ici, idem avec Alignment, Layout etc...
 
      visible:=true;
   end;
end;
 
procedure TForm1.FormClose(Sender : TObject; var CloseAction : TCloseAction);
begin
  LblDelta.Free;
end;
 
procedure TForm1.Button1Click(Sender : TObject);
begin
  LblDelta.Alternate := not(LblDelta.Alternate);
end;
 
{ TMyLabel }
 
procedure TMyLabel.SetAlternate(const AValue : Boolean);
begin
  if FAlternate = AValue then Exit;
  FAlternate := AValue;
  Self.Invalidate;
end;
 
procedure TMyLabel.paint;
var
   Offset                   : Tpoint;
   LgTxt                    : Word;
   HtTxt                    : Word;
   ch : String;
   OldFont : TFont;
 begin
   if Alternate then
     ch := FAlternateText
   else
    ch := GetLabelText;
 
   With Canvas do
   begin
     brush.Color:=ClBtnFace;
     LgTxt:=0;
     HtTxt:=0;
     if FAlternate then
     begin
 
       Pen.Color:= FBorderColor;
       rectangle(0, 0, ClientWidth, ClientHeight);
       // Le SELF devant FONT est IMPORTANT !!!!!
       OldFont := TFont.Create;
       OldFont.Assign(Self.Font);
 
       Self.Font.Size:=10;
       Self.Font.Name:='Symbol';
       Self.Font.Style:= [FsBold];
       Self.Font.Color:= FAlternateColor;
       LgTxt:= TextWidth('D.');
       HtTxt:= TextHeight('D.');
 
       Self.Font.Name:='Segoe UI';
       Self.Font.size:=9;
       LgTxt:= LgTxt + TextWidth(ch);
 
       //------------------------------------------------   Calcul Offset Largeur
       Offset.X:= (ClientWidth -LgTxt) div 2;
       //------------------------------------------------   Calcul Offset hauteur
       Offset.Y:= (ClientHeight - HtTxt) div 2;
 
       //--------------------------------   Affichage de la chaine dans le Canvas
       Self.Font.Size:= 11;
       Self.Font.Name:='Symbol';
       TextOut(Offset.X, Offset.y, 'D.');
       Offset:=PenPos;
       Self.Font.Name:='Segoe UI';
       Self.Font.size:= 9;
       TextOut(Offset.X, Offset.Y, ch);
       Self.Font.Assign(OldFont);
       FreeAndNil(OldFont);
     end
     else
     begin
       LgTxt:= TextWidth(ch);
       HtTxt:= TextHeight(ch);
       //------------------------------------------------   Calcul Offset Largeur
       Offset.X:= (ClientWidth - LgTxt) div 2;
       //------------------------------------------------   Calcul Offset hauteur
       Offset.Y:= (ClientHeight - HtTxt) div 2;
       //--------------------------------   Affichage de la chaine dans le Canvas
       TextOut(Offset.X, Offset.Y, ch);
     end;
   end;
end;
 
end.

A+

Jérôme

19/02/2020, 11h10
neho88

'TCanvas' dans un 'Label'

Bonjour,
merci pour vos réponses.
je teste tout cela et je reviens vers vous.
bonne journée
19/02/2020, 17h07
Andnotor

Je ne comprends pas trop la logique d'utiliser un TLabel pour ça :koi:
22/02/2020, 08h57
neho88

Afficher le Canvas d'un Label, plutôt que son 'Caption'

Bonjour,
merci pour vos réponses.
Merci à BeanzMaster, c'est très intéressant de savoir comment ça marche. et ça marche !
//------------
Pour répondre à la question très pertinente de Andnotor ...
au départ, j'avais juste un texte à afficher donc un Label était amplement suffisant.
puis un jour, je me suis dit que remplacer Delta par le symbole Delta Grec aurait été pas mal du tout.
j'ai donc utilisé le Canvas du Label en me heurtant à la difficulté que j'ai exposé.
--------------
pour finir, après cette excellente question, j'ai changé mon Label en PaintBox.
--------------
encore une fois, merci à tous,
c'est toujours sympa de constater qu'on progresse grâce à vos excellentes réponses.
bonne journée
:applo::applo::applo:
23/02/2020, 14h21
Alcatîz

Bonjour,

Étant donné que Lazarus utilise par défaut l'UTF-8, pourquoi ne pas tout simplement écrire le delta grec dans le libellé du TLabel ?
Lazarus possède une table de caractères (il faut taper Maj-Ctrl-M dans l'éditeur) ; dans l'onglet Unicode l'intervalle Greek and Coptic contient l'alphabet grec.

;)
24/02/2020, 09h17
neho88

Afficher le Canvas d'un Label, plutôt que son 'Caption'

Bonjour,
merci pour cette excellente solution.
je ne connaissais pas cette possibilité.
bonne journée

:lahola::lahola::lahola: