TImage + Texte encore

Résolu
Signaler
Messages postés
103
Date d'inscription
vendredi 20 février 2004
Statut
Membre
Dernière intervention
16 mai 2019
-
Messages postés
103
Date d'inscription
vendredi 20 février 2004
Statut
Membre
Dernière intervention
16 mai 2019
-
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

Messages postés
3826
Date d'inscription
vendredi 23 juillet 2004
Statut
Modérateur
Dernière intervention
10 mai 2021
46
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
Messages postés
3826
Date d'inscription
vendredi 23 juillet 2004
Statut
Modérateur
Dernière intervention
10 mai 2021
46
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
Messages postés
3826
Date d'inscription
vendredi 23 juillet 2004
Statut
Modérateur
Dernière intervention
10 mai 2021
46
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
Messages postés
3826
Date d'inscription
vendredi 23 juillet 2004
Statut
Modérateur
Dernière intervention
10 mai 2021
46
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
Messages postés
3826
Date d'inscription
vendredi 23 juillet 2004
Statut
Modérateur
Dernière intervention
10 mai 2021
46
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
Messages postés
103
Date d'inscription
vendredi 20 février 2004
Statut
Membre
Dernière intervention
16 mai 2019

Bjr.

Cela Marche mais on dirais que cela n'arrete pas de peindre (Flashe)
une idee ?
Louis
Messages postés
3826
Date d'inscription
vendredi 23 juillet 2004
Statut
Modérateur
Dernière intervention
10 mai 2021
46
Salut,
poste ton code ici ce sera plus simple et surtout plus rapide pour moi pour trouver ce qui cloche



@+
Cirec
Messages postés
103
Date d'inscription
vendredi 20 février 2004
Statut
Membre
Dernière intervention
16 mai 2019

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
Messages postés
3826
Date d'inscription
vendredi 23 juillet 2004
Statut
Modérateur
Dernière intervention
10 mai 2021
46
bon j'ai besoin de savoir
- Picture ne sert qu'à afficher les BitMap tu ne charge plus rien directement dedans?



@+
Cirec
Messages postés
103
Date d'inscription
vendredi 20 février 2004
Statut
Membre
Dernière intervention
16 mai 2019

Non non

Louis
Messages postés
3826
Date d'inscription
vendredi 23 juillet 2004
Statut
Modérateur
Dernière intervention
10 mai 2021
46
bon, alors le temps pour moi de jeter un oeil (et de manger aussi c'est l'heure )
et je te tiend informé



@+
Cirec
Messages postés
103
Date d'inscription
vendredi 20 février 2004
Statut
Membre
Dernière intervention
16 mai 2019

OK Bon Courage et Bon Appetit

Encore Merci

Louis
Messages postés
103
Date d'inscription
vendredi 20 février 2004
Statut
Membre
Dernière intervention
16 mai 2019

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
Messages postés
103
Date d'inscription
vendredi 20 février 2004
Statut
Membre
Dernière intervention
16 mai 2019

Re Bjr

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



A+

Louis
Messages postés
103
Date d'inscription
vendredi 20 février 2004
Statut
Membre
Dernière intervention
16 mai 2019

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
Messages postés
103
Date d'inscription
vendredi 20 février 2004
Statut
Membre
Dernière intervention
16 mai 2019

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
Messages postés
103
Date d'inscription
vendredi 20 février 2004
Statut
Membre
Dernière intervention
16 mai 2019

OK et merci encore bonne soiree

Louis