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

Question

我已经看到了如何使德尔福TSpeedButton保持按下......,但我想这是TButton因为它支持绘制字形的方式(我的意思是Images,ImageIndex,HotImageIndex,...).我知道我可以通过代码绘制所有内容,但我认为必须有一些技巧可以让它保持原状.

Answer 1

您可以使用a TCheckbox或a TRadioButton来显示带有BS_PUSHLIKE样式的Button外观.

使按钮(例如复选框,三态复选框或单选按钮)看起来像按钮一样.未按下或检查时按钮看起来凸起,按下或检查时按钮凹陷.

双方TCheckBox并TRadioButton实际上是从标准的Windows子类BUTTON控制.(这将提供类似于.net的切换按钮行为CheckBox,Appearance设置为Button - 请参阅:我们将Button down属性设置为布尔值).

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,HotImageIndex...).因此,当您分配ImageIndex或HotImageIndex等时,它会重建该内部图像列表,并使用它.如果仅存在一个图像,则将其用于所有状态.如果需要,请参阅source TCustomButton.UpdateImages以了解它是如何完成的,并为您的应用程序应用相同的逻辑TButtonCheckBox.

实际上,逆方法可以通过TButton使用BS_PUSHLIKE + BS_CHECKBOX样式将其转换为"复选框"而直接应用于a ,并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属性切换按钮状态.