Foros Club Delphi

Foros Club Delphi (https://www.clubdelphi.com/foros/index.php)
-   OOP (https://www.clubdelphi.com/foros/forumdisplay.php?f=5)
-   -   Crear un componente derivado de TGroupBox (https://www.clubdelphi.com/foros/showthread.php?t=89218)

MAXIUM 18-10-2015 01:42:54

Crear un componente derivado de TGroupBox
 
Hola a todos,

La verdad es que ya me he leído algunos tutoriales y revisado la web, pero no me sale lo que quiero :(

Lo que intento, es crear un nuevo componente derivado de TGroupBox y agregarle la propiedad de poder cambiarle el color de los bordes. Seria fácil instalar un componente de terceros, pero la idea es aprender :)

Si no es mucha la molestia, también me gustaría para este nuevo componente:
- Cambiar color de los bordes.
- Caption dentrado o que permita el alineamiento.
- Bordes redondeados.
- Eliminar todos los bordes a excepción del superior.

Eso no'h más :D

MAXIUM 18-10-2015 02:15:05

Actualización
========

Hasta el momento he conseguido un bonito rectángulo con el color del borde a gusto. Voy avanzando :D

Código Delphi [-]
unit GroupBoxEX;

interface

uses
  SysUtils, Classes, Controls, StdCtrls, Graphics;

type
  TGroupBoxEX = class(TGroupBox)
  private
    { Private declarations }
    FBorderColor: TColor;
    procedure SetBorderColor(Value:TColor);
  protected
    { Protected declarations }
    procedure Paint; override;
  public
    { Public declarations }
    constructor Create(AOwner:TComponent); override;
  published
    { Published declarations }
    property BorderColor: TColor read FBorderColor Write SetBorderColor Default clBlack;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Personales', [TGroupBoxEX]);
end;

constructor TGroupBoxEX.Create(AOwner:TComponent);
begin
     inherited;
     FBorderColor:= clBlack;
end;

procedure TGroupBoxEX.SetBorderColor(Value:TColor);
begin
     If FBorderColor <> Value Then
     Begin
          FBorderColor:= Value;
          Invalidate;
     End;
end;

procedure TGroupBoxEX.Paint;
var
   X, Y, W, H: Integer;
begin
     With Canvas Do
     Begin

       // Pluma
          Pen.Width:= 1;
          Pen.Color:= BorderColor;

       // Brocha
          Brush.Color:= Color;
          Brush.Style:= bsSolid; //Relleno Sólido

          X:= Pen.Width div 2;
          Y:= X;
          W:= Width - Pen.Width + 1;
          H:= Height - Pen.Width + 1;

          FillRect(ClientRect);
         
          Brush.Style:= bsClear; //Relleno Sólido

          Rectangle(X, Y, X + W, Y + H);
     End;
End;

end.

ecfisa 18-10-2015 09:19:09

Hola MAXIUM.

Un empujón mas...
Código Delphi [-]
unit GroupBoxPlus;

interface

uses
  Windows, Graphics, Classes, Controls, Messages, StdCtrls;

type
  TGroupBoxPlus = class(TGroupBox)
  private
    FBorderColor : TColor;
    FBorderWidth : Integer;
    FBorderRound : Boolean;
    FBorderCurve : Integer;
    procedure SetBorderColor(const Value: TColor);
    procedure SetBorderWidth(const Value: Integer);
    procedure SetBorderCurve(const Value: Integer);
    procedure SetBorderRound(const Value: Boolean);
    //...
  protected
    procedure Paint; override;
    //...
  published
    constructor Create(AOwner: TComponent); override;
    property BorderColor: TColor  read FBorderColor write SetBorderColor default clBlack;
    property BorderWidth: Integer read FBorderWidth write SetBorderWidth default 1;
    property BorderRound: Boolean read FBorderRound write SetBorderRound default False;
    property BorderCurve: Integer read FBorderCurve write SetBorderCurve default 20;
   //...
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Ejemplo', [TGroupBoxPlus]);
end;

constructor TGroupBoxPlus.Create(AOwner: TComponent);
begin
  inherited;
  FBorderColor := clBlack;
  FBorderWidth := 1;
  FBorderRound := False;
  FBorderCurve := 20;
end;

procedure TGroupBoxPlus.SetBorderColor(const Value: TColor);
begin
  if Value <> FBorderColor then
  begin
    FBorderColor := Value;
    Invalidate;
  end;
end;

procedure TGroupBoxPlus.SetBorderWidth(const Value: Integer);
begin
  if Value <> FBorderWidth then
    if (Value > 0) and (Value < 6) then
    begin
      FBorderWidth := Value;
      Invalidate;
    end;
end;

procedure TGroupBoxPlus.SetBorderRound(const Value: Boolean);
begin
  if Value <> FBorderRound then
  begin
    FBorderRound := Value;
    Invalidate;
  end;
end;

procedure TGroupBoxPlus.SetBorderCurve(const Value: Integer);
begin
  if FBorderCurve <> Value then
    if (Value > 0) and (Value < 31) then
    begin
      FBorderCurve := Value;
      Invalidate;
    end;
end;

procedure TGroupBoxPlus.Paint;
var
  mH, H, W, X, Y: Integer;
  R: TRect;
begin
  Canvas.Pen.Color := FBorderColor;
  Canvas.Pen.Width := FBorderWidth;
  X := Canvas.Pen.Width div 2;
  Y := Canvas.Pen.Width div 2;
  W := Width;
  H := Height;
  Canvas.Font := Self.Font;
  mH := Canvas.TextHeight(Caption) div 2;
  Canvas.Brush.Style := bsClear;
  if not FBorderRound then
    Canvas.Rectangle(X, Y + mH, W-X, H-Y-2)
  else
    Canvas.RoundRect(X, Y + mH, W-X, H-Y-2, FBorderCurve, FBorderCurve);
  Canvas.Font := Self.Font;
  R := Rect(20, 0, 20 + Canvas.TextWidth(Caption), Canvas.TextHeight(Caption));
  Canvas.Brush.Color := Color;
  Canvas.Brush.Style := bsSolid;
  Canvas.FillRect(R);
  DrawText(Canvas.Handle, PChar(Caption), -1, R,
    DT_CENTER or DT_VCENTER or DT_NOPREFIX or DT_SINGLELINE);
end;

//...
end.
El código no hace todo los puntos que solicitas, está en bruto y seguramente tengas que pulirlo un poco. Pero espero que te aporte algunas ideas.

Saludos :)


La franja horaria es GMT +2. Ahora son las 12:25:04.

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