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. |
Partager