Crear un componente derivado de TGroupBox

[ecfisa]

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