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