unit ImageButton;

//2013 bummi

interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  StdCtrls, ImgList;

type
  TButtonState = (bsMouseIn, bsMouseOut, bsPressed);
  TImageButton = class(TGraphicControl)
  private
    FIndex: Integer;
    FDownIndex: Integer;
    FHoverIndex: Integer;
    FImages: TCustomImageList;
    FImagesChangeLink: TChangeLink;
    FButtonState: TButtonState;
    procedure ImagesChange(Sender: TObject);
    procedure SetDownIndex(Value: Integer);
    procedure SetHoverIndex(Value: Integer);
    procedure SetIndex(Value: Integer);
    procedure SetImages(Value: TCustomImageList);
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure WMLButtonDown(var Message: TMessage); message WM_LBUTTONDOWN;
    procedure WMLButtonUp(var Message: TMessage); message WM_LBUTTONUP;
  protected
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Caption;
    property DownIndex: Integer read FDownIndex write SetDownIndex;
    property Font;
    property HoverIndex: Integer read FHoverIndex write SetHoverIndex;
    property Images: TCustomImageList read FImages write SetImages;
    property Index: Integer read FIndex write SetIndex;
  end;

  procedure Register;

implementation

constructor TImageButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Parent := TWinControl(AOwner);
  Width := 200;
  Height := 200;
  FButtonState := bsMouseOut;
  FImagesChangeLink := TChangeLink.Create;
  FImagesChangeLink.OnChange := ImagesChange;
end;

Destructor TImageButton.Destroy;
begin
  FImagesChangeLink.Free;
  inherited Destroy;
end;

procedure TImageButton.Paint;
var
  S: string;
  DestRect: TRect;
  ImageIndex: Integer;
begin
  inherited;
  ImageIndex := -1;
  if Assigned(FImages) then
  begin
    case FButtonState of
      bsMouseIn:
        if FImages.Count > HoverIndex then
          ImageIndex := HoverIndex;
      bsMouseOut:
        if FImages.Count > Index then
          ImageIndex := Index;
      bsPressed:
        if FImages.Count > DownIndex then
          ImageIndex := DownIndex;
    end;
    if ImageIndex > -1 then
      FImages.Draw(Canvas, 0, 0, ImageIndex);
  end
  else
    Canvas.Rectangle(ClientRect);

  S := Caption;
  DestRect := ClientRect;
  Canvas.Font.Assign(Font);
  Canvas.Brush.Style := bsClear;
  Canvas.TextRect(DestRect, S, [tfVerticalCenter, tfCenter, tfSingleLine]);
end;

procedure TImageButton.ImagesChange(Sender: TObject);
begin
  if not (csDestroying in ComponentState) then
    Invalidate;
end;

procedure TImageButton.SetDownIndex(Value: Integer);
begin
  if FDownIndex <> Value then
  begin
    FDownIndex := Value;
    Invalidate;
  end;
end;

procedure TImageButton.SetHoverIndex(Value: Integer);
begin
  if FHoverIndex <> Value then
  begin
    FHoverIndex := Value;
    Invalidate;
  end;
end;

procedure TImageButton.SetImages(Value: TCustomImageList);
begin
  if FImages <> Value then
  begin
    if Assigned(FImages) then
    begin
      FImages.UnRegisterChanges(FImagesChangeLink);
      FImages.RemoveFreeNotification(Self);
    end;

    FImages := Value;

    if Assigned(FImages) then
    begin
      FImages.RegisterChanges(FImagesChangeLink);
      FImages.FreeNotification(Self);
      ImagesChange(nil);
    end;
  end;
end;

procedure TImageButton.SetIndex(Value: Integer);
begin
  if FIndex <> Value then
  begin
    FIndex := Value;
    Invalidate;
  end;
end;

procedure TImageButton.WMLButtonDown(var Message: TMessage);
begin
  inherited;
  FButtonState := bsPressed;
  Invalidate;
end;

procedure TImageButton.WMLButtonUp(var Message: TMessage);
begin
  inherited;
  FButtonState := bsMouseIn;
  Invalidate;
end;

Procedure TImageButton.CMMouseEnter(var Message: TMessage);
Begin
  inherited;
  if not (csDesigning in ComponentState) and (FButtonState <> bsMouseIn) then
  begin
    FButtonState := bsMouseIn;
    Invalidate;
  end;
end;

Procedure TImageButton.CMMouseLeave(var Message: TMessage);
Begin
  inherited;
  if not (csDesigning in ComponentState) and (FButtonState <> bsMouseOut) then
  begin
    FButtonState := bsMouseOut;
    Invalidate;
  end;
end;

procedure TImageButton.CMFontChanged(var Message: TMessage);
begin
  inherited;
  Invalidate;
end;

procedure TImageButton.CMTextChanged(var Message: TMessage);
begin
  inherited;
  Invalidate;
end;

procedure Register;
begin
  RegisterComponents('Own', [TImageButton])
end;

end.