Как подавить стандартное поведение проверки RadioButton в Delphi?

Question

Я понимаю, что это немного странно, поэтому я объясню. Для простого интернет-радио-плеера мне нужен элемент управления для определения рейтинга (1-5 "звездочек"). У меня нет опыта или таланта в графическом дизайне, поэтому все мои попытки рисовать растровые изображения выглядят смешно / ужасно, выбирайте сами. Я не смог найти сторонний элемент управления с такими функциями и внешний вид, который соответствует стандартным элементам управления VCL. Итак ...

Мне пришло в голову, что я могу добиться нормального внешнего вида и согласованности с пользовательским интерфейсом Windows с помощью стандартных радиокнопок без заголовков, например:

У меня было смутное (и неправильное) воспоминание свойства GroupIndex; назначение различного значения для каждой радиокнопки позволило бы проверять несколько радиокнопок одновременно. Увы, TRadioButton не имеет свойства GroupIndex, вот и все.

1. Можно ли полностью переопределить естественное поведение радиокнопки , чтобы одновременно можно было увидеть несколько проверенных кнопок? Или,

2. Могу ли я получить все растровые изображения, которые Windows использует для радиокнопок (я предполагаю, что они являются растровыми изображениями), из системы и нарисовать их напрямую, включая поддержку тем? В этом случае я все еще хотел бы сохранить все эффекты радиопереключателя, включая «свечение» при наведении мыши и т. Д., Что означает получение всех «родных» растровых изображений и их рисование по мере необходимости, возможно, на TPaintBox.

Answer 1

Для максимального удобства вы могли бы написать небольшой элемент управления, который рисует родные, тематические, радиоблоки:

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.

Просто настройте свойства NumStars, Rating и Spacing и получайте удовольствие!

Рейтинг контроля http://privat.rejbrand.se/ratingctrl.png

Конечно, вы также можете написать компонент, который использует собственные растровые изображения вместо встроенных переключателей Windows.

Answer 2

Я согласен с Юджином и Крейгом, что что-то вроде звезд было бы лучше, но, чтобы ответить на поставленный вопрос:

Необработанные изображения переключателей доступны по телефону LoadBitmap с OBM_CHECKBOXES . Вы можете назначить это непосредственно свойству Handle TBitmap, а затем разделить ширину на 4 и высоту на 3, чтобы получить измерения подбитовой карты. Используйте TCanvas.BrushCopy для рисования.

Чтобы нарисовать тематические изображения, вам нужно использовать Delphi's Themes.pas. В частности, вызовите ThemeServices.GetElementDetails с tbRadioButtonUncheckedNormal или tbRadioButtonCheckedNormal и передайте результат в ThemeServices.DrawElement вместе с клиентом rect.

Вот простое переопределение, которое заставляет TCheckBox рисовать как проверенную радиокнопку, чтобы вы могли увидеть, как это работает:

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;

Answer 3

Вы можете поместить каждую радиокнопку на отдельную (крошечную) панель, и это заменит отсутствующее свойство GroupIndex.

Может быть, не самый хороший метод, все еще относительно дешевый, мне кажется.

Answer 4

Создание радиокнопок, которые выглядят как радиокнопки, но ведут себя иначе, может запутать пользователя. Кроме того, в конечном итоге вам понадобятся полу-галочки, когда вы решите отобразить существующие рейтинги. Таким образом, что-то вроде индикатора выполнения (может быть пользовательского или нарисованного) для отображения, насколько «полное» удовлетворение пользователя может быть лучшим вариантом.

Answer 5

Хорошее вдохновение дало вам Андреас Рейбранд (+1).Я предоставлю вам небольшой кусочек кода того, что вы, вероятно, ищете.Это форма с двумя перекрывающимися изображениями с одним общим событием - OnMouseDown.Он содержит только некоторую безумную формулу - к сожалению, с константами, которые я сделал некоторое время назад.Но извините, я не математик, поэтому, пожалуйста, будьте терпеливы со мной, и давайте возьмем это также как вдохновение:)