Propriete MouseMove
Résolu
louiwahl
Messages postés
103
Date d'inscription
vendredi 20 février 2004
Statut
Membre
Dernière intervention
16 mai 2019
-
2 févr. 2006 à 22:40
Cirec Messages postés 3833 Date d'inscription vendredi 23 juillet 2004 Statut Modérateur Dernière intervention 18 septembre 2022 - 3 févr. 2006 à 16:01
Cirec Messages postés 3833 Date d'inscription vendredi 23 juillet 2004 Statut Modérateur Dernière intervention 18 septembre 2022 - 3 févr. 2006 à 16:01
A voir également:
- Mousemove javascript
- Récupérer données json (javascript) - Conseils pratiques -Javascript
- Javascript poo - Conseils pratiques -Javascript
- Base de données javascript - Conseils pratiques -Javascript
- Calendrier javascript - Conseils pratiques -Javascript
- Tuto javascript - Conseils pratiques -Javascript
6 réponses
Cirec
Messages postés
3833
Date d'inscription
vendredi 23 juillet 2004
Statut
Modérateur
Dernière intervention
18 septembre 2022
50
2 févr. 2006 à 23:52
2 févr. 2006 à 23:52
La procedure courante MouseMove :
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
Et celle qui permet de réagir en entant et en sortant :
procedure CMMouseEnter(var msg: TMessage);
message CM_MOUSEENTER;
procedure CMMouseLeave(var msg: TMessage);
message CM_MOUSELEAVE;
le tout à mettre dans la section private { Déclarations privées } de ton code
@+
Cirec
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
Et celle qui permet de réagir en entant et en sortant :
procedure CMMouseEnter(var msg: TMessage);
message CM_MOUSEENTER;
procedure CMMouseLeave(var msg: TMessage);
message CM_MOUSELEAVE;
le tout à mettre dans la section private { Déclarations privées } de ton code
@+
Cirec
Cirec
Messages postés
3833
Date d'inscription
vendredi 23 juillet 2004
Statut
Modérateur
Dernière intervention
18 septembre 2022
50
2 févr. 2006 à 23:08
2 févr. 2006 à 23:08
Salut,
c'est toujours le même composant le Bouton que tu fais ?
@+
Cirec
c'est toujours le même composant le Bouton que tu fais ?
@+
Cirec
louiwahl
Messages postés
103
Date d'inscription
vendredi 20 février 2004
Statut
Membre
Dernière intervention
16 mai 2019
2 févr. 2006 à 23:16
2 févr. 2006 à 23:16
Bjr Cirec Et oui
mais j'ai refais le code
le voici
unit LBtn;
interface
uses
Windows, Messages, SysUtils, Classes, Controls, Graphics;
type
TLBtn = class(tgraphicControl)
private
{ Déclarations privées }
FBmpNorm, FBmpDown: TBitmap;
FBmpTransparentColor: TColor;
procedure SetBmpTransparentColor(Value: TColor);
procedure SetBmpNorm(value:TBitmap);
procedure SetBmpDown(value:TBitmap);
protected
{ Déclarations protégées }
public
{ Déclarations publiques }
FColor: TColor;
FTransparent: Boolean;
FDown : Boolean;
procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
Procedure Paint;
Override;
// Shift: TShiftState;
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
procedure Click; override;
procedure DblClick; override;
property Owner;
property Parent;
published
{ Déclarations publiées }
property BmpNorm:TBitmap read FBmpNorm write SetBmpNorm;
property BmpDown:TBitmap read FBmpDown write SetBmpDown;
property BmpTransparentColor: TColor read FBmpTransparentColor
write SetBmpTransparentColor default clNone;
// property Align;
property Anchors;
property Constraints;
property Visible;
property Caption;
property Enabled;
property Font;
property OnClick;
property OnDblClick;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Louis', [TLBtn]);
end;
constructor TLBtn.Create(AOwner: TComponent);
begin
Inherited Create(AOwner);
Height:=25;
Width:=85;
FDown := False;
Cursor:=crHandPoint;
FBmpNorm:=TBitmap.Create;
FBmpDown:=TBitmap.Create;
FBmpTransparentColor:= clCaptionText;
end;
destructor TLBtn.Destroy;
begin
FBmpNorm.Free;
FBmpDown.Free;
Inherited Destroy;
end;
procedure TLBtn.CMTextChanged(var Message: TMessage);
begin
Invalidate;
end;
procedure TLBtn.Click;
begin
inherited Click;
Invalidate;
end;
procedure TLBtn.DblClick;
begin
inherited DblClick;
Invalidate;
end;
procedure TLBtn.SetBmpTransparentColor(Value: TColor);
begin
if value <> FBmpTransparentColor
then begin
FBmpTransparentColor := Value;
if not BmpNorm.Empty
then
if FBmpTransparentColor <> clNone
then begin
BmpNorm.Transparent := True;
BmpNorm.TransparentColor := FBmpTransparentColor;
end
else
BmpNorm.Transparent := False;
if not BmpDown.Empty
then
if FBmpTransparentColor <> clNone
then begin
BmpDown.Transparent := True;
BmpDown.TransparentColor := FBmpTransparentColor;
end
else
BmpDown.Transparent := False;
Invalidate;
end;
end;
procedure TLBtn.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
Y: integer);
begin
Inherited MouseDown(Button,Shift,X,Y);
If Enabled Then
if (Button = mbLeft)
then
begin
FDown := True;
Invalidate;
end;
end;
procedure TLBtn.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
Y: integer);
begin
Inherited MouseUp(Button,Shift,X,Y);
if Button = mbLeft then
begin
FDown := False;
Invalidate;
end;
end;
procedure TLBtn.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.StretchDraw(aRect, BmpDown);
OffsetRect(aRect, 1, 1);
DrawText(Canvas.Handle, PChar(Caption), -1, aRect, Flags);
End
Else
Begin
Canvas.StretchDraw(aRect, BmpNorm);
DrawText(Canvas.Handle, PChar(Caption), -1, aRect, Flags);
End;
end;
procedure TLBtn.SetBmpDown(value: TBitmap);
begin
try
BmpDown.Assign(value);
if not BmpDown.Empty
then begin
Width := BmpDown.Width;
Height := BmpDown.Height;
if FBmpTransparentColor <> clNone
then begin
BmpDown.Transparent := True;
BmpDown.TransparentColor := FBmpTransparentColor;
end
else
BmpDown.Transparent := False;
end;
except
end;
Invalidate;
end;
procedure TLBtn.SetBmpNorm(value: TBitmap);
begin
try
FBmpNorm.Assign(Value);
if not FBmpNorm.Empty
then begin
Width := FBmpNorm.Width;
Height := FBmpNorm.Height;
if FBmpTransparentColor <> clNone
then begin
FBmpNorm.Transparent := True;
FBmpNorm.TransparentColor := FBmpTransparentColor;
end
else
FBmpNorm.Transparent := False;
end;
except
end;
Invalidate;
end;
end.
J'espere qu'il est assez clair
Merci A+
Louis
mais j'ai refais le code
le voici
unit LBtn;
interface
uses
Windows, Messages, SysUtils, Classes, Controls, Graphics;
type
TLBtn = class(tgraphicControl)
private
{ Déclarations privées }
FBmpNorm, FBmpDown: TBitmap;
FBmpTransparentColor: TColor;
procedure SetBmpTransparentColor(Value: TColor);
procedure SetBmpNorm(value:TBitmap);
procedure SetBmpDown(value:TBitmap);
protected
{ Déclarations protégées }
public
{ Déclarations publiques }
FColor: TColor;
FTransparent: Boolean;
FDown : Boolean;
procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
Procedure Paint;
Override;
// Shift: TShiftState;
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
procedure Click; override;
procedure DblClick; override;
property Owner;
property Parent;
published
{ Déclarations publiées }
property BmpNorm:TBitmap read FBmpNorm write SetBmpNorm;
property BmpDown:TBitmap read FBmpDown write SetBmpDown;
property BmpTransparentColor: TColor read FBmpTransparentColor
write SetBmpTransparentColor default clNone;
// property Align;
property Anchors;
property Constraints;
property Visible;
property Caption;
property Enabled;
property Font;
property OnClick;
property OnDblClick;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Louis', [TLBtn]);
end;
constructor TLBtn.Create(AOwner: TComponent);
begin
Inherited Create(AOwner);
Height:=25;
Width:=85;
FDown := False;
Cursor:=crHandPoint;
FBmpNorm:=TBitmap.Create;
FBmpDown:=TBitmap.Create;
FBmpTransparentColor:= clCaptionText;
end;
destructor TLBtn.Destroy;
begin
FBmpNorm.Free;
FBmpDown.Free;
Inherited Destroy;
end;
procedure TLBtn.CMTextChanged(var Message: TMessage);
begin
Invalidate;
end;
procedure TLBtn.Click;
begin
inherited Click;
Invalidate;
end;
procedure TLBtn.DblClick;
begin
inherited DblClick;
Invalidate;
end;
procedure TLBtn.SetBmpTransparentColor(Value: TColor);
begin
if value <> FBmpTransparentColor
then begin
FBmpTransparentColor := Value;
if not BmpNorm.Empty
then
if FBmpTransparentColor <> clNone
then begin
BmpNorm.Transparent := True;
BmpNorm.TransparentColor := FBmpTransparentColor;
end
else
BmpNorm.Transparent := False;
if not BmpDown.Empty
then
if FBmpTransparentColor <> clNone
then begin
BmpDown.Transparent := True;
BmpDown.TransparentColor := FBmpTransparentColor;
end
else
BmpDown.Transparent := False;
Invalidate;
end;
end;
procedure TLBtn.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
Y: integer);
begin
Inherited MouseDown(Button,Shift,X,Y);
If Enabled Then
if (Button = mbLeft)
then
begin
FDown := True;
Invalidate;
end;
end;
procedure TLBtn.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
Y: integer);
begin
Inherited MouseUp(Button,Shift,X,Y);
if Button = mbLeft then
begin
FDown := False;
Invalidate;
end;
end;
procedure TLBtn.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.StretchDraw(aRect, BmpDown);
OffsetRect(aRect, 1, 1);
DrawText(Canvas.Handle, PChar(Caption), -1, aRect, Flags);
End
Else
Begin
Canvas.StretchDraw(aRect, BmpNorm);
DrawText(Canvas.Handle, PChar(Caption), -1, aRect, Flags);
End;
end;
procedure TLBtn.SetBmpDown(value: TBitmap);
begin
try
BmpDown.Assign(value);
if not BmpDown.Empty
then begin
Width := BmpDown.Width;
Height := BmpDown.Height;
if FBmpTransparentColor <> clNone
then begin
BmpDown.Transparent := True;
BmpDown.TransparentColor := FBmpTransparentColor;
end
else
BmpDown.Transparent := False;
end;
except
end;
Invalidate;
end;
procedure TLBtn.SetBmpNorm(value: TBitmap);
begin
try
FBmpNorm.Assign(Value);
if not FBmpNorm.Empty
then begin
Width := FBmpNorm.Width;
Height := FBmpNorm.Height;
if FBmpTransparentColor <> clNone
then begin
FBmpNorm.Transparent := True;
FBmpNorm.TransparentColor := FBmpTransparentColor;
end
else
FBmpNorm.Transparent := False;
end;
except
end;
Invalidate;
end;
end.
J'espere qu'il est assez clair
Merci A+
Louis
Cirec
Messages postés
3833
Date d'inscription
vendredi 23 juillet 2004
Statut
Modérateur
Dernière intervention
18 septembre 2022
50
2 févr. 2006 à 23:41
2 févr. 2006 à 23:41
bon, et tu veux quoi, pouvoir réagir quand la souris passe sur le bouton pour faire un effet comme le font certaint bouton ou juste capter le mouvement de la souris
@+
Cirec
@+
Cirec
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
louiwahl
Messages postés
103
Date d'inscription
vendredi 20 février 2004
Statut
Membre
Dernière intervention
16 mai 2019
3 févr. 2006 à 15:55
3 févr. 2006 à 15:55
Bjr.
Ca y est ca marche a merveille
Un grand merci a Cirec qui m'a beaucoup aider et pour ce site qui est tres bien fait.
Je pense mettre ce composant dans les sources des que j'aurais tout compris pour le commenter clairement. Il faut dire que j'apprend a programer tout seul avec de la doc
mais ce n'est pas facile.
Encore merci et A+
Louis
Ca y est ca marche a merveille
Un grand merci a Cirec qui m'a beaucoup aider et pour ce site qui est tres bien fait.
Je pense mettre ce composant dans les sources des que j'aurais tout compris pour le commenter clairement. Il faut dire que j'apprend a programer tout seul avec de la doc
mais ce n'est pas facile.
Encore merci et A+
Louis
Cirec
Messages postés
3833
Date d'inscription
vendredi 23 juillet 2004
Statut
Modérateur
Dernière intervention
18 septembre 2022
50
3 févr. 2006 à 16:01
3 févr. 2006 à 16:01
j'en sais quelque chose, j'ai appris comme toi tout seul, c'est pas facile mais on y arrive avec beaucoup de patience
@+
Cirec
@+
Cirec
