TButtonColor Transparent Delphi

//Atualizado em: 07/08/2022
unit UButtonColor;

interface

uses
  Windows,
  Messages,
  SysUtils,
  Classes,
  VCL.Graphics,
  VCL.Controls,
  VCL.StdCtrls,
  VCL.Buttons,
  VCL.ExtCtrls;

type
  TColorButton = class(TButton)
  private
    FButtonColor : TColor;
    FTransparentButton : Boolean;
    FCanvas : TCanvas;
    FStyle, FExStyle : DWORD;
  protected
    procedure CreateParams(var Params : TCreateParams); override;
    procedure CNCtlcolorbtn(var Message: TMessage); message CN_CTLCOLORBTN;
    procedure SetButtonStyle(Value : Boolean); override;
    procedure SetColorBackGroundButton(const Value : TColor);
    procedure SetTransparentButton(const Value : Boolean);
    procedure WMEraseBkGnd(var Message : TWMEraseBkGnd); message WM_ERASEBKGND;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property ColorButton : TColor read FButtonColor write SetColorBackGroundButton;
    property TransparentButton : Boolean read FTransparentButton write SetTransparentButton;
  end;

procedure Register;

implementation

constructor TColorButton.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);

 Width  := 150;
 Height := 50;
 Font.Color := clWhite;
 DoubleBuffered:=False;
 ParentDoubleBuffered:=False;
 FButtonColor := clBlue;
 FTransparentButton := False;
 ControlStyle := ControlStyle + [csOpaque];

end;

procedure TColorButton.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);

  with Params do
  begin
    FStyle := Style or BS_OWNERDRAW;
    Style := FStyle;
    FExStyle := ExStyle or WS_EX_TRANSPARENT;
    ExStyle := FExStyle;
  end;
end;

destructor TColorButton.Destroy;
begin
 inherited Destroy;
end;


procedure TColorButton.SetButtonStyle(Value: Boolean);
begin
//  deixar comentado para que não faça nada
//  inherited;
end;

procedure TColorButton.SetColorBackGroundButton(const Value: TColor);
begin
  FButtonColor := Value;
  Repaint;
end;

procedure TColorButton.SetTransparentButton(const Value: Boolean);
begin
  FTransparentButton := Value;
  Repaint;
end;

procedure TColorButton.CNCtlcolorbtn(var Message: TMessage);
var
  DC : HDC;
  R : TRect;
begin

if (FTransparentButton = True) then
begin

  DoubleBuffered:=False;
  ParentDoubleBuffered:=False;

  try
   DC := GetDC(Handle);
   R := ClientRect;
   SetBkMode(DC, TRANSPARENT);
   FCanvas := TCanvas.Create;
   Brush.Style := bsClear;
   FCanvas.Handle := DC;
   FCanvas.Brush.Style:=bsClear;
   FCanvas.Pen.Style:=psClear;
   FCanvas.Rectangle(0, 0, Width, Height);
   FCanvas.Font := Self.Font;
   DrawText(FCanvas.Handle, Pchar(Caption), -1, R, DT_SINGLELINE OR DT_CENTER OR DT_VCENTER);
  finally
   ReleaseDC(DC, FCanvas.Handle);
   FCanvas.Free;
  end;

end
else
begin

  try
   DC := GetDC(Handle);
   R := ClientRect;
   SetBkMode(Handle, OPAQUE);
   FCanvas := TCanvas.Create;
   FCanvas.Handle := DC;
   FCanvas.Brush.Style:=bsSolid;
   FCanvas.Brush.Color := FButtonColor; //cor do fundo
   FCanvas.Pen.Style:=psSolid;
   FCanvas.Pen.Color:= FButtonColor; //cor da borda
   FCanvas.Rectangle(0, 0, Width, Height);
   FCanvas.Font := Self.Font;
   DrawText(FCanvas.Handle, Pchar(Caption), -1, R, DT_SINGLELINE OR DT_CENTER OR DT_VCENTER);
  finally
   ReleaseDC(DC, FCanvas.Handle);
   FCanvas.Free;
  end;

  Message.Result := 1;
end;

end;

procedure TColorButton.WMEraseBkGnd(var Message: TWMEraseBkGnd);
begin
  Message.Result := 1;
end;

procedure Register;
begin
  RegisterComponents('Standard', [TColorButton]);
end;

initialization
  RegisterClass(TColorButton);

end.