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

{ }

{ Sprite Button }

{ }

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

{ (s-mike) }

{ <a href="http://forum.sources.ru" title="http://forum.sources.ru">http://forum.sources.ru</a> }

{ <a href="http://mikesoft.front.ru" title="http://mikesoft.front.ru">http://mikesoft.front.ru</a> }

{ }

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

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. := 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. := (ClientHeight - (R.Bottom - R.)) 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.