Discussion :

[cilies38]

Bonjour,

J'aimerais utiliser des ellipses dans mon interfaces avec du texte à l'intérieur et la possibilité de changer de couleur lorsque l'on clique dessus. N'ayant pas trouver de composants permettant déjà d'inscrire du texte dedans, j'ai décider d'utiliser un canvas pour réaliser cela. Probleme je n'arrive rien à dessiner. Y'aurait-il un composant permettant de réaliser ceci et aurai je oublier des trucs avant l'utilisation de canvas (j'ai vu des objets TPAINTBOX). Merci d'avance voila une partie de mon code je voudrais dessiner dans un panel.

procedure TForm4.FormPaint(Sender: TObject);
begin
Canvas.MoveTo(200,100);
Canvas.Pen.Color := clBlue;
Canvas.Ellipse(-20, -20, 20 , 20);

end;

PS : je débute en delphi

[MFDev]

Salut,
Je peux te proposer un extrait d'une de mes application.
Un TPanel, sur lequel tu rajoutes un TPaintBox, et dans l'événement OnPaint du TPaintBox, tu gères l'affichage.
Pour la démonstration, j'ai rajouté les Evnt OnClick + une var globale sTexte.

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
procedure TForm1.PaintBox1Paint(Sender: TObject);
 begin
	Paint;
 end;
 
procedure TForm1.Paint;
 var
	i, X0, Y0: integer;
	iAbsc, iOrd: integer;
	iNbGradX, iPasGradX: integer;
	iNbGradY, iPasGradY, iMaxY: integer;
 begin
	with PaintBox1.Canvas do begin
		X0 := 30;
		Font.Size := 10;
		TextOut(40, 20, sTexte + '      ');  // sTexte = variable globale, pour la démonstration des OnClick
		Y0 := PaintBox1.Height - 20;
		iAbsc := PaintBox1.Width - 20;
		iOrd := PaintBox1.Height - 20;	// long ordonnee pour graduations
		iPasGradX := trunc(iAbsc / 10);	// pas de graduation  abscisse
		Pen.Width := 2;          		// taille du crayon
		MoveTo(X0, Y0); 						// tracé ordonnée
		LineTo(X0, Y0 - iOrd);
		MoveTo(X0, Y0);  						// tracé abscisse
		LineTo(X0 + iAbsc, Y0);
		// tracé des graduations de l'ordonnée
		iNbGradY := round(iOrd / 10) + 1;				// au cas où valeur trop petite
		iPasGradY := trunc(iOrd / iNbGradY);		// définir le pas de graduation ordonnée
		for i := 0 to iNbGradY do begin	// tracé des graduations Ordonnée
			if (i mod 10) = 0 then
				TextOut(2, Y0 - (i * iPasGradY), IntToStr(i * 10));
			MoveTo(X0 - 5, Y0 - (i * iPasGradY));  										// graduation ordonnée
			LineTo(X0 + 5, Y0 - (i * iPasGradY));
		end;	// for
	end;	// with
 end;
 
procedure TForm1.FormCreate(Sender: TObject);
 begin
	sTexte := 'Démarrage';
 end;
 
procedure TForm1.Panel1Click(Sender: TObject);
 begin
	sTexte := 'Clic TPanel';
	Paint;
 end;
procedure TForm1.PaintBox1Click(Sender: TObject);
 begin
	sTexte := 'Clic TPaintBox';
	Paint;
 end;

J'ai simplifié le code au max, pour te montrer l'affichage.
@+
Fabrice

[cilies38]

merci beaucoup

[e-ric]

Salut

je te propose une bidouille (ça me fait une récré).
Comme TPanel n'expose pas publiquement sa propriété Canvas (un peu de pudeur), on va lui forcer un peu la main en lui changer son identité...

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
 
Type 
  TBidouillePanel = class(TPanel)
  public
    property Canvas;
  end;
....
uses Math;
....
// et enfin
procedure TForm1.FormPaint(Sender: TObject);
const
  ArCol : array[0..6] of TColor = (
    clRed, clBlue, clGreen, clYellow, clLime, clAqua, clGray
    );
begin
  with TBidouillePanel(Panel1) do
  begin
    Canvas.Pen.Color := ArCol[RandomRange(Low(ArCol), High(ArCol))];
    Canvas.Ellipse(1, 1, Width-1, Height-1);
  end;
End;

C'est pas jojo (cast sauvage) mais c'est amusant !

cdlt

e-ric

[LadyWasky]

Voici un composant spécialement conçu pour ton besoin, c'est un descendant de TShape (donc tu peux lui faire dessiner une ellipse), avec :
- un Caption (multiligne possible),
- une propriété Font pour choisir sa police
- des propriétés d'alignement du texte ,
- et des évènement OnClick, OnDblClick et OnMouseUp

tout ça en plus de l'original, c'est vrai que ça manquait... :

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
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
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
unit ShapeText;
 
interface
 
uses
  Windows,SysUtils, Classes, Controls, ExtCtrls;
 
type
  TAlignementVertical=(alVTop,alVCenter,alVBottom);
  TAlignementHorizontal=(alHLeft,alHCenter,alHRight);
  TJustification=(JustLeft,JustCenter,JustRight);
 
  TShapeText = class(TShape)
  private
    FAlignementHorizontal: TAlignementHorizontal;
    FAlignementVertical: TAlignementVertical;
    FJustification: TJustification;
    procedure SetAlignementHorizontal(const Value: TAlignementHorizontal);
    procedure SetAlignementVertical(const Value: TAlignementVertical);
    procedure SetJustification(const Value: TJustification);
    { Déclarations privées }
  protected
    { Déclarations protégées }
    procedure Paint; override;
  public
    { Déclarations publiques }
  published
    { Déclarations publiées }
    property AlignementVertical:TAlignementVertical read FAlignementVertical write SetAlignementVertical;
    property AlignementHorizontal:TAlignementHorizontal read FAlignementHorizontal write SetAlignementHorizontal;
    property Justification:TJustification read FJustification write SetJustification;
    property Caption;
    property Font;
    property Align;
    property Anchors;
    property Brush;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Constraints;
    property ParentShowHint;
    property Pen;
    property Shape;
    property ShowHint;
    property Visible;
    property OnContextPopup;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseUp;
    property OnMouseMove;
    property OnClick;
    property OnDblClick;
    property OnStartDock;
    property OnStartDrag;
  end;
 
procedure Register;
 
implementation
uses Graphics,Types;
//Voir FAQ Delphi de <a href="http://www.developpez.com" target="_blank">www.developpez.com</a> pour cette fonction :
//URL : http://delphi.developpez.com/faq/?page=typechaine#dimensionstexte
Function TextSize(Phrase : string; Police : TFont = nil) : TPoint;
var
  DC: HDC;
  X: Integer;
  Rect: TRect;
  C : TBitmap;
begin
  C := TBitmap.Create;
  if police <> nil then  C.canvas.Font := police;
 
    Rect.Left := 0;
    Rect.Top:=0;
    Rect.Right:=0;
    Rect.Bottom:=0;
    DC := GetDC(0);
    C.Canvas.Handle := DC;
    DrawText(C.Canvas.Handle, PChar(Phrase), -1, Rect, (DT_EXPANDTABS or DT_CALCRECT));
    C.Canvas.Handle := 0;
    ReleaseDC(0, DC);
    result.X:=Rect.Right-Rect.Left;
    result.Y:=Rect.Bottom-Rect.Top;
    C.Free;
end;
 
procedure DessineTexteMultiligne(AString: string;ACanvas:TCanvas;ARect: TRect;
                       AlignementHorizontal:TAlignementHorizontal;
                       AlignementVertical:TAlignementVertical;
                       TextJustification:TJustification);
var
  AHeight,AWidth:integer;
  Rect,oldClipRect:TRect;
  ATop,ALeft,H,W:Integer;
  AText:string;
  JustificationDuTexte:Integer;
  MyRgn:HRGN;
begin
  with ACanvas do
  begin
    AHeight:=ARect.Bottom-ARect.Top;
    AWidth:=ARect.Right-ARect.Left;
    //on calcule la taille du rectangle dans lequel va tenir le texte
    W:=TextSize(AString,ACanvas.Font).X;
    H:=TextSize(AString,ACanvas.Font).Y;
 
    //on calcule la position (Haut,Gauche) du rectangle dans lequel va tenir le texte
    //en fonction de l'alignement horizontal et vertical choisis
    ATop:=ARect.Top;
    ALeft:=ARect.Left;
 
 
    case AlignementVertical of
      alVBottom : ATop:=ARect.Bottom-H;
      alVCenter : ATop:=ARect.Top+((AHeight-H) div 2);
      alVTop    : ATop:=ARect.Top;
    end;
 
    case AlignementHorizontal of
      alHLeft  : ALeft:=ARect.Left;
      alHCenter: ALeft:=ARect.Left+(AWidth-W) div 2;
      alHRight : ALeft:=ARect.Right-W;
    end;
 
    //Fin du calcul du rectangle, on met le resultat dans Rect
    Rect:=Bounds(ALeft,ATop,W,H);
 
    //On détermine les paramètres de justification à passer à Windows
    case TextJustification of
      JustLeft  : JustificationDuTexte:=DT_LEFT;
      JustCenter: JustificationDuTexte:=DT_CENTER;
      JustRight : JustificationDuTexte:=DT_RIGHT;
    end;
 
    //On dessine le texte
    DrawText(Handle,PChar(AString),-1,Rect,JustificationDuTexte or DT_NOPREFIX or DT_WORDBREAK );
  end;
end;
 
procedure Register;
begin
  RegisterComponents('WA', [TShapeText]);
end;
 
{ TShapeText }
 
procedure TShapeText.Paint;
var X, Y, W, H, S: Integer;
    ARect:TRect;
begin
  inherited Paint;
  with Canvas do
  begin
    X := Pen.Width div 2;
    Y := X;
    W := Width - Pen.Width + 1;
    H := Height - Pen.Width + 1;
    if Pen.Width = 0 then
    begin
      Dec(W);
      Dec(H);
    end;
    if W < H then S := W else S := H;
    if Shape in [stSquare, stRoundSquare, stCircle] then
    begin
      Inc(X, (W - S) div 2);
      Inc(Y, (H - S) div 2);
      W := S;
      H := S;
    end;
  end;
  ARect:=Bounds(X,Y,W,H);
  DessineTexteMultiligne(Caption,Canvas,ARect,
      FAlignementHorizontal,FAlignementVertical,FJustification);
end;
 
procedure TShapeText.SetAlignementHorizontal(
  const Value: TAlignementHorizontal);
begin
  if FAlignementHorizontal<>Value then
  begin
    FAlignementHorizontal := Value;
    Invalidate;
  end;
end;
 
procedure TShapeText.SetAlignementVertical(
  const Value: TAlignementVertical);
begin
  if FAlignementVertical<>Value then
  begin
    FAlignementVertical := Value;
    Invalidate;
  end;
end;
 
procedure TShapeText.SetJustification(const Value: TJustification);
begin
  if FJustification<>Value then
  begin
    FJustification := Value;
    Invalidate;
  end;
end;
 
end.

[cilies38]

Merci pour toutes ces solutions