Можно ли из 3-х Image(картинок) сделать компонент-кнопку

Code:

{*******************************************************}

{       Sprite Button                                   }

{       Copyright (c)  Михаил Мостовой        }

{*******************************************************}

unit SpriteBtn;

interface

uses

Windows, SysUtils, Classes, Controls, Graphics, Types, Messages;

type

TSpriteButton = class(TGraphicControl)

private

   FPicturePressed: TPicture;

   FPictureFocused: TPicture;

   FPictureNormal: TPicture;

   FPictureDisabled: TPicture;

   FEnabled: Boolean;

   FPressed: Boolean;

   FFocused: Boolean;

   FDrawing: Boolean;

   FTransparent: Boolean;

   procedure SetPictureFocused(const Value: TPicture);

   procedure SetPicturePressed(const Value: TPicture);

   procedure SetPictureNormal(const Value: TPicture);

   procedure SetPictureDisabled(const Value: TPicture);

   procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;

   procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;

   procedure OnPictureChange(Sender: TObject);

   procedure UpdateButtonState;

   procedure SetTransparent(const Value: Boolean);

protected

   procedure Paint; override;

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

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

public

   constructor Create(AOwner: TComponent); override;

   destructor Destroy; override;

published

   property Action;

   property Anchors;

   property Caption;

   property Enabled;

   property Font;

   property ShowHint;

   property ParentShowHint;

   property OnClick;

   property OnMouseDown;

   property PictureNormal: TPicture read FPictureNormal write SetPictureNormal;

   property PictureFocused: TPicture read FPictureFocused write SetPictureFocused;

   property PicturePressed: TPicture read FPicturePressed write SetPicturePressed;

   property PictureDisabled: TPicture read FPictureDisabled write SetPictureDisabled;

   property Transparent: Boolean read FTransparent write SetTransparent;

end;

procedure Register;

implementation

uses Consts;

procedure Register;

begin

RegisterComponents('MSX Controls', [TSpriteButton]);

end;

{ TSpriteButton }

constructor TSpriteButton.Create(AOwner: TComponent);

begin

inherited;

FEnabled := True;

FPictureNormal := TPicture.Create;

FPictureNormal.OnChange := OnPictureChange;

FPictureFocused := TPicture.Create;

FPicturePressed := TPicture.Create;

FPictureDisabled := TPicture.Create;

FPressed := False;

FFocused := False;

FDrawing := False;

end;

destructor TSpriteButton.Destroy;

begin

FPictureNormal.Free;

FPictureFocused.Free;

FPicturePressed.Free;

FPictureDisabled.Free;

inherited;

end;

procedure TSpriteButton.SetPictureNormal(const Value: TPicture);

begin

PictureNormal.Assign(Value);

if Assigned(Value) then

begin

   Width := Value.Width;

   Height := Value.Height;

end;

if not FDrawing then Invalidate;

end;

procedure TSpriteButton.SetPictureFocused(const Value: TPicture);

begin

FPictureFocused.Assign(Value);

end;

procedure TSpriteButton.SetPicturePressed(const Value: TPicture);

begin

FPicturePressed.Assign(Value);

end;

procedure TSpriteButton.SetPictureDisabled(const Value: TPicture);

begin

FPictureDisabled.Assign(Value);

end;

procedure TSpriteButton.CMMouseEnter(var Message: TMessage);

begin

if Enabled = False then Exit;

FFocused := True;

if not FDrawing then Invalidate;

end;

procedure TSpriteButton.CMMouseLeave(var Message: TMessage);

begin

if Enabled = False then Exit;

FFocused := False;

if not FDrawing then Invalidate;

end;

procedure TSpriteButton.MouseDown(Button: TMouseButton; Shift: TShiftState;

X, Y: Integer);

begin

inherited;

if Enabled = False then Exit;

if Button = mbLeft then

begin

   FPressed := True;

   FFocused := True;

   if not FDrawing then Invalidate;

end;

end;

procedure TSpriteButton.MouseUp(Button: TMouseButton; Shift: TShiftState;

X, Y: Integer);

begin

if Enabled = False then Exit;

if Button = mbLeft then

begin

   FPressed := False;

   if not FDrawing then Invalidate;

end;

inherited; 

end;

procedure TSpriteButton.OnPictureChange(Sender: TObject);

begin

Width := PictureNormal.Width;

Height := PictureNormal.Height;

if not FDrawing then Invalidate;

end;

procedure TSpriteButton.UpdateButtonState;

var

Picture: TPicture;

begin

if Enabled then

begin

   if not (csDesigning in ComponentState) then

   begin

     if (FPressed and FFocused) then

       Picture := PicturePressed

     else

       if (not FPressed and FFocused) then

         Picture := PictureFocused

       else

         Picture := PictureNormal;

   end else Picture := PictureNormal;

end else begin

   FFocused := False;

   FPressed := False;

   Picture := PictureDisabled;

end;

if (Picture <> PictureNormal) and ((Picture.Width = 0) or (Picture.Height = 0)) then

   Picture := PictureNormal;

if (csDesigning in ComponentState) and

    ((not Assigned(Picture.Graphic)) or (Picture.Width = 0) or (Picture.Height = 0)) then

begin

   with Canvas do

   begin

     Pen.Style := psDash;

     Pen.Color := clBlack;

     Brush.Color := Color;

     Brush.Style := bsSolid;

     Rectangle(0, 0, Width, Height);

   end;

   Exit;

end;

if Assigned(Picture.Graphic) then

begin

   if not ((Picture.Graphic is TMetaFile) or (Picture.Graphic is TIcon)) then

     Picture.Graphic.Transparent := FTransparent;

   Canvas.Draw(0, 0, Picture.Graphic);

end;

end;

procedure TSpriteButton.Paint;

var

R: TRect;

begin

if FDrawing then Exit;

FDrawing := True;

try

   UpdateButtonState;

   if Caption <> '' then

   begin

     R := ClientRect;

     Canvas.Font.Assign(Font);

     Canvas.Brush.Style := bsClear;

     R := ClientRect;

     R.Top := 0;

     R.Bottom := 0;

     Inc(R.Left, 14);

     Dec(R.Right, 14);

     DrawText(Canvas.Handle, PChar(Caption), -1, R, DT_WORDBREAK or DT_CALCRECT);

     R.Right := ClientWidth - 14;

     R.Top := (ClientHeight - (R.Bottom - R.Top)) div 2;

     R.Bottom := ClientHeight;

     DrawText(Canvas.Handle, PChar(Caption), -1, R, DT_WORDBREAK or DT_CENTER);

   end;

finally

   FDrawing := False;

end;

end;

procedure TSpriteButton.SetTransparent(const Value: Boolean);

begin

if Value <> FTransparent then

begin

   FTransparent := Value;

   if not FDrawing then Invalidate;

end;

end;

end.