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.