如何使Delphi TButton控件保持按下状态

Question

我看过如何让Delphi TSpeedButton保持按下状态。。。，但我希望它是TButton，因为它支持绘制字形(我的意思是Images，ImageIndex，HotImageIndex，…)。我知道我可以用代码绘制，但我认为一定有一些技巧可以让它保持不变。

Answer 1

您可以使用TCheckbox或TRadioButton使按钮具有BS_PUSHLIKE样式的外观。

制作按钮(如复选框、三态复选框或单选框按钮)看起来和行为都像按钮。当它没有被推动或检查，当它被推动或被检查时会凹陷。

TCheckBox和TRadioButton实际上都是标准WindowsBUTTON控件的子类。(这将提供类似于.netCheckBox的切换按钮行为，其中Appearance设置为button-请参阅：我们是否将button down属性设置为Boolean)。

type
TButtonCheckBox = class(StdCtrls.TCheckBox)
protected
procedure CreateParams(var Params: TCreateParams); override;
end;
procedure TButtonCheckBox.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.Style := Params.Style or BS_PUSHLIKE;
end;

将Checked属性设置为按下或不按下。

要设置图像列表，请使用Button_SetImageList宏(向按钮控件发送BCM_SETIMAGELIST消息)，例如：

uses CommCtrl;
...
procedure TButtonCheckBox.SetImages(const Value: TCustomImageList);    
var
LButtonImageList: TButtonImageList;
begin
LButtonImageList.himl := Value.Handle;
LButtonImageList.uAlign := BUTTON_IMAGELIST_ALIGN_LEFT;
LButtonImageList.margin := Rect(4, 0, 0, 0);
Button_SetImageList(Handle, LButtonImageList);
Invalidate;
end;

注意：若要使用此宏，必须提供指定Comclt32.dll 6.0版

每个TButton都使用它自己的内部图像列表(FInternalImageList)，该列表为每个按钮状态(ImageIndex、HotImageIndex…)保存5个图像。因此，当您分配一个ImageIndex或HotImageIndex等时，它会重建内部图像列表，并使用它。如果只存在一个图像，则它将用于所有状态。如果需要，请参阅源TCustomButton.UpdateImages以了解它是如何完成的，并将相同的逻辑应用于TButtonCheckBox。

---

实际上，相反的方法可以很容易地直接应用于TButton，方法是使用BS_PUSHLIKE + BS_CHECKBOX样式将其变成一个"复选框"，并完全省略BS_PUSHBUTTON样式。我从TCheckBox中借用了一些代码，并使用了一个用于演示的中介器类：

type
TButton = class(StdCtrls.TButton)
private
FChecked: Boolean;
FPushLike: Boolean;
procedure SetPushLike(Value: Boolean);
procedure Toggle;
procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
protected
procedure SetButtonStyle(ADefault: Boolean); override;
procedure CreateParams(var Params: TCreateParams); override;
procedure CreateWnd; override;
function GetChecked: Boolean; override;
procedure SetChecked(Value: Boolean); override;
published
property Checked;
property PushLike: Boolean read FPushLike write SetPushLike;
end;
implementation
procedure TButton.SetButtonStyle(ADefault: Boolean);
begin
if not FPushLike then inherited;
{ Else, do nothing - avoid setting style to BS_PUSHBUTTON }
end;
procedure TButton.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
if FPushLike then
begin
Params.Style := Params.Style or BS_PUSHLIKE  or BS_CHECKBOX;
Params.WindowClass.style := Params.WindowClass.style and not (CS_HREDRAW or CS_VREDRAW);
end;
end;
procedure TButton.CreateWnd;
begin
inherited CreateWnd;
if FPushLike then
SendMessage(Handle, BM_SETCHECK, Integer(FChecked), 0);
end;
procedure TButton.CNCommand(var Message: TWMCommand);
begin
if FPushLike and (Message.NotifyCode = BN_CLICKED) then
Toggle
else
inherited;
end;
procedure TButton.Toggle;
begin
Checked := not FChecked;
end;
function TButton.GetChecked: Boolean;
begin
Result := FChecked;
end;
procedure TButton.SetChecked(Value: Boolean);
begin
if FChecked <> Value then
begin
FChecked := Value;
if FPushLike then
begin
if HandleAllocated then
SendMessage(Handle, BM_SETCHECK, Integer(Checked), 0);
if not ClicksDisabled then Click;
end;
end;
end;
procedure TButton.SetPushLike(Value: Boolean);
begin
if Value <> FPushLike then
begin
FPushLike := Value;
RecreateWnd;
end;
end;

现在，如果将PushLike属性设置为True，则可以使用Checked属性来切换按钮状态。

Answer 2

这只是对kobik详细答案的修改。我添加了GroupIndex属性以使一组按钮协同工作(当GroupIndex <> 0时，一次只让其中一个按钮停止工作)。这个问题中甚至没有问到这样的设施，但我认为未来来这里的人可能很快就会需要它，就像我一样。我还删除了PushLike属性，并假设它默认为True，因为我毕竟将其命名为TToggleButton。

uses
Winapi.Windows, Vcl.StdCtrls, Winapi.Messages, Vcl.Controls, Vcl.ActnList;
type
TToggleButton = class(TButton)
private
FChecked: Boolean;
FGroupIndex: Integer;
procedure Toggle;
procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
procedure SetGroupIndex(const Value: Integer);
procedure TurnSiblingsOff;
protected
procedure SetButtonStyle(ADefault: Boolean); override;
procedure CreateParams(var Params: TCreateParams); override;
procedure CreateWnd; override;
function GetChecked: Boolean; override;
procedure SetChecked(Value: Boolean); override;
published
property Checked;
property GroupIndex: Integer read FGroupIndex write SetGroupIndex;
end;
implementation
{ TToggleButton}
procedure TToggleButton.SetButtonStyle(ADefault: Boolean);
begin
{ do nothing - avoid setting style to BS_PUSHBUTTON }
end;
procedure TToggleButton.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.Style := Params.Style or BS_PUSHLIKE  or BS_CHECKBOX;
Params.WindowClass.style := Params.WindowClass.style and not (CS_HREDRAW or CS_VREDRAW);
end;
procedure TToggleButton.CreateWnd;
begin
inherited CreateWnd;
SendMessage(Handle, BM_SETCHECK, Integer(FChecked), 0);
end;
procedure TToggleButton.CNCommand(var Message: TWMCommand);
begin
if Message.NotifyCode = BN_CLICKED then
Toggle
else
inherited;
end;
procedure TToggleButton.Toggle;
begin
Checked := not FChecked;
end;
function TToggleButton.GetChecked: Boolean;
begin
Result := FChecked;
end;
procedure TToggleButton.SetChecked(Value: Boolean);
begin
if FChecked <> Value then
begin
FChecked := Value;
if HandleAllocated then
SendMessage(Handle, BM_SETCHECK, Integer(Checked), 0);
if Value then
TurnSiblingsOff;
if not ClicksDisabled then Click;
end;
end;
procedure TToggleButton.SetGroupIndex(const Value: Integer);
begin
FGroupIndex := Value;
if Checked then
TurnSiblingsOff;
end;
procedure TToggleButton.TurnSiblingsOff;
var
I: Integer;
Sibling: TControl;
begin
if (Parent <> nil) and (GroupIndex <> 0) then
with Parent do
for I := 0 to ControlCount - 1 do
begin
Sibling := Controls[I];
if (Sibling <> Self) and (Sibling is TToggleButton) then
with TToggleButton(Sibling) do
if GroupIndex = Self.GroupIndex then
begin
if Assigned(Action) and
(Action is TCustomAction) and
TCustomAction(Action).AutoCheck then
TCustomAction(Action).Checked := False;
SetChecked(False);
end;
end;
end;

CCD_ 36方法是从CCD_。