How to make Delphi TButton control stay pressed?

Question

I've seen How to make a Delphi TSpeedButton stay pressed ..., but I want it to be TButton because of the way it supports drawing glyph (I mean Images, ImageIndex, HotImageIndex, ...). I know that I can draw it all by code, but I thought there must be some trick that makes it stay down.

Answer 1

You can use a TCheckbox or a TRadioButton to have an appearance of a Button with the BS_PUSHLIKE style.

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.

Both TCheckBox and TRadioButton are actually sub-classed from the standard Windows BUTTON control. (This will give a toggle button behavior similar to .net CheckBox with Appearance set to Button - see: 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;

Set the Checked property to make it pressed or not.

To set an image list use Button_SetImageList macro (which sends a BCM_SETIMAGELIST message to the button control) e.g.:

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

Each TButton uses it's own internal image list (FInternalImageList) that holds 5 images for each button state (ImageIndex, HotImageIndex, ...). So when you assign an ImageIndex or HotImageIndex etc, it rebuilds that internal image list, and uses that. If only one image is present, it is used for all states. If needed, see source TCustomButton.UpdateImages to learn how it's done, and apply the same logic for your TButtonCheckBox.

---

Actually the inverse method could be easily applied directly to a TButton by turning it into a "check box" using BS_PUSHLIKE + BS_CHECKBOX styles, and omitting the BS_PUSHBUTTON style completely. I borrowed a bit of code from TCheckBox and used an interposer class for demo:

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;

Now if you set PushLike property to True, you can use the Checked property to toggle the button state.