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

我见过How to make a Delphi TSpeedButton stay pressed ...，但是我希望它成为TButton，因为它支持绘制字形的方式（我的意思是Images，ImageIndex，HotImageIndex，...）。我知道我可以通过代码来绘制所有内容，但我认为必须有一些技巧可以使其保持不变。

最佳答案

您可以使用TCheckbox或TRadioButton来显示具有BS_PUSHLIKE样式的Button。


  制作一个按钮（例如复选框，三态复选框或单选按钮
  按钮）的外观和行为就像一个按钮。当
  它不会被推动或检查，而在被推动或检查时会下沉。


实际上，TCheckBox和TRadioButton都从标准Windows BUTTON控件中被子类化。 （这将提供类似于.net CheckBox的切换按钮行为，其中Appearance设置为Button-请参阅：Do we have Button down property as 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属性来切换按钮状态。