Ver Mensaje Individual
  #4  
Antiguo 12-04-2012
briast briast is offline
Miembro
NULL
 
Registrado: may 2011
Posts: 50
Reputación: 13
briast Va por buen camino
Ya me funciona bien. Pongo aquí el código por si le interesa a alguien:

Código:
unit RoundBtn;

interface

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

type
  TRoundBtn = class(TShape)
  private
    { Private declarations }
    FImagen: TPicture;
    FColorActivo: TColor;
    FColorInactivo: TColor;

    procedure SetPicture(Value: TPicture);
    function GetPicture: TPicture;

  protected
    { Protected declarations }
    procedure Paint; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X,Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X,Y: Integer); override;
  public
    { Public declarations }
    constructor Create(AOwner:TComponent); override;
    destructor Destroy; override;

    
  published
    { Published declarations }
    property Picture: TPicture read GetPicture write SetPicture;
    property ColorActivo:TColor read FColorActivo write FColorActivo default clRed;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('PRUEBA', [TRoundBtn]);
end;

{ TRoundBtn }

constructor TRoundBtn.Create(AOwner: TComponent);
begin
     inherited Create(Aowner);

     FColorActivo:=clRed;
     Self.pen.Color:=clWhite;
     self.Pen.Width:=3;
     Self.pen.Style:=psSolid;
     FColorInactivo:=self.pen.Color;
     self.Shape:=stCircle;
     self.Brush.Color:=clSilver;
     self.Width:=65;
     self.Height:=65;

     // Creamos el componente de imagen
     FImagen:=TPicture.Create;
end;

destructor TRoundBtn.Destroy;
begin
  inherited;
     FImagen.free;
end;

procedure TRoundBtn.SetPicture(Value: TPicture);
begin
     FImagen.Assign(Value);
     Paint();
end;

procedure TRoundBtn.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  self.Pen.Color:=FColorActivo;
  inherited;
  Invalidate;
end;

procedure TRoundBtn.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
     self.pen.color:=FColorInactivo;
     inherited;
     Invalidate;
end;

procedure TRoundBtn.Paint;
var
  X, Y, W, H, S: Integer;
  Rect: TRect;
begin
  if self.Width>self.Height then Self.Height:=self.Width;
  if self.Height>self.Width then Self.Width:=self.Height;

  with Canvas do
  begin
    Pen := self.Pen;
    Brush := self.Brush;
    X := Pen.Width div 2;
    Y := X;
    W := Width - Pen.Width + 1;
    H := Height - Pen.Width + 1;
    if Pen.Width = 0 then
    begin
      Dec(W);
      Dec(H);
    end;
    if W < H then S := W else S := H;
    if self.Shape in [stSquare, stRoundSquare, stCircle] then
    begin
      Inc(X, (W - S) div 2);
      Inc(Y, (H - S) div 2);
      W := S;
      H := S;
    end;
    case Self.Shape of
      stRectangle, stSquare:
        Rectangle(X, Y, X + W, Y + H);
      stRoundRect, stRoundSquare:
        RoundRect(X, Y, X + W, Y + H, S div 4, S div 4);
      stCircle, stEllipse:
        Ellipse(X, Y, X + W, Y + H);
    end;

    Rect:=self.GetClientRect;

    if Assigned(FImagen) then
    begin
      // Calculamos
      X:= StrToInt(FormatFloat('#0',(Self.Width-FImagen.Width)/2));
      Y:= StrToInt(FormatFloat('#0',(Self.Height-FImagen.Height)/2));
      Draw(Rect.Left+X, Rect.Top+Y,FImagen.Graphic);
    end;
  end;
end;

function TRoundBtn.GetPicture: TPicture;
begin
        Result:=FImagen;
end;

end.
Un saludo
Responder Con Cita