How change a checkbox to a solid colour and change its border colour in Delphi

Question

I have build a control which represents an Integrated circuit.

Each pin is a check box and I have based the control on the this post from @Andreas Rebrand 's excellent byte edit example The check box can have up to 4 values which I would like to represent as 4 different colours. I would also like to set the border of a selected check box to a colour to indicate when it is selected. Can anyone suggest how this could be done?

Answer 1

The code in the linked question uses the theme API to draw native-styled check boxes. That's a great idea if that is what you want.

In this case, however, you want something different from a native-styled checkbox, so it is probably better to draw the boxes manually. Then, of course, you can give them any number of states.

For example,

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.