delphidelphi-2010vcltbutton

How to make Delphi TButton control stay pressed?


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.


Solution

  • 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.