delphi - 为什么我的单选按钮不透明？

Question

我想让组框控制单选按钮的背景颜色，但单选按钮不透明。主题已启用，并且我已将单选按钮的parentbackground 设置为true。

这就是我得到的:

我希望通过单选按钮显示蓝色渐变，并且不使用任何颜色作为单选按钮的背景。

我正在调用此方法，使用 GDI+ 在组框上绘图:

procedure TMyRadio.PaintBackground(AParentColor : TColor; Graphics: IGPGraphics);
var
  ExpandedRect : TGPRect;
  Path : IGPGraphicsPath;
  GradientBrush : IGPPathGradientBrush;
  SurroundColors : array[0..0] of TGPColor;
begin

  ExpandedRect := TGPRect.Create(ExpandBorder(BoundsRect, 10));
  Path := TGPGraphicsPath.Create;
  Path.AddRectangle(ExpandedRect);
  GradientBrush :=  TGPPathGradientBrush.Create(Path);

  GradientBrush.CenterColor := TGPColor.Create(255,
                                               GetRValue(ColorToRGB(BackgroundColor)),
                                               GetGValue(ColorToRGB(BackgroundColor)),
                                               GetBValue(ColorToRGB(BackgroundColor))
                                               );

  SurroundColors[0].Initialize(0,
                               GetRValue(ColorToRGB(AParentColor)),
                               GetGValue(ColorToRGB(AParentColor)),
                               GetBValue(ColorToRGB(AParentColor))
                               );

  GradientBrush.SetSurroundColors(SurroundColors);
  Graphics.FillRectangle(GradientBrush, ExpandedRect);

end;

从覆盖的绘制函数中，单选按钮所在的组框不会通过单选按钮控件显示。我没有在其他地方设置单选按钮的颜色，并且在运行时检查了 ParentBackground = true 。

Answer 1

问题中发布的图片与代码和代码描述之间存在不一致(请参阅我对问题的评论)。组框的背景应该在组框的绘制周期中绘制。以下作品(使用 XE2 测试，单选按钮是透明的):

type
  TMyGroupBox = class(TGroupBox)
  protected
    procedure Paint; override;
    procedure PaintBackground(AParentColor : TColor; Graphics: IGPGraphics);
  end;

  ..

procedure TMyGroupBox.Paint;
var
  G: IGPGraphics;
begin
  inherited;
  G := TGPGraphics.Create(Canvas.Handle);
  PaintBackground(clYellow, G);
end;

procedure TMyGroupBox.PaintBackground(AParentColor: TColor; Graphics: IGPGraphics);
var
  ..
begin
  // Same as in the question. Of course the rectangle should be calculated
  // based on the positions of radio button...
  ..

<小时/>

下面是一个如何将其与样式合并的示例(我想知道这是否容易):

uses
  .., gdiplus;

type
  TGroupBoxStyleHook = class(vcl.stdctrls.TGroupBoxStyleHook)
  strict protected
    procedure PaintBackground(Canvas: TCanvas); override;
  end;

  TGroupBox = class(vcl.stdctrls.TGroupBox)
  private
    FButtonSize: Integer;
    FGradientMargin: Integer;
    function GetButtonSize: Integer;
  protected
    procedure Paint; override;
    procedure PaintBackground(AParentColor: TColor; Graphics: IGPGraphics);
    procedure CMWininichange(var Message: TMessage); message CM_WININICHANGE;
    property ButtonSize: Integer read GetButtonSize;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property GradientMargin: Integer
        read FGradientMargin write FGradientMargin default 10;
  end;

  TForm1 = class(TForm)
    GroupBox1: TGroupBox;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    Button1: TButton;
  end;

var
  Form1: TForm1;

implementation

uses
  themes, uxtheme;

{$R *.dfm}


{ TGroupBoxStyleHook }

procedure TGroupBoxStyleHook.PaintBackground(Canvas: TCanvas);
var
  G: IGPGraphics;
begin
  inherited;
  G := TGPGraphics.Create(Canvas.Handle);
  (Control as TGroupBox).PaintBackground(clYellow, G);
end;


{ TGroupBox }

constructor TGroupBox.Create(AOwner: TComponent);
begin
  inherited;
  FGradientMargin := 10;
  TCustomStyleEngine.RegisterStyleHook(TCustomGroupBox, TGroupBoxStyleHook);
end;

procedure TGroupBox.CMWininichange(var Message: TMessage);
begin
  FButtonSize := 0;
  inherited;
end;

function TGroupBox.GetButtonSize: Integer;
var
  Size: TSize;
begin
  Result := FButtonSize;
  if StyleServices.Enabled and (Result = 0) then begin
    TStyleManager.SystemStyle.GetElementSize(0,
        TStyleManager.SystemStyle.GetElementDetails(tbRadioButtonCheckedNormal),
        TRect.Empty, esActual, Size);
    FButtonSize := Size.cx;
    Result := FButtonSize;
  end;
end;


procedure TGroupBox.PaintBackground(AParentColor: TColor; Graphics: IGPGraphics);
const
  BackGroundColor = clBlue;
var
  R: TRect;
  i: Integer;

  ExpandedRect : TGPRect;
  Path : IGPGraphicsPath;
  GradientBrush : IGPPathGradientBrush;
  SurroundColors : array[0..0] of TGPColor;
begin
  for i := 0 to ControlCount - 1 do begin
    if Controls[i] is TRadioButton then begin

      // Don't know what ExpandBorder is.
      //  ExpandedRect := TGPRect.Create(ExpandBorder(BoundsRect, 10));
      R := Controls[i].BoundsRect;
      R.Inflate(GradientMargin, GradientMargin);
      R.Right := R.Left + 2 * GradientMargin + ButtonSize;
      ExpandedRect := TGPRect.Create(R);

      Path := TGPGraphicsPath.Create;
      Path.AddRectangle(ExpandedRect);
      GradientBrush :=  TGPPathGradientBrush.Create(Path);

      GradientBrush.CenterColor := TGPColor.Create(255,
                                         GetRValue(ColorToRGB(BackgroundColor)),
                                         GetGValue(ColorToRGB(BackgroundColor)),
                                         GetBValue(ColorToRGB(BackgroundColor))
                                         );
      SurroundColors[0].Initialize(0,
                                   GetRValue(ColorToRGB(AParentColor)),
                                   GetGValue(ColorToRGB(AParentColor)),
                                   GetBValue(ColorToRGB(AParentColor))
                                   );
      GradientBrush.SetSurroundColors(SurroundColors);
      Graphics.FillRectangle(GradientBrush, ExpandedRect);
    end;
  end;
end;

procedure TGroupBox.Paint;
var
  G: IGPGraphics;
begin
  //  'Paint' is not called with styles other than the SystemStyle
  inherited;

  // Do not draw the background with no runtime themes (no default transparency)
  if StyleServices.Enabled then begin
    G := TGPGraphics.Create(Canvas.Handle);
    PaintBackground(clRed, G); // I don't notice any effect of color passed here
  end;
end;

看起来像:
默认 ，样式