Change the cell of a TStringGrid into a button

Problem/Question/Abstract:

Does anyone know how to make a cell (that has text in it) look like a button with the text written on it?

Answer:

The following example fakes a column of buttons in column 3 of the grid. The buttons are "clickable". Events of the grid handled are OnMouseDown, OnMOuseUp, OnDrawCell, OnSelectCell.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, StdCtrls, Grids;

type
  TForm1 = class(TForm)
    StatusBar: TStatusBar;
    Button1: TButton;
    Label1: TLabel;
    StringGrid1: TStringGrid;
    procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect;
      State: TGridDrawState);
    procedure StringGrid1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure StringGrid1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer; var
      CanSelect: Boolean);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    FButtonDown: Boolean;
    FDownRow: Integer;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

const
  ButtonCol = 3;
type
  TGridCracker = class(TStringGrid);
  {gives access to protected methods of grid}

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var
  grid: TStringGrid;
begin
  grid := Sender as TStringGrid;
  if (aCol = ButtonCol) and (aRow >= grid.FixedRows) then
  begin
    {draw a button in Rect}
    DrawFrameControl(grid.Canvas.handle, Rect, DFC_BUTTON, DFCS_BUTTONPUSH or
      DFCS_ADJUSTRECT or DFCS_PUSHED * Ord(FButtonDown and (Arow = FDOwnrow)));
    grid.Canvas.Brush.Style := bsClear;
    grid.Canvas.Font.Color := clBlack;
    grid.Canvas.TextRect(Rect, Rect.Left + 2, Rect.Top + 2, grid.Cells[aCol, aRow]);
    grid.Canvas.Brush := grid.Brush;
  end;
end;

procedure TForm1.StringGrid1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  r: TPoint;
  grid: TGridCracker;
begin
  if (Button = mbLeft) and ((Shift - [ssLeft]) = []) then
  begin
    grid := TGridCracker(Sender as TStringGrid);
    grid.MouseToCell(X, Y, r.x, r.y);
    if (r.x = ButtonCol) and (r.y >= grid.FixedRows) then
    begin
      FDownRow := r.Y;
      FButtonDown := true;
      grid.InvalidateCell(r.x, r.y);
      grid.MouseCapture := true;
      grid.Options := grid.Options - [goRangeSelect];
    end;
  end;
end;

procedure TForm1.StringGrid1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  grid: TGridCracker;
begin
  if FButtonDown then
  begin
    grid := TGridCracker(Sender as TStringGrid);
    grid.MouseCapture := false;
    FButtonDown := False;
    grid.InvalidateCell(ButtonCol, FDownRow);
    grid.Options := grid.Options + [goRangeSelect];
    { ... might do some click action here}
  end;
end;

procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer;
  var CanSelect: Boolean);
begin
  CanSelect := aCol <> ButtonCol;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  i: Integer;
begin
  for i := 1 to StringGrid1.rowcount - 1 do
    StringGrid1.cells[ButtonCol, i] := format('Button %d', [i]);
end;

end.