Crear un TButton con un skin

[aeff]

saludos!

como muestra de mi agradecimiento quisiera regalarles el nuevo TButton con skin para que lo usen y hagan con este lo que deseen:

Código Delphi [-]
type
  TXButton = class(TButton)
    protected
      FFillColor,
      FHoverColor,
      FNormalColor,
      FLineColor,
      FFocusedLineColor,
      FTextColorNormal,
      FTextColorFocused: TColor;
      FFocused: Boolean;
      procedure CreateParams(var Param: TCreateParams); override;
      procedure WndProc(var Message: TMessage); override;
      procedure SetButtonStyle(Value: Boolean); override;
      procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
      procedure CMFontChange(var Message: TMessage); message CM_FONTCHANGE;
      procedure Click; override;
      procedure DrawButtonSkin();
    public
      Canvas: TCanvas;
      constructor Create(aOwner: TComponent); override;
    published
      property  HoverColor: TColor read FHoverColor write FHoverColor;
      property  NormalColor: TColor read FNormalColor write FNormalColor;
      property  LineColor: TColor read FLineColor write FLineColor;
      property  FocusedLineColor: TColor read FFocusedLineColor write FFocusedLineColor;
      property  TextColorNormal: TColor read FTextColorNormal write FTextColorNormal;
      property  TextColorFocus: TColor read FTextColorFocused write FTextColorFocused;
  end;

implementation

  constructor TXButton.Create(aOwner: TComponent);
  begin
    inherited;
    Canvas := TCanvas.Create;
    FFillColor := clGray;
    FHoverColor := clSilver;
    FNormalColor := clGray;
    FLineColor := clBlack;
    FFocusedLineColor := $004BD1F3;
    FTextColorNormal := clWindowText;
    FTextColorFocused := $000FC4E3;
    Font.Name := 'Tahoma';
  end;

  procedure TXButton.CreateParams(var Param: TCreateParams);
  begin
    inherited;
    Param.Style := Param.Style or BS_OWNERDRAW;
  end;

  procedure TXButton.WndProc(var Message: TMessage);
  var
    aP: TPaintStruct;
  begin
    case Message.Msg of
      CM_MOUSELEAVE: begin FFillColor := FNormalColor;  Invalidate; end;
      CM_MOUSEENTER: begin FFillColor := FHoverColor;   Invalidate; end;
    end;

    inherited;
  end;

  procedure TXButton.SetButtonStyle(Value: Boolean);
  begin
    FFocused := Value;
    if Value then
      Invalidate;
  end;

  procedure TXButton.CNDrawItem(var Message: TWMDrawItem);
  var
    SaveIndex: Integer;
  begin
    with Message.DrawItemStruct^ do
    begin
      SaveIndex := SaveDC(hDC);
      Canvas.Lock;
      try
        Canvas.Handle := hDC;
        Canvas.Font := Font;
        Canvas.Brush := Brush;
        DrawButtonSkin();
      finally
        Canvas.Handle := 0;
        Canvas.Unlock;
        RestoreDC(hDC, SaveIndex);
      end;
    end;
    Message.Result := 1;
  end;

  procedure TXButton.CMFontChange(var Message: TMessage);
  begin
    Invalidate;
    Inherited;
  end;

  procedure TXButton.Click;
  begin
    inherited;
    FFillColor := FHoverColor;
    Invalidate;
    Application.ProcessMessages;
    Sleep(70);
    Application.ProcessMessages;
    FFillColor := FNormalColor;
    Invalidate;
  end;

  procedure TXButton.DrawButtonSkin();
  var
    tX, tY, lColor: Integer;
  begin
    {Asignando el valores del canvas normal}

    Canvas.Font.Name := Font.Name;
    Canvas.Font.Style := Font.Style;    

    {Pintado el estilo}
    Canvas.Brush.Color := FFillColor;
    Canvas.FillRect(Canvas.ClipRect);
    case FFocused of
      false:  begin
                Canvas.Font.Color := FTextColorNormal;
                Canvas.Pen.Color := FLineColor;
              end;
      true:   begin
                Canvas.Font.Color := FTextColorFocused;
                Canvas.Pen.Color := FFocusedLineColor;
              end;
    end;
    Canvas.Rectangle(1,1, Width -1, Height -1);
    if not FFocused then Canvas.DrawFocusRect(Rect(1,1,Width -1, Height -1)); 
    lColor := Canvas.Brush.Color;
    Canvas.Pen.Color := FFillColor + $0A0A0A;
    Canvas.Brush.Color := FFillColor + $0A0A0A;

    {brillo}
    Canvas.Rectangle(3,3, Width -3, Height div 2);

    {bajo brillo oscuro}
    Canvas.Pen.Color := FFillColor - $050505;
    Canvas.Brush.Color := FFillColor - $050505;
    Canvas.Rectangle(3, Height div 2, Width -3, Height div 2 + 2);

    Canvas.Pen.Color := FFillColor - $020202;
    Canvas.Brush.Color := FFillColor - $020202;
    Canvas.Rectangle(3, Height div 2 + 2, Width -3, Height div 2 + 2 + 2);

    Canvas.Brush.Style := bsClear;
    tX := (Width div 2) - (Canvas.TextWidth(Caption) div 2);
    tY := (Height div 2) - (Canvas.TextHeight(Caption) div 2);
    Canvas.TextOut(tX, tY, Caption);
  end;

entonces, por si desean hacer una prueba rápida, les muestro como los creo hasta el momento, en el evento OnCreate de la Form:

Código Delphi [-]
procedure TfrmMain.FormCreate(Sender: TObject);
var
  oBtn: TXButton;
begin
  //
  oBtn := TXButton.Create(Self);
  oBtn.Parent := self;
  oBtn.Left := 100;
  oBtn.Top := 50;
  oBtn.Caption := 'XButton1';
  oBtn.Caption := 'A.E.F.F';

  oBtn := TXButton.Create(Self);
  oBtn.Parent := self;
  oBtn.Left := 100;
  oBtn.Top := 80;
  oBtn.Caption := 'XButton1';
  oBtn.Caption := 'M.M.L.R';
  oBtn.Font.Style := [fsBold];

  oBtn := TXButton.Create(Self);
  oBtn.Parent := self;
  oBtn.Left := 100;
  oBtn.Top := 110;
  oBtn.Caption := 'XButton1';
  oBtn.Caption := 'C.E.F.D';
  oBtn.Cursor := crHandPoint;
  Screen.Cursors[crHandPoint] := LoadCursorFromFile('C:\WINDOWS\Cursores\dinosau2.ani');

end;

bueno, saludos!
hasta pronto!
aeff!

[aeff]

claro, faltan detalles, pero aún le estoy dando vuelta al asunto!, por ejemplo, cuando se cambie el valor de algunos de los colores de estilo hay que repintar el objeto, ¿no creen?

aeff!