Mirror

How to draw a TRadioGroup without a frame (Views: 23)


Problem/Question/Abstract:

How to draw a TRadioGroup without a frame

Answer:

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('Garlin', [TGSRadioGroup]);
end;

end.

<< Back to main page