如何将复选框更改为纯色并在 Delphi 中更改其边框颜色

Question

我已经构建了一个代表集成电路的控件。

每个图钉都是一个复选框，我根据@Andreas Rebrand 的excellent byte edit example 的这篇帖子进行了控制。复选框最多可以有 4 个值，我想将它们表示为 4 种不同的颜色。我还想将选定复选框的边框设置为一种颜色，以指示它何时被选中。谁能建议如何做到这一点？

Answer 1

链接问题中的代码使用主题 API 来绘制原生样式的复选框。如果这是您想要的，那是个好主意。

但是，在这种情况下，您需要与原生样式的复选框不同的东西，因此最好手动绘制框。然后，当然，你可以给他们任意数量的状态。

例如，

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs;

type
  TForm1 = class(TForm)
    procedure FormPaint(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
  private
    const
      BoxCount = 8;
    type
      TBoxState = (bsRed, bsGreen, bsBlue, bsBlack);
    var
      FBoxes: array[0..BoxCount - 1] of TBoxState;
      FHotBox: Integer;
    const
      Margin = 64;
      InternalPadding = 24;
      BoxSize = 36;
      BoxColors: array[TBoxState] of TColor = ($A6A6FF, $A6FFA6, $FFA6A6, $A6A6A6);
    function GetBoxRect(AIndex: Integer): TRect;
    function GetBoxAt(const APoint: TPoint): Integer;
    procedure DrawBox(AIndex: Integer);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.DrawBox(AIndex: Integer);
begin
  Canvas.Brush.Color := BoxColors[FBoxes[AIndex]];
  Canvas.Pen.Width := 4;
  if AIndex = FHotBox then
    Canvas.Pen.Color := clBlack
  else
    Canvas.Pen.Color := clWindow;
  Canvas.Rectangle(GetBoxRect(AIndex));
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FHotBox := -1;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  var Idx := GetBoxAt(Point(X, Y));
  if Idx <> -1 then
  begin
    FBoxes[Idx] := TBoxState((Succ(Ord(FBoxes[Idx])) mod 4));
    DrawBox(Idx);
  end;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  var LOldHotBox := FHotBox;
  FHotBox := GetBoxAt(Point(X, Y));
  if LOldHotBox <> FHotBox then
  begin
    if LOldHotBox <> -1 then
      DrawBox(LOldHotBox);
    if FHotBox <> -1 then
      DrawBox(FHotBox);
  end;
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  Canvas.Brush.Color := clWindow;
  Canvas.FillRect(ClientRect);
  for var i := 0 to High(FBoxes) do
    DrawBox(i);
end;

function TForm1.GetBoxAt(const APoint: TPoint): Integer;
begin
  for var i := 0 to High(FBoxes) do
    if GetBoxRect(i).Contains(APoint) then
      Exit(i);
  Result := -1;
end;

function TForm1.GetBoxRect(AIndex: Integer): TRect;
begin
  Result.Left := Margin + AIndex * (BoxSize + InternalPadding);
  Result.Top := Margin;
  Result.Width := BoxSize;
  Result.Height := BoxSize;
end;

end.