Make more perfect

How to make this component looks like TButton.
In TButton after OnClick event, it will go up without wait a process completed.
To see the difference try to put this component in form1 (as a procedure) and call form2 (form2.showmodal).
This component looked "down" and after close form2, it will be back go up.

unit TButton;

interface

uses
  Windows, Messages, Classes, Graphics, Controls, ExtCtrls;

type
  TButtonState=(bsUp,bsDown);
  TAlignment=(taLeft,taCenter,taRight);

type
  TTButton = class(TGraphicControl)
  private
    FAlignment:        TAlignment;
    FCaption:          TCaption;
    FTransparent:      Boolean;
    FWordWrap:         Boolean;
    FMouseDown:        Boolean;
    FMouseInside:      Boolean;
    FState:            TButtonState;
    FInsideButton:     Boolean;

    procedure SetAlignment(Value:TAlignment);
    procedure SetCaption(Value:TCaption);
    procedure SetTransparent(Value:boolean);
    procedure SetWordWrap(Value:boolean);
  protected
    procedure DrawTheText;
    function  InsideBtn(X,Y: Integer): boolean;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer);override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);override;
    procedure Paint;  override;
  public
    constructor Create(AOwner: TComponent); override;
    procedure Click; override;
  published
    property Alignment:TAlignment read FAlignment write SetAlignment default taCenter;
    property Caption: TCaption read FCaption write SetCaption;
    property Enabled;
    property Font;
    property ShowHint;
    property Transparent: boolean read FTransparent write SetTransparent default True;
    property Visible;
    property WordWrap:boolean read FWordWrap write SetWordWrap default False;

    property OnClick;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
  end;

procedure Register;

implementation

constructor TTButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle - [csOpaque];
  FState := bsUp;
  FMouseInside := False;
  SetBounds(0,0,60,30);
  FAlignment := taCenter;
  FTransparent := True;
  FMouseDown:= False;
  FInsideButton := False;
  FWordwrap := False;
end;

procedure TTButton.SetAlignment(Value:TAlignment);
begin
  if FAlignment <> Value then
  begin
    FAlignment := Value;
    Invalidate;
  end;
end;

procedure TTButton.SetCaption(Value: TCaption);
begin
  if FCaption <> Value then
  begin
    FCaption := Value;
    Invalidate;
  end;
end;

procedure TTButton.SetTransparent(Value:boolean);
begin
  if FTransparent <> Value then
  begin
    if Value then
      ControlStyle := ControlStyle - [csOpaque]
    else
      ControlStyle := ControlStyle + [csOpaque];
    FTransparent := Value;
    Invalidate;
  end;
end;

procedure TTButton.SetWordWrap(Value:boolean);
begin
  if FWordWrap <> Value then
  begin
    FWordwrap := Value;
    Invalidate;
  end;
end;

function TTButton.InsideBtn(X,Y: Integer): boolean;
begin
  Result := PtInRect(Rect(0,0,Width,Height),Point(X,Y));
end;

procedure TTButton.Paint;
var
  TmpRect:TRect;

begin
  TmpRect := Rect(0,0,Width,Height);

  with Canvas do
  begin
    Brush.Color := clBtnFace;
    Pen.Color := clBlack;
    Pen.Width := 1;

    Pen.Color := clBlack;
    if not Transparent then
      Rectangle(1,1,Width,Height)
    else
    begin
      TmpRect := Rect(1,1,Width,Height);
      Frame3D(Canvas,TmpRect,clBlack,clBlack,1);
    end;

    TmpRect := Rect(1,1,Width-1,Height-1);

    if (FState = bsDown) then
    begin
      InflateRect(TmpRect,1,1);
      Frame3D(Canvas,TmpRect,clBlack,clBtnHighLight,1);
      Frame3D(Canvas,TmpRect,clBtnShadow,clBtnFace,1);
    end;

    if (FState = bsUp) then
    begin
      TmpRect := Rect(1,1,Width-1,Height-1);

      InflateRect(TmpRect,1,1);
      Frame3D(Canvas,TmpRect,clBtnHighLight,clBlack,1);
      Frame3D(Canvas,TmpRect,clBtnFace,clBtnShadow,1);
    end;
  end;

  DrawTheText;
end;

procedure TTButton.DrawTheText;
var
  Flags,MidX,MidY: Integer;
  DC: THandle;
  Tmprect: TRect;

begin
  Canvas.Font := Self.Font;
  DC := Canvas.Handle;

  if FWordWrap then
    Flags := DT_WORDBREAK
  else
    Flags := DT_SINGLELINE;

  TmpRect := Rect(0,0,Width,Height);

  DrawText(DC, PChar(FCaption), Length(FCaption), TmpRect, Flags or DT_CALCRECT);
  MidY := TmpRect.Bottom - TmpRect.Top;
  MidX := TmpRect.Right  - TmpRect.Left;
  Flags := DT_CENTER;

  case Alignment of
    taLeft:
      OffsetRect(TmpRect,0,Height div 2 - MidY div 2);
    taCenter:
      OffsetRect(TmpRect,Width div 2 - MidX div 2,Height div 2 - MidY div 2);
    taRight:
      OffsetRect(TmpRect,Width  - MidX,Height div 2 - MidY div 2);
  end;

  if FWordWrap then
    Flags := Flags or DT_WORDBREAK or DT_NOCLIP
  else
    Flags := Flags or DT_SINGLELINE or DT_NOCLIP;

  if FState = bsDown then
      OffsetRect(TmpRect,1,1);

  SetBkMode(DC,Windows.TRANSPARENT);

  if not Enabled then
  begin
    SetTextColor(DC,ColorToRGB(clBtnHighLight));
    OffsetRect(tmpRect,1,1);
    DrawText(DC, PChar(FCaption), Length(FCaption), TmpRect, Flags);
    OffsetRect(TmpRect,-1,-1);
    SetTextColor(DC,ColorToRGB(clBtnShadow));
  end
  else
    SetTextColor(DC,self.Font.Color);

  DrawText(DC, PChar(FCaption), Length(FCaption), TmpRect, Flags);
end;

procedure TTButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if not Enabled then Exit;
  inherited MouseDown(Button,Shift,X,Y);
  if Assigned(OnMouseDown) then OnMouseDown(Self,Button,Shift,X,Y);
  if InsideBtn(X,Y) then
  begin
    FMouseDown := True;
    FState := bsDown;
    Repaint;
  end;
end;

procedure TTButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if not Enabled then Exit;
  inherited MouseUp(Button,Shift,X,Y);
  FMouseDown := False;
  FState := bsUp;
  Repaint;
  if Assigned(OnMouseUp) then OnMouseUp(Self,Button,Shift,X,Y);
end;

procedure TTButton.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseMove(Shift,X,Y);
  if Assigned(OnMouseMove) then OnMouseMove(Self,Shift,X,Y);
  if FMouseDown then
  begin
    if not InsideBtn(X,Y) then
    begin
      if FState = bsDown then
      begin
        FState := bsUp;
        Repaint;
      end;
    end
    else
    begin
      if FState = bsUp then
      begin
        FState := bsDown;
        Repaint;
      end;
    end;
  end;
end;

procedure TTButton.Click;
begin
  inherited Click;
end;

procedure Register;
begin
  RegisterComponents('Samples', [TTButton]);
end;

end.