TSprite indépendant de l'objet de font

**mtloper** · 31/01/2008, 21h50

Salut,

j'ai fait une classe TTextSprite qui peux deplacer du text au coordonnees voulu sans affecter l'image en dessous.

Ca fonctionne bien mais il ne fonctionne que sur un TPaintBox seulement.
Je voudrait que ma classe fonctionne sur n'importequel objet ayant un canvas.( je veux quelle soit plus universelle)
exemple : je veux pouvoir afficher sur unTImage, TBitMap ou TForm sans changer le code dans ma class.

Comment faire ?

Voici ma classe:

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
unit Sprites;
 
interface
 
uses
  Windows, SysUtils,Classes,Graphics,ExtCtrls;
type
 
  TSpriteOrigin = (so00,so10,so11,so01);                                        //correspond au 4 point cartesient
 
 
  TTextSprite = Class
  private
    FSpriteOrigin : TSpriteOrigin;   //origine du point x,y  en bas a droit, en haut a gauche etc...
    FActive : Boolean;       
    RBG : TRect;             //Rect BackCround
    BG  : TBitMap;           //BackGround
    Target : TPaintBox;  <______C'EST ICI QUE JE VOUDRAIS UN VARIANT COMME OBJET
 
 
 
  public
    W,H : Integer;           //Dimention de l'espace que prend le text
    RFG : Trect;             //Rect ForeGround
    FG  : TBitMap;           //ForGround
    Constructor Create(Destination:TPaintbox);  <______    
    Destructor Destroy;
    procedure  Show(x, y: Integer;T:String);
    procedure  Hide;
    Procedure  DoActivate(Rep:Boolean);
    procedure SetSpriteOrigin(Origin: TSpriteOrigin);      
  published
  End;
implementation
 
 
Procedure TTextSprite.SetSpriteOrigin(Origin:TSpriteOrigin);
Begin
  FSpriteOrigin := Origin;
End;
 
Procedure TTextSprite.DoActivate(Rep:Boolean);
Begin
  if rep = false then begin
    rbg:= RECT(-100,-100,1,1);
    rfg:= RECT(-100,-100,1,1);
  end;
  FActive := Rep;
End;
Constructor TTextSprite.Create(Destination:TPaintBox); <______
Begin
  Target := Destination;  //<______
  FG := TBitMap.Create;
  BG := TBitmap.Create;
 
  fg.Canvas.Font.name   := Target.Canvas.Font.name;  
  fg.Canvas.Font.size   := Target.Canvas.Font.Size;
  fg.Canvas.Font.Color  := Target.Canvas.Font.Color;
 
  fg.Canvas.Brush.Color := Target.Canvas.Brush.Color;
  fg.Canvas.Pen.Color   := Target.Canvas.Pen.Color;
  FActive := true;
  FSpriteOrigin := so00;                                                        //Par default set origine en haut a gauche (normale)
End;
 
Destructor TTextSprite.Destroy;
begin
  FG.Free;
  BG.Free;
end;
 
Procedure TTextSprite.Show(x,y:Integer;T:String);
Var TW : integer;
Begin
  if not Factive then exit;
  W := FG.Canvas.TextWidth(T)+2;
  H := FG.Canvas.TextHeight(T)+2;
 
  case FSpriteOrigin of                                                         
  so01: Y := Y - H;
  so10: X := X - W;
  so11:
    Begin
      Y := Y - H;
      X := X - W;
    End;
  end;
 
  RBG := rect(x,y,x+w,y+h);
  RFG := RECT(0,0,w,h);
 
  bg.Width := w;
  bg.Height := h;
 
 bg.Canvas.CopyRect(RFG,Target.canvas,RBG);                           //Memorise l'image avant de dessiner
 
  FG.Width  :=w;
  FG.Height :=h;
  fg.canvas.Brush.Color := $f0f0f0;//clltgray;
  fg.Canvas.TextRect(RFG,0,0,t);
  Target.canvas.CopyRect(RBG,fg.Canvas ,RFG);
 
End;
Procedure TTextSprite.Hide;
begin
  if FActive then
    Target.canvas.CopyRect(RBG,bg.Canvas ,rfg); //REPLACE L'IMAGE TARGET
end;
 
end.
 
{
exemple d'utilisation
 code Pour bouger le TextSprite
 Dans create form..
 1-ts:=TTextSprite.Create(PaintBox1);
   ts.fg.Canvas.Brush.Color:=rclred;
 
 ...
 
 Dans mouseMove
 ts.Hide;                                                                //Replacer l'image arriere
 ts.Show(x,y,'Coor :'+ Inttostr(x) +','+ inttostr(y));   //Memorise l'image arriere et affiche le TextSprite devant Limage arriere
 
}

Merci d'avance
Madmax

**ero-sennin** · 31/01/2008, 22h55

Salut et Bienvenue sur Developpez.com,

Je ne suis pas trop calé dans ce genre de choses, mais je te propose une piste, c'est de travailler avec la classe TCanvas

Ainsi, tu ne te limites pas à un objet. Tu peux faire en sorte d'utiliser tous objets qui possède un canevas ...

Je mettrai donc ceci :

Code :

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

Target : TCanvas;

Biensur, celà implique des changements dans le code car l'on travaille directement avec le canvas de l'objet et non plus avec l'objet ... Je ne sais pas si c'est bon (j'ai une erreur de violation d'accès dans le OnMouseMove lorsque je veux tester la classe comme tu l'as cité) mais ça donnerai un truc du genre :

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
unit Sprites;
 
interface
 
uses
  Windows, SysUtils,Classes,Graphics,Controls,ExtCtrls;
type
 
  TSpriteOrigin = (so00,so10,so11,so01);                                        //correspond au 4 point cartesient
 
 
  TTextSprite = Class
  private
    FSpriteOrigin : TSpriteOrigin;   //origine du point x,y  en bas a droit, en haut a gauche etc...
    FActive : Boolean;       
    RBG : TRect;             //Rect BackCround
    BG  : TBitMap;           //BackGround
    Target : TCanvas;  // TCanvas
 
 
 
  public
    W,H : Integer;           //Dimention de l'espace que prend le text
    RFG : Trect;             //Rect ForeGround
    FG  : TBitMap;           //ForGround
    Constructor Create(Destination:TCanvas);
    Destructor Destroy;override;
    procedure  Show(x, y: Integer;T:String);
    procedure  Hide;
    Procedure  DoActivate(Rep:Boolean);
    procedure SetSpriteOrigin(Origin: TSpriteOrigin);      
  published
  End;
implementation
 
 
Procedure TTextSprite.SetSpriteOrigin(Origin:TSpriteOrigin);
Begin
  FSpriteOrigin := Origin;
End;
 
Procedure TTextSprite.DoActivate(Rep:Boolean);
Begin
  if rep = false then begin
    rbg:= RECT(-100,-100,1,1);
    rfg:= RECT(-100,-100,1,1);
  end;
  FActive := Rep;
End;
Constructor TTextSprite.Create(Destination:TCanvas);
Begin
  Target:=Destination;
  FG := TBitMap.Create;
  BG := TBitmap.Create;
 
  fg.Canvas.Font.name   := Destination.Font.name;
  fg.Canvas.Font.size   := Destination.Font.Size;
  fg.Canvas.Font.Color  := Destination.Font.Color;
 
  fg.Canvas.Brush.Color := Destination.Brush.Color;
  fg.Canvas.Pen.Color   := Destination.Pen.Color;
  FActive := true;
  FSpriteOrigin := so00;                                                        //Par default set origine en haut a gauche (normale)
End;
 
Destructor TTextSprite.Destroy;
begin
  FG.Free;
  BG.Free;
  inherited;
end;
 
Procedure TTextSprite.Show(x,y:Integer;T:String);
Begin
  if not Factive then exit;
  W := FG.Canvas.TextWidth(T)+2;
  H := FG.Canvas.TextHeight(T)+2;
 
  case FSpriteOrigin of                                                         
  so01: Y := Y - H;
  so10: X := X - W;
  so11:
    Begin
      Y := Y - H;
      X := X - W;
    End;
  end;
 
  RBG := rect(x,y,x+w,y+h);
  RFG := RECT(0,0,w,h);
 
  bg.Width := w;
  bg.Height := h;
 
 bg.Canvas.CopyRect(RFG,Target,RBG);                           //Memorise l'image avant de dessiner
 
  FG.Width  :=w;
  FG.Height :=h;
  fg.canvas.Brush.Color := $f0f0f0;//clltgray;
  fg.Canvas.TextRect(RFG,0,0,t);
  Target.CopyRect(RBG,fg.Canvas ,RFG);
 
End;
Procedure TTextSprite.Hide;
begin
  if FActive then
    Target.CopyRect(RBG,bg.Canvas ,rfg); //REPLACE L'IMAGE TARGET
end;
 
end.
 
{
exemple d'utilisation
 code Pour bouger le TextSprite
 Dans create form..
 1-ts:=TTextSprite.Create(PaintBox1);
   ts.fg.Canvas.Brush.Color:=rclred;
 
 ...
 
 Dans mouseMove
 ts.Hide;                                                                //Replacer l'image arriere
 ts.Show(x,y,'Coor :'+ Inttostr(x) +','+ inttostr(y));   //Memorise l'image arriere et affiche le TextSprite devant Limage arriere
 
}

A+

EDIT:
Je n'ai plus d'erreur

J'avais oublié une petite instruction dans le code, désormais, tout fonctionne

Pour l'utilisation :
Avec un TPaintBox par exemple :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
procedure TForm1.FormCreate(Sender: TObject);
begin
  ts:=TTextSprite.Create(PaintBox1.Canvas);
  ts.FG.Canvas.Brush.Color:=clRed;
end;
 
procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  ts.Hide;
  ts.Show(x,y,'Coor :'+ Inttostr(x) +','+ inttostr(y));
end;

Pour une Form :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
procedure TForm1.FormCreate(Sender: TObject);
begin
  ts:=TTextSprite.Create(Form1.Canvas);
  ts.FG.Canvas.Brush.Color:=clRed;
end;
 
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  ts.Hide;
  ts.Show(x,y,'Coor :'+ Inttostr(x) +','+ inttostr(y));
end;

J'espère que ça te correspondra ...
A+

**Gilbert Geyer** · 01/02/2008, 14h27

Salut,

J'ai testé le code en pensant que BG : TBitMap; serait utilisé comme une image qui accompagenrait le texte mais nenni. Bien que le code marche, si c'est juste pour afficher les coordonnées de la souris il est bigrement plus simple d'utiliser un TLabel qui peut même être rendu transparent et dont on fait varier le Left et le Top en fonction du X,Y du MouseMove : ça prend une poignée de lignes de code au lieu des 120 utilisées par TTextSprite = Class.

Code :

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

1
2
3
4
5
6
7
 
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  with label2 do
  begin left:=X+5; top:=Y+5; caption:='Coor : '+ Inttostr(x) +','+ inttostr(y); end;
end;

A+

EDIT : un oubli, il faut que le Label utilisé à cet effet soit le dernier objet posé sur la Form sinon il risque de passer en-dessous de ceux qui y ont éventuellement été déposés après lui.

**Archimède** · 01/02/2008, 16h28

Sinon à la place de Tpaintbox, on pourrait mettre Tgraphiccontrol mais pour un bitmap, c'est pas bon(Tgraphic).

**ero-sennin** · 01/02/2008, 16h34

Envoyé par Archimède

Sinon à la place de Tpaintbox, on pourrait mettre Tgraphiccontrol mais pour un bitmap, c'est pas bon(Tgraphic).

Justement, je ne pense pas que ça fonctionne

. J'avais essayé et le soucis, c'est qu'on accède pas au Canvas ... Donc je suis passé par un TCanvas directement

**Gilbert Geyer** · 01/02/2008, 16h36

Salut,

à la place de Tpaintbox, on pourrait mettre Tgraphiccontrol

... si j'ai bien pigé, l'objectif est d'afficher les coordonnées de la souris à côté du pointeur de la souris "sans affecter l'image en dessous" donc quel que soit l'objet (TForm, TPaintBox, TImage, Tgraphiccontrol ...) qui contient cette image ... et pour faire ceci il suffit d'un TLabel.

A+

EDIT : posts croisés

**Archimède** · 01/02/2008, 17h37

Envoyé par ero-sennin

Justement, je ne pense pas que ça fonctionne

. J'avais essayé et le soucis, c'est qu'on accède pas au Canvas ... Donc je suis passé par un TCanvas directement

Ok, c'était une idée comme ça... J'ai pas testé... je te fais confiance.

**mtloper** · 02/02/2008, 07h59

Dabord je voudrait vous dir que je suis agrablement surpris de votre hospitalite
et merci a tous car sa ma beaucoup aider au sujet de passer le canvas au lieut de l'objet ( je croyait que je ne pouvait pas passer un canvas au paravant )

Pour repondre a la question du TLabel
je prefere utiliser mon TTextSprite au lieu d'utiliser un TLabel car s'est une question de rapiditer et de pouvoir afficher autre chose dans future.
vous savez la rapidite du graphic sur XP n'est pas terible par rapport a window2000.

Merci a tous et particulierement a toi ero-sennin

TSprite indépendant de l'objet de font

Langage Delphi

Discussions similaires

Partager

Partager