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
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