TImage + Texte encore

Résolu
louiwahl Messages postés 103 Date d'inscription vendredi 20 février 2004 Statut Membre Dernière intervention 16 mai 2019 - 23 janv. 2006 à 22:38
louiwahl Messages postés 103 Date d'inscription vendredi 20 février 2004 Statut Membre Dernière intervention 16 mai 2019 - 26 janv. 2006 à 19:42
Bjr



voila dans mon composant bouton deriver de TImage j'ai mis la
proprietee Caption que je voudrais voire afficher sur mon bouton a la
creation de celui-ci mais je n'arrive qu'a le faire afficher quand je
charge un Bmp avec une proprietee que j'ai ajouter

voila ma fonction Create



Constructor TLBouton.Create(AOwner:TComponent);

begin

Inherited Create(AOwner);

Height:=25;

Width:=60;

Cursor:=crHandPoint; {par défaut, mets le curseur en forme de main}

Canvas.brush.style := bsClear;

Canvas.TextOut(Height div 2,5,Caption);

stretch := True;

AutoSize := True;

Transparent := True;

end;



Quand je fais Canvas.TextOut(Height div 2,5,'Caption'); ca marche

si quelqu'un a une idee



Merci
Louis

17 réponses

Cirec Messages postés 3833 Date d'inscription vendredi 23 juillet 2004 Statut Modérateur Dernière intervention 18 septembre 2022 50
26 janv. 2006 à 13:16
Bon, j'ai un peut remanié ton code je l'ai dérivé de TGraphicControl qui me semble plus adapté que TImage et voilà ce que ça donne :

unit LBouton;


interface


uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;


type
TLBouton = class(TGraphicControl)
private
{ Déclarations privées }
FBmpNorm, FBmpDown: TBitmap; // FBmpNul,
FDown : Boolean;
procedure SetBmpNorm(value:TBitmap);
procedure SetBmpDown(value:TBitmap);
protected
{ Déclarations protégées }
public
{ Déclarations publiques }
Procedure Paint; Override;
procedure MouseDown(Button:TMouseButton; Shift:TShiftState; X, Y :integer); override;
procedure MouseUp(Button:TMouseButton; Shift:TShiftState; X, Y :integer); override;
Constructor Create(AOwner:TComponent); override; // création du composant
Destructor Destroy; override; // destruction du composant
published
{ Déclarations publiées }
property BmpNorm:TBitmap read FBmpNorm write SetBmpNorm;
property BmpDown:TBitmap read FBmpDown write SetBmpDown;
property Caption;
property Enabled;
property Font;
end;


procedure Register;


implementation


procedure Register;
begin
RegisterComponents('Louis', [TLBouton]);
end;


{ TLBouton }


constructor TLBouton.Create(AOwner: TComponent);
begin
Inherited Create(AOwner);
FDown := False;
Height:=25;
Width:=60;
Cursor:=crHandPoint; {par défaut, mets le curseur en forme de main}
FBmpNorm:=TBitmap.Create;
FBmpDown:=TBitmap.Create;
// stretch := True;
// AutoSize := True;
// Transparent := True;
end;


destructor TLBouton.Destroy;
begin
FBmpNorm.Free;
FBmpDown.Free;
Inherited Destroy;
end;


procedure TLBouton.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
Y: integer);
begin
Inherited MouseDown(Button,Shift,X,Y);
If Enabled Then
if (Button = mbLeft) and ptInRect(ClientRect, Point(x, y)) then
begin
FDown := True;
Invalidate;
end;
end;


procedure TLBouton.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
Y: integer);
begin
Inherited MouseDown(Button,Shift,X,Y);
if Button = mbLeft then
begin
FDown := False;
Invalidate;
end;
end;


procedure TLBouton.Paint;
Var aRect : TRect; Flags : LongWord;
begin
Inherited;
aRect := ClientRect;
Canvas.Font := Font;
Canvas.Brush.Style := bsClear;
Flags := DT_Center Or DT_VCENTER Or DT_EXPANDTABS Or DT_SINGLELINE;
If (FDown) and (Enabled) Then
Begin
//Canvas.Draw(0, 0, BmpDown); // dessin Normal
Canvas.StretchDraw(aRect, BmpDown); // ou Stretch au choix l'un ou l'autre
OffsetRect(aRect, 1, 1); // on decale le texte pour donner l'impression de pression
DrawText(Canvas.Handle, PChar(Caption), -1, aRect, Flags);
End
Else
Begin
//Canvas.Draw(0, 0, BmpNorm); // dessin Normal
Canvas.StretchDraw(aRect, BmpNorm); // ou Stretch au choix l'un ou l'autre
DrawText(Canvas.Handle, PChar(Caption), -1, aRect, Flags);
End;
end;


procedure TLBouton.SetBmpDown(value: TBitmap);
begin
BmpDown.Assign(value);
Invalidate; // Invalidate va déclancher Paint
end;


procedure TLBouton.SetBmpNorm(value: TBitmap);
begin
BmpNorm.Assign(value);
Invalidate;
end;


end.

Si tu as encore des Questions n'hésite pas
Si la réponse te convient n'oublie pas de cliquer sur Réponse Acceptée



@+
Cirec
3
Cirec Messages postés 3833 Date d'inscription vendredi 23 juillet 2004 Statut Modérateur Dernière intervention 18 septembre 2022 50
26 janv. 2006 à 19:04
c'est à dire ?
ceux que tu avais mis avant la modification où quoi ? ça c'est Normal il faut les retirer puis remettre des nouveaux



@+
Cirec
3
Cirec Messages postés 3833 Date d'inscription vendredi 23 juillet 2004 Statut Modérateur Dernière intervention 18 septembre 2022 50
26 janv. 2006 à 19:30
Bon deux chose,

1°)

TLBouton = class(TGraphicControl)
FBmpNorm, FBmpDown: TBitmap; // est mal placé
private
{ Déclarations privées }
FBmpNorm, FBmpDown: TBitmap; // il faut le mettre ici
FDown : Boolean;
procedure SetBmpNorm(value:TBitmap);
procedure SetBmpDown(value:TBitmap);
protected

2°)
published
{ Déclarations publiées }
property BmpNorm:TBitmap read FBmpNorm write SetBmpNorm;
property BmpDown:TBitmap read FBmpDown write SetBmpDown;
property Caption;
property Enabled; // cette propritée est manquante chez toi et je pense que ça vient de là
property Font;
end;



@+
Cirec
3
Cirec Messages postés 3833 Date d'inscription vendredi 23 juillet 2004 Statut Modérateur Dernière intervention 18 septembre 2022 50
26 janv. 2006 à 19:33
pas de soucis mais fait quand même les deux midifications la propriété Enabled te serviras à désactiver le bouton si tu mets sa valeur à False



@+
Cirec
3

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Cirec Messages postés 3833 Date d'inscription vendredi 23 juillet 2004 Statut Modérateur Dernière intervention 18 septembre 2022 50
24 janv. 2006 à 15:26
Salut,
faire un Bouton avec un TImage à mon avis c'est pas la bonne solution mais bon c'est ton choix.
pour le reste il faut surcharger la procedure paint de ton nouveau composant :

MyBouton = Class (TImage)
....
Protected
{ Déclarations protégées }
Procedure Paint; Override;
....
End;

Implementation

Procedure MyBouton.Paint
Begin
Inherited; // ceci va appeler la procedure Paint de TImage donc la dessiner
Canvas.brush.style : = bsClear; // et ensuite tu écris ton texte
Canvas.TextOut(Height div 2,5,Caption);
End;



@+
Cirec
0
louiwahl Messages postés 103 Date d'inscription vendredi 20 février 2004 Statut Membre Dernière intervention 16 mai 2019
26 janv. 2006 à 10:41
Bjr.

Cela Marche mais on dirais que cela n'arrete pas de peindre (Flashe)
une idee ?
Louis
0
Cirec Messages postés 3833 Date d'inscription vendredi 23 juillet 2004 Statut Modérateur Dernière intervention 18 septembre 2022 50
26 janv. 2006 à 11:17
Salut,
poste ton code ici ce sera plus simple et surtout plus rapide pour moi pour trouver ce qui cloche



@+
Cirec
0
louiwahl Messages postés 103 Date d'inscription vendredi 20 février 2004 Statut Membre Dernière intervention 16 mai 2019
26 janv. 2006 à 11:31
OK voila mon code



unit LBouton;



interface



uses

Windows, Messages, SysUtils, Classes, StdCtrls,Graphics, Forms,Controls, ExtCtrls, CommCtrl;



type

TLBouton = class(TImage)

private

{ Déclarations privées }

protected

{ Déclarations protégées }

FBmpNul, FBmpNorm, FBmpDown: TBitmap;

Procedure Paint; Override;

procedure SetBmpNorm(value:TBitmap);

procedure SetBmpDown(value:TBitmap);

procedure MouseDown(Button:TMouseButton; Shift:TShiftState; X, Y :integer); override;

procedure MouseUp(Button:TMouseButton; Shift:TShiftState; X, Y :integer); override;

public

{ Déclarations publiques }

Constructor Create(AOwner:TComponent); override; // création du composant

Destructor Destroy; override; // destruction du composant

published

{ Déclarations publiées }

property BmpNorm:TBitmap read FBmpNorm write SetBmpNorm;

property BmpDown:TBitmap read FBmpDown write SetBmpDown;

property Caption;

property Font;

end;



procedure Register;



var Hg, Lg: integer; // taille du bouton





implementation



Procedure TLBouton.Paint;

begin

Inherited; // ceci va appeler la procedure Paint de TImage donc la dessiner

Canvas.brush.style := bsClear; // et ensuite tu écris ton texte

Canvas.TextOut(Height div 2,5,Caption);

End;



Constructor TLBouton.Create(AOwner:TComponent);

begin

Inherited Create(AOwner);

Height:=25;

Width:=60;

Cursor:=crHandPoint; {par défaut, mets le curseur en forme de main}

FBmpNorm:=TBitmap.Create;

FBmpDown:=TBitmap.Create;

stretch := True;

AutoSize := True;

Transparent := True;

end;



Destructor TLBouton.Destroy;

begin

FBmpNorm.Free;

FBmpDown.Free;

Inherited Destroy;

end;



Procedure TLBouton.SetBmpNorm(value:TBitmap);

begin

BmpNorm.Assign(value);

Picture.Assign(Value);

Canvas.brush.style := bsClear;

Canvas.TextOut(Height div 2,5,Caption);

paint;

end;



Procedure TLBouton.SetBmpDown(value:TBitmap);

begin

BmpDown.Assign(value);

Canvas.brush.style := bsClear;

Canvas.TextOut(Height div 2,5,Caption);

paint;

end;



procedure TLBouton.MouseDown(Button:TMouseButton; Shift:TShiftState; X,Y:integer);

begin

Inherited MouseDown(Button,Shift,X,Y);

if Button = mbLeft then

begin

Picture.Assign(BmpDown);

end;

end;



procedure TLBouton.MouseUp(Button:TMouseButton; Shift:TShiftState; X, Y :integer);

begin

Inherited MouseDown(Button,Shift,X,Y);

if Button = mbLeft then

begin

Picture.Assign(BmpNorm);

end;

end;



procedure Register;

begin

RegisterComponents('Louis', [TLBouton]);

end;



end.



Merci encore

Louis
0
Cirec Messages postés 3833 Date d'inscription vendredi 23 juillet 2004 Statut Modérateur Dernière intervention 18 septembre 2022 50
26 janv. 2006 à 11:40
bon j'ai besoin de savoir
- Picture ne sert qu'à afficher les BitMap tu ne charge plus rien directement dedans?



@+
Cirec
0
louiwahl Messages postés 103 Date d'inscription vendredi 20 février 2004 Statut Membre Dernière intervention 16 mai 2019
26 janv. 2006 à 11:50
Non non

Louis
0
Cirec Messages postés 3833 Date d'inscription vendredi 23 juillet 2004 Statut Modérateur Dernière intervention 18 septembre 2022 50
26 janv. 2006 à 11:53
bon, alors le temps pour moi de jeter un oeil (et de manger aussi c'est l'heure )
et je te tiend informé



@+
Cirec
0
louiwahl Messages postés 103 Date d'inscription vendredi 20 février 2004 Statut Membre Dernière intervention 16 mai 2019
26 janv. 2006 à 11:57
OK Bon Courage et Bon Appetit

Encore Merci

Louis
0
louiwahl Messages postés 103 Date d'inscription vendredi 20 février 2004 Statut Membre Dernière intervention 16 mai 2019
26 janv. 2006 à 13:33
Je te remerci encore



je vais essayer ça ce soir car "Travail travail" quand tu nous tiens!!

est là il faut que j'y aille



A+

Louis
0
louiwahl Messages postés 103 Date d'inscription vendredi 20 février 2004 Statut Membre Dernière intervention 16 mai 2019
26 janv. 2006 à 18:38
Re Bjr

Cela Marche mais a l'execution je n'est plus de bouton ( Snif snif ) sur ma form



A+

Louis
0
louiwahl Messages postés 103 Date d'inscription vendredi 20 février 2004 Statut Membre Dernière intervention 16 mai 2019
26 janv. 2006 à 19:22
Non j' ai modifier mon programe



unit LBouton;



interface



uses

Windows, Messages, SysUtils, Classes, StdCtrls,Graphics, Forms,Controls, ExtCtrls, CommCtrl;



type

TLBouton = class(TGraphicControl)

FBmpNorm, FBmpDown: TBitmap;

private

{ Déclarations privées }

// FBmpNorm, FBmpDown: TBitmap;

FDown : Boolean;

procedure SetBmpNorm(value:TBitmap);

procedure SetBmpDown(value:TBitmap);

protected

{ Déclarations protégées }

public

{ Déclarations publiques }

Procedure Paint; Override;

procedure MouseDown(Button:TMouseButton; Shift:TShiftState; X, Y :integer); override;

procedure MouseUp(Button:TMouseButton; Shift:TShiftState; X, Y :integer); override;

Constructor Create(AOwner:TComponent); override; // création du composant

Destructor Destroy; override; // destruction du composant

published

{ Déclarations publiées }

property BmpNorm:TBitmap read FBmpNorm write SetBmpNorm;

property BmpDown:TBitmap read FBmpDown write SetBmpDown;

property Caption;

property Font;

end;



procedure Register;



var Hg, Lg: integer; // taille du bouton



implementation



procedure Register;

begin

RegisterComponents('Louis', [TLBouton]);

end;



{ TLBouton }



constructor TLBouton.Create(AOwner: TComponent);

begin

Inherited Create(AOwner);

FDown := False;

Height:=25;

Width:=80;

Cursor:=crHandPoint; {par défaut, mets le curseur en forme de main}

FBmpNorm:=TBitmap.Create;

FBmpDown:=TBitmap.Create;

end;



destructor TLBouton.Destroy;

begin

FBmpNorm.Free;

FBmpDown.Free;

Inherited Destroy;

end;



procedure TLBouton.MouseDown(Button: TMouseButton; Shift: TShiftState; X,

Y: integer);

begin

Inherited MouseDown(Button,Shift,X,Y);

If Enabled Then

if (Button = mbLeft) and ptInRect(ClientRect, Point(x, y)) then

begin

FDown := True;

Invalidate;

end;

end;



procedure TLBouton.MouseUp(Button: TMouseButton; Shift: TShiftState; X,

Y: integer);

begin

Inherited MouseDown(Button,Shift,X,Y);

if Button = mbLeft then

begin

FDown := False;

Invalidate;

end;

end;



procedure TLBouton.Paint;

Var aRect : TRect; Flags : LongWord;

begin

Inherited;

aRect := ClientRect;

Canvas.Font := Font;

Canvas.Brush.Style := bsClear;

Flags := DT_Center Or DT_VCENTER Or DT_EXPANDTABS Or DT_SINGLELINE;

If (FDown) and (Enabled) Then

Begin

//Canvas.Draw(0, 0, BmpDown); // dessin Normal

Canvas.StretchDraw(aRect, BmpDown); // ou Stretch au choix l'un ou l'autre

OffsetRect(aRect, 1, 1); // on decale le texte pour donner l'impression de pression

DrawText(Canvas.Handle, PChar(Caption), -1, aRect, Flags);

End

Else

Begin

//Canvas.Draw(0, 0, BmpNorm); // dessin Normal

Canvas.StretchDraw(aRect, BmpNorm); // ou Stretch au choix l'un ou l'autre

DrawText(Canvas.Handle, PChar(Caption), -1, aRect, Flags);

End;

end;



procedure TLBouton.SetBmpDown(value: TBitmap);

begin

BmpDown.Assign(value);

Invalidate; // Invalidate va déclancher Paint

end;



procedure TLBouton.SetBmpNorm(value: TBitmap);

begin

BmpNorm.Assign(value);

Invalidate;

end;



end.



Sur ma form tout vas bien mais a l'execution plus de bouton ??

Louis
0
louiwahl Messages postés 103 Date d'inscription vendredi 20 février 2004 Statut Membre Dernière intervention 16 mai 2019
26 janv. 2006 à 19:26
10 000 000 D'EXCUSES je viens de le recompiler et reposer sur ma form et ca marche

Excuse moi encore pour ton temps de perdus



et encore merci

Louis
0
louiwahl Messages postés 103 Date d'inscription vendredi 20 février 2004 Statut Membre Dernière intervention 16 mai 2019
26 janv. 2006 à 19:42
OK et merci encore bonne soiree

Louis
0
Rejoignez-nous