unit GSRadioGroup;
interface
uses
Windows, SysUtils, Classes, Forms, ExtCtrls;
type
TGSRadioGroup =
class(TRadioGroup)
private
FBorderStyle: TBorderStyle;
FValues: TStrings;
protected
procedure SetBorderStyle(Value: TBorderStyle);
procedure Paint;
override;
function GetValues: TStrings;
procedure SetValues(Value: TStrings);
public
constructor Create(AOwner: TComponent);
override;
destructor Destroy;
override;
published
property BorderStyle: TBorderStyle
read FBorderStyle
write SetBorderStyle
default bsNone;
property Values: TStrings
read GetValues
write SetValues;
end;
procedure Register;
implementation
constructor TGSRadioGroup.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FBorderStyle := bsNone;
FValues := TStringList.Create;
end;
destructor TGSRadioGroup.Destroy;
begin
FValues.Free;
inherited Destroy;
end;
function TGSRadioGroup.GetValues;
begin
Result := FValues;
end;
procedure TGSRadioGroup.SetValues(Value: TStrings);
begin
if Value <> FValues
then
begin
FValues.Assign(Value);
end;
end;
procedure TGSRadioGroup.SetBorderStyle(Value: TBorderStyle);
begin
if FBorderStyle <> Value
then
begin
FBorderStyle := Value;
RecreateWnd;
end;
end;
procedure TGSRadioGroup.Paint;
var
c: Integer;
diff: Integer;
H: Integer;
R: TRect;
begin
if FBorderStyle = bsSingle
then
inherited Paint
else
begin
with Canvas
do
begin
if Text <> EmptyStr
then
begin
Font := Self.Font;
H := TextHeight('
0');
R := Rect(8, 0, 0, H);
DrawText(
Handle, PChar(Text), Length(Text), R, DT_LEFT
or
DT_SINGLELINE
or DT_CALCRECT);
Brush.Color := Color;
DrawText(
Handle, PChar(Text), Length(Text), R, DT_LEFT
or
DT_SINGLELINE);
end
else
begin
if ControlCount > 0
then
begin
diff := Controls[0].Top;
for c := 0
to ControlCount - 1
do
begin
Controls[c].Top := Controls[c].Top - diff;
end;
// You may want to adjust the height here.
end;
end;
end;
end;
end;
procedure Register;
begin
RegisterComponents('
Samples', [TGSRadioGroup]);
end;
end.