Question

我已经看过How to make a Delphi TSpeedButton stay pressed ...，但我希望它是TButton因为它支持绘制字形的方式（我的意思是Images，ImageIndex，{ {1}}，...）。我知道我可以通过代码绘制所有内容，但我认为必须有一些技巧可以让它保持原状。

Answer 1

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

制作一个按钮（例如复选框，三态复选框或收音机按钮）外观和行为就像一个按钮。按钮看起来很高兴它不会被推或检查，在推或检查时会被凹陷。

TCheckBox和TRadioButton实际上都是从标准Windows BUTTON控件中细分的。（这将提供类似于.net CheckBox的切换按钮行为，其中Appearance设置为按钮 - 请参阅：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），每个按钮状态保存5张图片（ImageIndex，{{ 1}}，...）。因此，当您分配HotImageIndex或ImageIndex等时，它会重建该内部图像列表并使用它。如果仅存在一个图像，则将其用于所有状态。如果需要，请参阅来源HotImageIndex以了解其完成情况，并为TCustomButton.UpdateImages应用相同的逻辑。

实际上，反向方法可以很容易地直接应用于TButtonCheckBox，方法是将其转换为＆＃34;复选框＆＃34;使用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属性切换按钮状态。

Answer 2

这只是对kobik's detailed answer的修改。我添加了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;

TurnSiblingsOff方法来自TRadioButton。

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

2 个答案: