Fórum Desenhando componentes em delphi: Como se faz isso? #264875

unit Botao;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
  TBotao = class(TGraphicControl) // Herdei de TGraphicControl... Esse componente não pode receber o focus
  private
    { Private declarations }
  protected
    procedure Paint; override; // Metodo Paint reescrito
    procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN; // Mensagem que pega quando o botão esquerdo do mouse é clicado
  public
    constructor Create(AOwner: TComponent); override;
  published
    { Published declarations }
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents(´Teste´, [TBotao]);
end;

{ TBotao }

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

   Self.Height := 25;
   Self.Width  := 75;

   Invalidate; // Chamando o metodo paint manualmente... Sempre chama ele pelo Invalidade...
end;

procedure TBotao.Paint;
begin
   // Aqui que eu desenho tudo o que eu quero...
   // O ideal aqui é usar doublebuffering

   Canvas.Rectangle(0,0,75,25);

   Canvas.TextOut(22,6, ´Botão´);

   inherited;
end;

procedure TBotao.WMLButtonDown(var Message: TWMLButtonDown);
begin
   showmessage(´Clicou´);
end;

end.

unit Botao;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
  TBotao = class(TGraphicControl) // Herdei de TGraphicControl... Esse componente não pode receber o focus
  private
    OffScreen: TBitmap; // O segundo canvas aqui chamado de OffScreen...
  protected
    procedure Paint; override; // Metodo Paint reescrito
    procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN; // Mensagem que pega quando o botão esquerdo do mouse é clicado
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    { Published declarations }
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents(´Teste´, [TBotao]);
end;

{ TBotao }

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

   OffScreen := TBitmap.Create; // Crie o OffScreen...

   OffScreen.Height:= 25; //Defini o tamanho do OffScreen...
   OffScreen.Width := 75;

   Self.Height := 25;
   Self.Width  := 75;

   Invalidate; // Chamando o metodo paint manualmente... Sempre chama ele pelo Invalidade...
end;

destructor TBotao.Destroy;
begin
   OffScreen.Free; // Matei o OffScreen...

   inherited Destroy;
end;

procedure TBotao.Paint;
begin
   // Aqui que eu desenho tudo o que eu quero...
   // O ideal aqui é usar doublebuffering

   OffScreen.Canvas.FillRect(Rect( 0, 0, 75, 25)); // Limpei o OffScreen...

   OffScreen.Canvas.Rectangle(0,0,75,25);

   OffScreen.Canvas.TextOut(22,6, ´Botão´);

   Canvas.Draw(0, 0, OffScreen); //Copiei tudo do OffScreen para o canvas...

   inherited;
end;

procedure TBotao.WMLButtonDown(var Message: TWMLButtonDown);
begin
   showmessage(´Clicou´);
end;

end.

procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUp;

procedure TBotao.WMLButtonDown(var Message: TWMLButtonDown);
begin
  OffScreen.Canvas.Brush.Color := clRed;
  Invalidate;
end;

procedure TBotao.WMLButtonUp(var Message: TWMLButtonUp);
begin
  OffScreen.Canvas.Brush.Color := clWhite;
  Invalidate;
end;