Fake TSpeedButton based on a TBitBtn

Delphi 3 Minutes

When you google for TSpeedButton and Focus a lot of hits are where people ask how to set the focus to a TSpeedButton and the answer of course is, that it isn’t possible because TSpeedButton descends from TGraphicControl which does not have a window handle and therefore cannot receive the input focus. And that is usually the end to it. I have found 0 (zero) answers on how to get around this shortcoming.

So I posed the same question myself in the Google+ Delphi Developers Community, hoping against hope that somebody in the 30 years that Delphi has existed has come up with a solution (e.g. a component that allows both: A Button that can stay down and still receive focus.

Apparently there are a few, most of them part of a larger component collection, mostly commercial ones, none that is simple and stand alone and free.

While waiting for answers I played around with various solutions and came up with a solution that you can see in the animated GIF above:

Take a TBitBtn, set its Caption xor assign a Glyph to it (no, it won’t work with both), set its Tag to 1, if you want it to start in the Down state, and call TdzSpeedBitBtn.Create(BitBtn).

If you don’t want to change the Down “property” yourself later on, you don’t need to keep the TdzSpeedBitBtn reference around. It will attach itself to the BitBtn and automatically be destroyed when the BitBtn is destroyed.

If you want to execute an event when the button is clicked, feel free to assign an OnClick event prior to passing it to TdzSpeedBitBtn.

If you want to be able to change the Down state, keep the reference. It does have a Down property which will let you change the Down state of the button. If you only want to read it, simply check if the Tag property is <> 0.

EDIT1: Replaced all that line drawing with a call to the WinAPI function DrawEdge.
EDIT2: Set both bitmaps to Transparent.
EDIT3: Moved bitmap generation to a sub procedure.

  TdzSpeedBitBtn.Create(b_Test1);
  TdzSpeedBitBtn.Create(b_Test2);
  TdzSpeedBitBtn.Create(b_Test3);
  TdzSpeedBitBtn.Create(b_Test4);

The helper class TdzSpeedButton isn’t even very complicated. Here is the source code:

unit GX_dzSpeedBitBtn;

interface

uses
  Windows,
  Classes,
  Buttons,
  Graphics;

type
  TdzSpeedBitBtn = class(TComponent)
  private
    FCaption: string;
    FBtn: TBitBtn;
    FOrigBmp: TBitmap;
    FOrigOnClick: TNotifyEvent;
    FUpBmp: TBitmap;
    FDownBmp: TBitmap;
    procedure doOnClick(_Sender: TObject);
    procedure HandleOnClick(_Sender: TObject);
    function GetDown: Boolean;
    procedure SetDown(const Value: Boolean);
    procedure UpdateGlyph;
  public
    constructor Create(_btn: TComponent); override;
    destructor Destroy; override;
    property Down: Boolean read GetDown write SetDown;
  end;

implementation

{ TdzSpeedBitBtn }

constructor TdzSpeedBitBtn.Create(_btn: TComponent);

  procedure PrepareBmp(w, h: Integer; _Color: TColor; _Edge: UINT; out _bmp: TBitmap);
  var
    cnv: TCanvas;
    qrc: TRect;
    TextSize: TSize;
  begin
    _bmp := TBitmap.Create;
    _bmp.Width := w;
    _bmp.Height := h;
    _bmp.TransparentColor := clFuchsia;

    cnv := _bmp.Canvas;

    cnv.Brush.Color := _Color;
    cnv.Brush.Style := bsSolid;
    cnv.FillRect(Rect(0, 0, w, h));

    qrc := Rect(0, 0, w - 1, h - 2);
    DrawEdge(cnv.Handle, qrc, _Edge, BF_RECT);

    if FCaption <> '' then begin
      TextSize := cnv.TextExtent(FCaption);
      cnv.TextOut((w - TextSize.cx) div 2, (h - TextSize.cy) div 2, FCaption);
    end else begin
      cnv.Draw((w - FOrigBmp.Width) div 2, (h - FOrigBmp.Height) div 2, FOrigBmp);
    end;

  end;

var
  w: Integer;
  h: Integer;
  ColBack1: TColor;
  ColBack2: TColor;
begin
  inherited Create(_btn);
  FBtn := _btn as TBitBtn;
  FOrigOnClick := FBtn.OnClick;
  FCaption := FBtn.Caption;

  FOrigBmp := TBitmap.Create;
  FOrigBmp.Assign(FBtn.Glyph);
  FOrigBmp.Transparent := True;

  FBtn.Caption := '';

  w := FBtn.Width - 1;
  h := FBtn.Height - 1;

  ColBack1 := rgb(240, 240, 240); // clBtnFace;
  ColBack2 := rgb(245, 245, 245); // a bit lighter than clBtnFace;

  PrepareBmp(w, h, ColBack1, EDGE_RAISED, FUpBmp);
  PrepareBmp(w, h, ColBack2, EDGE_SUNKEN, FDownBmp);

  FBtn.OnClick := HandleOnClick;

  UpdateGlyph;
end;

destructor TdzSpeedBitBtn.Destroy;
begin
  // If we get here, either the constructor failed (which automatically calls the destructor)
  // or FBtn was already destroyed, so we must not access it at all.
  FUpBmp.Free;
  FDownBmp.Free;
  FOrigBmp.Free;
  inherited;
end;

procedure TdzSpeedBitBtn.doOnClick(_Sender: TObject);
begin
  if Assigned(FOrigOnClick) then
    FOrigOnClick(_Sender);
end;

procedure TdzSpeedBitBtn.HandleOnClick(_Sender: TObject);
begin
  Down := not Down;
  doOnClick(_Sender);
end;

function TdzSpeedBitBtn.GetDown: Boolean;
begin
  Result := (FBtn.Tag <> 0);
end;

procedure TdzSpeedBitBtn.SetDown(const Value: Boolean);
begin
  if Value then
    FBtn.Tag := 1
  else
    FBtn.Tag := 0;
  UpdateGlyph;
end;

procedure TdzSpeedBitBtn.UpdateGlyph;
begin
  if FBtn.Tag <> 0 then
    FBtn.Glyph := FDownBmp
  else
    FBtn.Glyph := FUpBmp;
end;

end.

There is no support for grouping these buttons (yet). I’ll probably not bother but simply use the OnClick event for that.

I have so far tested this only with Delphi 2007 and on Windows 8.1. So it is still possible that it doesn’t work with other Delphi versions (I am going to use it in GExperts, so I will find out) or on other Windows versions (I have only Windows 8.1 to test, so that’s up to people who use GExperts on these versions.).

I will also add this unit to my dzlib library once I am satisfied with it.

Published