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

Question

我见过How to make a Delphi TSpeedButton stay pressed ... ，但我希望它是 TButton 因为它支持绘制字形的方式(我的意思是 Images、ImageIndex、HotImageIndex，...)。我知道我可以通过代码将其全部绘制出来，但我认为一定有一些技巧可以使其保持不变。

Answer 1

您可以使用 TCheckbox 或 TRadioButton 来获得带有 BS_PUSHLIKE 的按钮外观。风格。

Makes a button (such as a check box, three-state check box, or radio button) look and act like a push button. The button looks raised when it isn't pushed or checked, and sunken when it is pushed or checked.

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;

Note: To use this macro, you must provide a manifest specifying Comclt32.dll version 6.0

每个 TButton 使用它自己的内部图像列表 (FInternalImageList)，该列表为每个按钮状态保存 5 个图像 (ImageIndex，HotImageIndex，...)。因此，当您分配 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 属性来切换按钮状态。