如何抑制Delphi中的标准单选按钮检查行为？_Delphi_Radio Button

如何抑制Delphi中的标准单选按钮检查行为？

delphi

如何抑制Delphi中的标准单选按钮检查行为？,delphi,radio-button,Delphi,Radio Button,我知道这个有点奇怪，所以我会解释的。对于一个简单的互联网广播播放器，我需要一个控件来指定评级（1-5“星”）。我在图形设计方面没有经验或天赋，所以我所有绘制位图的尝试看起来都很可笑/糟糕，随你挑吧。我找不到具有这种功能和外观的第三方控件适合标准VCL控件。所以我突然想到，通过使用没有标题的标准单选按钮，我可以实现OK外观和与Windows UI的一致性，如下所示：我对GroupIndex属性有一个模糊（错误）的回忆；为每个单选按钮指定不同的值将允许同时检查多个单选按钮。唉，TRadioBu

我知道这个有点奇怪，所以我会解释的。对于一个简单的互联网广播播放器，我需要一个控件来指定评级（1-5“星”）。我在图形设计方面没有经验或天赋，所以我所有绘制位图的尝试看起来都很可笑/糟糕，随你挑吧。我找不到具有这种功能和外观的第三方控件适合标准VCL控件。所以

我突然想到，通过使用没有标题的标准单选按钮，我可以实现OK外观和与Windows UI的一致性，如下所示：

我对GroupIndex属性有一个模糊（错误）的回忆；为每个单选按钮指定不同的值将允许同时检查多个单选按钮。唉，TRadioButton没有GroupIndex属性，仅此而已

是否可以完全覆盖自然的单选按钮行为，以便多个按钮可以同时显示为选中状态？或者

我是否可以从系统中获取Windows用于单选按钮的所有位图（我假设它们是位图）并直接绘制它们，包括主题化支持？在这种情况下，我仍然希望保留单选按钮的所有效果，包括鼠标悬停“发光”等，因此这意味着获取所有“本机”位图并根据需要绘制它们，可能是在TPaintBox上

制作看起来像单选按钮但行为不同的单选按钮会让用户感到困惑。此外，当您决定显示现有评级时，您最终需要半个复选标记。因此，像进度条（可能是自定义颜色或自定义绘制）这样的东西来显示“完整”的用户满意度可能是一个更好的选择

我同意尤金和克雷格的观点，类似星星的东西会更好，但是，为了回答提出的问题：

无主题单选按钮图像可通过呼叫获取。您可以将其直接指定给TBitmap的

句柄

属性，然后将宽度除以4，将高度除以3，以获得子位图的测量值。使用

TCanvas.BrushCopy

进行绘图

要绘制主题图像，需要使用Delphi的

Themes.pas

。使用

tbRadioButtonCheckedNormal

或

tbRadioButtonCheckedNormal

专门调用

ThemeServices.getElement详细信息

，并将结果与客户端rect一起传递给

ThemeServices.DrawElement

下面是一个简单的替代，它将复选框绘制为选中单选按钮，以便您可以查看其工作原理：

TCheckBox = class(StdCtrls.TCheckBox)
  constructor Create(AOwner: TComponent); override;
  procedure PaintWindow(DC: HDC); override;
end;

constructor TCheckBox.Create(AOwner: TComponent);
begin
  inherited;
  ControlState := ControlState + [csCustomPaint];
end;

procedure TCheckBox.PaintWindow(DC: HDC);
begin
  ThemeServices.DrawElement(DC,
    ThemeServices.GetElementDetails(tbRadioButtonCheckedNormal), ClientRect);
end;

我同意尤金和克雷格的观点，类似星星的东西会更好，但是，为了回答提出的问题：

无主题单选按钮图像可通过呼叫获取。您可以将其直接指定给TBitmap的

句柄

属性，然后将宽度除以4，将高度除以3，以获得子位图的测量值。使用

TCanvas.BrushCopy

进行绘图

要绘制主题图像，需要使用Delphi的

Themes.pas

。使用

tbRadioButtonCheckedNormal

或

tbRadioButtonCheckedNormal

专门调用

ThemeServices.getElement详细信息

，并将结果与客户端rect一起传递给

ThemeServices.DrawElement

下面是一个简单的替代，它将复选框绘制为选中单选按钮，以便您可以查看其工作原理：

TCheckBox = class(StdCtrls.TCheckBox)
  constructor Create(AOwner: TComponent); override;
  procedure PaintWindow(DC: HDC); override;
end;

constructor TCheckBox.Create(AOwner: TComponent);
begin
  inherited;
  ControlState := ControlState + [csCustomPaint];
end;

procedure TCheckBox.PaintWindow(DC: HDC);
begin
  ThemeServices.DrawElement(DC,
    ThemeServices.GetElementDetails(tbRadioButtonCheckedNormal), ClientRect);
end;

您可以将每个radiobutton放置在一个单独的（微小的）面板上，这样可以替代缺少的GroupIndex属性

在我看来，这可能不是最好的方法，仍然相对便宜。

您可以将每个radiobutton放置在一个单独的（微小的）面板上，这将替代缺少的GroupIndex属性

在我看来，这可能不是最好的方法，但还是相对便宜。

为了最大限度地方便起见，您可以编写一个小控件来绘制本地、主题化的广播框：

unit StarRatingControl;

interface

uses
  SysUtils, Windows, Messages, Graphics, Classes, Controls, UxTheme;

type
  TStarRatingControl = class(TCustomControl)
  private const
    DEFAULT_SPACING = 4;
    DEFAULT_NUM_STARS = 5;
    FALLBACK_BUTTON_SIZE: TSize = (cx: 16; cy: 16);
  private
    { Private declarations }
    FRating: integer;
    FBuffer: TBitmap;
    FSpacing: integer;
    FNumStars: integer;
    FButtonStates: array of integer;
    FButtonPos: array of TRect;
    FButtonSize: TSize;
    FDown: boolean;
    PrevButtonIndex: integer;
    PrevState: integer;
    FOnChange: TNotifyEvent;
    procedure SetRating(const Rating: integer);
    procedure SetSpacing(const Spacing: integer);
    procedure SetNumStars(const NumStars: integer);
    procedure SwapBuffers;
    procedure SetState(const ButtonIndex: integer; const State: integer);
  protected
    { Protected declarations }
    procedure WndProc(var Message: TMessage); override;
    procedure Paint; override;
    procedure MouseMove(Shift: TShiftState; X: Integer; Y: Integer); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X: Integer;
      Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X: Integer;
      Y: Integer); override;

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    { Public declarations }
  published
    { Published declarations }
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property Rating: integer read FRating write SetRating default 3;
    property Spacing: integer read FSpacing write SetSpacing default DEFAULT_SPACING;
    property NumStars: integer read FNumStars write SetNumStars default DEFAULT_NUM_STARS;
    property OnDblClick;
    property OnKeyUp;
    property OnKeyPress;
    property OnKeyDown;
    property OnMouseWheelDown;
    property OnMouseWheelUp;
    property OnMouseWheel;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnMouseActivate;
    property OnMouseMove;
    property OnMouseUp;
    property OnMouseDown;
    property OnClick;
    property Align;
    property Anchors;
    property Color;
  end;

procedure Register;

implementation

uses Math;

function IsIntInInterval(x, xmin, xmax: integer): boolean; inline;
begin
  IsIntInInterval := (xmin <= x) and (x <= xmax);
end;

function PointInRect(const X, Y: integer; const Rect: TRect): boolean; inline;
begin
  PointInRect := IsIntInInterval(X, Rect.Left, Rect.Right) and
                 IsIntInInterval(Y, Rect.Top, Rect.Bottom);
end;

procedure Register;
begin
  RegisterComponents('Rejbrand 2009', [TStarRatingControl]);
end;

{ TStarRatingControl }

constructor TStarRatingControl.Create(AOwner: TComponent);
var
  i: Integer;
begin
  inherited;
  FBuffer := TBitmap.Create;
  FRating := 3;
  FSpacing := DEFAULT_SPACING;
  FNumStars := DEFAULT_NUM_STARS;
  SetLength(FButtonStates, FNumStars);
  SetLength(FButtonPos, FNumStars);
  for i := 0 to high(FButtonStates) do
    FButtonStates[i] := RBS_NORMAL;
  FDown := false;
  PrevButtonIndex := -1;
  PrevState := -1;
end;

destructor TStarRatingControl.Destroy;
begin
  FBuffer.Free;
  inherited;
end;

procedure TStarRatingControl.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var
  i: integer;
begin
  inherited;
  FDown := true;
  for i := 0 to FNumStars - 1 do
    if PointInRect(X, Y, FButtonPos[i]) then
    begin
      SetState(i, RBS_PUSHED);
      Exit;
    end;
end;

procedure TStarRatingControl.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  i: Integer;
begin
  inherited;
  if FDown then Exit;
  for i := 0 to FNumStars - 1 do
    if PointInRect(X, Y, FButtonPos[i]) then
    begin
      SetState(i, RBS_HOT);
      Exit;
    end;
  SetState(-1, -1);
end;

procedure TStarRatingControl.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var
  i: Integer;
begin
  inherited;
  for i := 0 to FNumStars - 1 do
    if PointInRect(X, Y, FButtonPos[i]) and (i = PrevButtonIndex) and (FRating <> i + 1) then
    begin
      SetRating(i + 1);
      if Assigned(FOnChange) then
        FOnChange(Self);
    end;
  FDown := false;
  MouseMove(Shift, X, Y);
end;

procedure TStarRatingControl.Paint;
var
  t: HTHEME;
  i: Integer;
begin
  inherited;
  FBuffer.Canvas.Brush.Color := Color;
  FBuffer.Canvas.FillRect(ClientRect);
  FButtonSize := FALLBACK_BUTTON_SIZE;

  if UseThemes then
  begin

    t := OpenThemeData(Handle, 'BUTTON');
    if t <> 0 then
      try

        GetThemePartSize(t, FBuffer.Canvas.Handle, BP_RADIOBUTTON, RBS_NORMAL, nil, TS_DRAW, FButtonSize);

        for i := 0 to FNumStars - 1 do
          with FButtonPos[i] do
          begin
            Left := i * (Spacing + FButtonSize.cx);
            Top := (Self.Height - FButtonSize.cy) div 2;
            Right := Left + FButtonSize.cx;
            Bottom := Top + FButtonSize.cy;
          end;

        for i := 0 to FNumStars - 1 do
          DrawThemeBackground(t,
                              FBuffer.Canvas.Handle,
                              BP_RADIOBUTTON,
                              IfThen(FRating > i, RBS_CHECKEDNORMAL) + FButtonStates[i],
                              FButtonPos[i],
                              nil);

      finally
        CloseThemeData(t);
      end;

  end
  else
  begin

    for i := 0 to FNumStars - 1 do
      with FButtonPos[i] do
      begin
        Left := i * (Spacing + FButtonSize.cx);
        Top := (Self.Height - FButtonSize.cy) div 2;
        Right := Left + FButtonSize.cx;
        Bottom := Top + FButtonSize.cy;
      end;

    for i := 0 to FNumStars - 1 do
      DrawFrameControl(FBuffer.Canvas.Handle,
                       FButtonPos[i],
                       DFC_BUTTON,
                       DFCS_BUTTONRADIO or IfThen(FRating > i, DFCS_CHECKED));

  end;

  SwapBuffers;

end;

procedure TStarRatingControl.SetNumStars(const NumStars: integer);
var
  i: integer;
begin
  if FNumStars <> NumStars then
  begin
    FNumStars := NumStars;
    SetLength(FButtonStates, FNumStars);
    SetLength(FButtonPos, FNumStars);
    for i := 0 to high(FButtonStates) do
      FButtonStates[i] := RBS_NORMAL;
    Paint;
  end;
end;

procedure TStarRatingControl.SetRating(const Rating: integer);
begin
  if FRating <> Rating then
  begin
    FRating := Rating;
    Paint;
  end;
end;

procedure TStarRatingControl.SetSpacing(const Spacing: integer);
begin
  if FSpacing <> Spacing then
  begin
    FSpacing := Spacing;
    Paint;
  end;
end;

procedure TStarRatingControl.SetState(const ButtonIndex, State: integer);
var
  i: Integer;
begin
  for i := 0 to FNumStars - 1 do
    if i = ButtonIndex then
      FButtonStates[i] := State
    else
      FButtonStates[i] := RBS_NORMAL;

  if (PrevButtonIndex <> ButtonIndex) or (PrevState <> State) then
    Paint;

  PrevButtonIndex := ButtonIndex;
  PrevState := State;

end;

procedure TStarRatingControl.SwapBuffers;
begin
  BitBlt(Canvas.Handle,
         0,
         0,
         Width,
         Height,
         FBuffer.Canvas.Handle,
         0,
         0,
         SRCCOPY);
end;

procedure TStarRatingControl.WndProc(var Message: TMessage);
begin
  inherited;
  case Message.Msg of
    WM_SIZE:
      begin
        FBuffer.SetSize(Width, Height);
        Paint;
      end;
  end;
end;

end.

机组启动控制；
界面
使用
系统、窗口、消息、图形、类、控件、主题；
类型
tstaratingcontrol=class（TCustomControl）
私人康斯特
默认_间距=4；
默认的_NUM_STARS=5；
回退按钮大小：TSize=（cx:16；cy:16）；
私有的
{私有声明}
FRating：整数；
FBuffer:TBitmap；
FSpacing：整数；
FNumStars：整数；
FButtonStates：整数数组；
FButtonPos：TRect的数组；
FButtonSize:TSize；
FDown：布尔型；
PrevButtonIndex：整数；
PrevState：整数；
FOnChange:TNotifyEvent；
程序设置等级（常数等级：整数）；
程序设置间距（常数间距：整数）；
过程SetNumStars（const NumStars:integer）；
程序交换缓冲器；
过程设置状态（常量按钮索引：整数；常量状态：整数）；
受保护的
{受保护的声明}
程序WndProc（变量消息：TMessage）；推翻
程序漆；推翻
过程MouseMove（Shift:tshift状态；X:Integer；Y:Integer）；推翻
过程鼠标向下移动（按钮：TMouseButton；Shift:tShift状态；X:整数；
Y：整数）；推翻
过程鼠标（按钮：TMouseButton；Shift:tShift状态；X:整数；
Y：整数）；推翻
平民的
构造函数创建（AOwner:TComponent）；推翻
毁灭者毁灭；推翻
{公开声明}
出版
{已发布声明}
属性OnChange:TNotifyEvent read FOnChange write FOnChange；
属性级别：整数读写设置默认值3；
属性间距：整数读取fspacking写入setspace默认值D