如何在 Delphi 中将复选框更改为纯色并更改其边框颜色
How change a checkbox to a solid colour and change its border colour in Delphi
我构建了一个代表集成电路的控件。
每个引脚都是一个复选框,我的控件基于@Andreas Rebrand 的 excellent byte edit example 中的这个 post 复选框最多可以有 4 个值,我想代表 4 种不同的颜色。我还想将选中的复选框的边框设置为一种颜色以指示它何时被选中。谁能建议如何做到这一点?
链接问题中的代码使用主题 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.
我构建了一个代表集成电路的控件。
每个引脚都是一个复选框,我的控件基于@Andreas Rebrand 的 excellent byte edit example 中的这个 post 复选框最多可以有 4 个值,我想代表 4 种不同的颜色。我还想将选中的复选框的边框设置为一种颜色以指示它何时被选中。谁能建议如何做到这一点?
链接问题中的代码使用主题 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.