Crear un componente derivado de TGroupBox

[MAXIUM]

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]

Actualización
========

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

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]

Hola MAXIUM.

Un empujón mas...

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 :)