radioGroup - border

[Stevie]

Zitat von computer-glossar.de:

naja... auch ein wenig unprofessionell die lösung oder? bin mit dem panel und den radioButtons darauf ganz zuffrieden

Ich hatte gerade Langeweile!

Delphi-Quellcode:

unit RadioGroupEx;

interface

uses
  Windows, Messages, SysUtils, Classes, Controls, StdCtrls, ExtCtrls;

type
  TRadioGroupEx = class(TRadioGroup)
  private
    FBevelInner: TPanelBevel;
    FBevelOuter: TPanelBevel;
  protected
    procedure Paint; override;
    procedure SetBevelInner(Value: TPanelBevel);
    procedure SetBevelOuter(Value: TPanelBevel);
  published
    property BevelInner: TPanelBevel read FBevelInner write SetBevelInner default bvNone;
    property BevelOuter: TPanelBevel read FBevelOuter write SetBevelOuter default bvRaised;
  end;

procedure Register;

implementation

uses
  Graphics;

procedure TRadioGroupEx.Paint;
var
  H: Integer;
  R: TRect;
  Flags: Longint;
  TopColor, BottomColor: TColor;

  procedure AdjustColors(Bevel: TPanelBevel);
  begin
    TopColor := clBtnHighlight;
    if Bevel = bvLowered then TopColor := clBtnShadow;
    BottomColor := clBtnShadow;
    if Bevel = bvLowered then BottomColor := clBtnHighlight;
  end;

begin
  with Canvas do
  begin
    Font := Self.Font;
    H := TextHeight('0');
    R := Rect(0, H div 2 - 1, Width, Height);

    if BevelOuter <> bvNone then
    begin
      AdjustColors(BevelOuter);
      Frame3D(Canvas, R, TopColor, BottomColor, BevelWidth);
    end;
    Frame3D(Canvas, R, Color, Color, BorderWidth);
    if BevelInner <> bvNone then
    begin
      AdjustColors(BevelInner);
      Frame3D(Canvas, R, TopColor, BottomColor, BevelWidth);
    end;
(*
    if Ctl3D then
    begin
      Inc(R.Left);
      Inc(R.Top);
      Brush.Color := clBtnHighlight;
      FrameRect(R);
      OffsetRect(R, -1, -1);
      Brush.Color := clBtnShadow;
    end else
      Brush.Color := clWindowFrame;
    FrameRect(R);
*)
    if Text <> '' then
    begin
      if not UseRightToLeftAlignment then
        R := Rect(8, 0, 0, H)
      else                         
        R := Rect(R.Right - Canvas.TextWidth(Text) - 8, 0, 0, H);
      Flags := DrawTextBiDiModeFlags(DT_SINGLELINE);
      DrawText(Handle, PChar(Text), Length(Text), R, Flags or DT_CALCRECT);
      Brush.Color := Color;
      DrawText(Handle, PChar(Text), Length(Text), R, Flags);
    end;
  end;
end;

procedure Register;
begin
  RegisterComponents('Beispiele', [TRadioGroupEx]);
end;

procedure TRadioGroupEx.SetBevelInner(Value: TPanelBevel);
begin
  FBevelInner := Value;
  Realign;
  Invalidate;
end;

procedure TRadioGroupEx.SetBevelOuter(Value: TPanelBevel);
begin
  FBevelOuter := Value;
  Realign;
  Invalidate;
end;

end.