unit Test;

interface

uses
  windows,
  messages,
  UtilFunc,
  UtilClass;

type

TSpeedBtn = class(TSubClass)
private
  FColor: COLORREF;
  FRect: TRect;
public
  constructor Create(hParent: HWND); override;
  destructor Destroy; override;
  procedure DefaultHandler(var Message); override;
  property Rect: TRect read FRect write FRect;
end;

implementation

constructor TSpeedBtn.Create(hParent: HWND);
begin
  inherited Create(hParent);
  FColor := clrBlue;
  Dispatcher.TrapMessage(WM_PAINT,self);
  Dispatcher.TrapMessage(WM_LBUTTONDOWN,self);
end;

destructor TSpeedBtn.Destroy;
begin
  InvalidateRect(Parent,@FRect,true);
  inherited Destroy;
end;

procedure TSpeedBtn.DefaultHandler(var Message);
var
  Msg: TMessage;
  hBr: HBRUSH;
  DC: HDC;
  p: TPoint;
begin
  Msg := TMessage(Message);
  case Msg.Msg of
    WM_PAINT:begin
      hBr := CreateSolidBrush(FColor);
      DC := GetDC(Parent);
        FillRect(DC,FRect,hBr);
        DeleteObject(hBr);
        SetBkMode(DC,TRANSPARENT);
        SetTextColor(DC,clrWhite);
        DrawText(DC,'SpeedBtn',8,FRect,DT_CENTER or
                                  DT_SINGLELINE or DT_VCENTER);
      ReleaseDC(Parent,DC);
    end;
    WM_LBUTTONDOWN:begin
      p.x := Msg.LParamLo;
      p.y := Msg.LParamHi;
      if PtInRect(FRect,p) then begin
        if FColor = clrBlue then FColor := clrRed else FColor := clrBlue;
        InvalidateRect(Parent,@FRect,true);
      end;
    end;
  end; // case
end;

end.