Foros Club Delphi

Foros Club Delphi (https://www.clubdelphi.com/foros/index.php)
-   OOP (https://www.clubdelphi.com/foros/forumdisplay.php?f=5)
-   -   Componente shape circular con imagen (https://www.clubdelphi.com/foros/showthread.php?t=78366)

briast 12-04-2012 11:36:15
Componente shape circular con imagen
 
Hola. Estoy intentando hacer un componente heredado del TShape en el que se pueda mostrar una imagen en el interior, en concreto un PNG transparente.
Pongo aquí el código:
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);
  protected
    { Protected declarations }
    procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
    procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
  public
    { Public declarations }
    constructor Create(AOwner:TComponent); override;
    destructor Destroy; override;
  published
    { Published declarations }
    property Picture: TPicture read FImagen write SetPicture;
    property ColorActivo:TColor read FColorActivo write FColorActivo default clRed;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('PRUEBAS', [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);
    // Pintarla sobre el objeto
    self.Canvas.StretchDraw(Self.GetClientRect,FImagen.Bitmap);
end;

procedure TRoundBtn.WMLButtonDown(var Message: TWMLButtonDown);
begin
    self.Pen.Color:=FColorActivo;
    inherited;
end;

procedure TRoundBtn.WMLButtonUp(var Message: TWMLButtonUp);
begin
    self.pen.color:=FColorInactivo;
    inherited;
end;

end.
Lo que no consigo hacer es que se vea la imagen una vez asignada a la propiedad FImagen. También supongo que al cambiar el tamaño del objeto debería repintarse. He probado con un TImage y tampoco lo consigo.
Lo que quiero es tener una especie botón redondo con una imagen dentro. Al pulsarla se cambia el borde de color (eso ya está incluido).
Gracias por la ayuda.

defcon1_es 12-04-2012 13:51:09
Hola.
Creo que no se ve la imagen porque no has sobrecargado el método Paint del TRoundBtn,
y se ejecuta el de la clase TShape, que no tiene en cuenta tu imagen :)

Prueba algo asi y adáptalo a las necesidades de tu clase.

Código Delphi [-]
...
  protected
    procedure Paint; override;
...

procedure TRoundBtn.Paint;
var
  X, Y, W, H, S: Integer;
begin
  with Canvas do
  begin
    Pen := FPen;
    Brush := FBrush;
    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 FShape in [stSquare, stRoundSquare, stCircle] then
    begin
      Inc(X, (W - S) div 2);
      Inc(Y, (H - S) div 2);
      W := S;
      H := S;
    end;
    case FShape 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;
//El código anterior es el que tiene la clase TShape (Copy&Paste)
    if Assinged(FImagen) then
      StretchDraw(Self.GetClientRect,FImagen.Bitmap);
  end;
end;

briast 12-04-2012 16:14:15
Gracias por la respuesta, pero no funciona.
Creo que el problema es que el TPicture no guarda por algún motivo el png que le cargo, cuando llega a la función stretchdraw no pinta nada.

briast 12-04-2012 17:33:15
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

ElKurgan 13-04-2012 07:31:08
O.K., gracias por el aporte

Saludos


La franja horaria es GMT +2. Ahora son las 10:46:03.

Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi