TStringGrid with SpeedButtons

Question

I want to have a button with icon at the end of each row.

Like here:

I tried this

procedure TMyFrame.sgrd1DrawCell(Sender: TObject; ACol,
  ARow: Integer; Rect: TRect; State: TGridDrawState);
var
  canvas: TCanvas;
  sgrd: TStringGrid;
  point: TPoint;
  btn: TSpeedButton;
begin
  sgrd := TStringGrid(Sender);
  canvas := sgrd.Canvas;

  canvas.FillRect(Rect);

  if (ACol = 1) then 
  begin
    point := Self.ScreenToClient(ClientToScreen(Rect.TopLeft));

    btn := TSpeedButton.Create(sgrd);

    btn.Parent := sgrd;

    btn.OnClick := SpeedButton1Click;
    btn.Tag := ARow;

    btn.enabled:=true;
    btn.visible:= true;

    btn.Top := point.Y;
    btn.Left := point.X;
    btn.Width := 20;
    btn.Height := 24;
  end;
end;

but the button doesn't look like "alive" although click event works. No click, hover animation, focus, etc.

Answer 1

The problem is that you are continuously creating a new speedbutton every time the cell needs refreshing. You must create the buttons in the Create event.

procedure TForm1.FormCreate(Sender: TObject);
var
  canvas: TCanvas;
  point: TPoint;
  btn: TSpeedButton;
  row : integer;
  rect: TRect;
begin
  for row:=0 to stringGrid1.RowCount-1 do
   begin
    rect := stringGrid1.CellRect(1,row);
    point := ScreenToClient(ClientToScreen(Rect.TopLeft));
    btn := TSpeedButton.Create(StringGrid1);
    btn.Parent := StringGrid1;
    btn.OnClick := SpeedButton1Click;
    btn.Tag := row;
    btn.enabled:=true;
    btn.visible:= true;
    btn.Top := point.Y;
    btn.Left := point.X;
    btn.Width := 20;
    btn.Height := 24;
  end;

Answer 2

procedure TForm1.FormCreate(Sender: TObject);
var
  Canvas: TCanvas;
  Point: TPoint;
  MySpeedBtn: TSpeedButton;
  Row: integer;
  Rect: TRect;
begin
  for Row := 1 to StringGrid1.RowCount - 1 do
  begin
    Rect := StringGrid1.CellRect(4, Row);
    point := ScreenToClient(ClientToScreen(Rect.TopLeft));
    MySpeedBtn := TSpeedButton.Create(StringGrid1);
    MySpeedBtn.Parent := StringGrid1;
    MySpeedBtn.OnClick := SpeedButton1Click;
    MySpeedBtn.Tag := Row;
    MySpeedBtn.Width := 20;
    MySpeedBtn.Height := StringGrid1.RowHeights[1];
    MySpeedBtn.Top := Point.Y;
    MySpeedBtn.Left := Point.X + StringGrid1.ColWidths[1] - MySpeedBtn.Width;
  end;
end;

Answer 3

Assuming you might want to be able to scroll within your StringGrid and have the Buttons beeing associated with the selected row, you will have to implement an handler for TopLeftChanged. The buttons won't be moved if you scroll in your Stringgrid, without implementing code for this.

procedure TForm3.SpeedButton1Click(Sender: TObject);
begin
  Showmessage(TSpeedButton(Sender).Name  + ' ' +  IntToStr(TSpeedButton(Sender).Tag));
end;

const
  C_COL = 4;

procedure TForm3.StringGrid1TopLeftChanged(Sender: TObject);
var
  point: TPoint;
  btn: TSpeedButton;
  row: integer;
  rect: TRect;
  y: integer;
begin
  rect := TStringGrid(Sender).CellRect(C_COL, TStringGrid(Sender).TopRow);
  point := ScreenToClient(ClientToScreen(rect.TopLeft));
  y := rect.Top;
  for row := 0 to TStringGrid(Sender).RowCount - 1 do
  begin
    btn := TSpeedButton(TStringGrid(Sender).FindComponent(Format('SP%d', [row])));
    if row >= TStringGrid(Sender).TopRow then
    begin
      btn.Top := y;
      btn.Left := rect.Left;
      btn.Visible := rect.Right > 0;
      y := y + TStringGrid(Sender).DefaultRowHeight;
    end
    else
      btn.Visible := false;
  end;
end;

procedure TForm3.FormCreate(Sender: TObject);
var
  point: TPoint;
  btn: TSpeedButton;
  row: integer;
  rect: TRect;
  y: integer;
begin
  rect := StringGrid1.CellRect(C_COL, StringGrid1.TopRow);
  point := ScreenToClient(ClientToScreen(rect.TopLeft));
  y := rect.Top;
  for row := 0 to StringGrid1.RowCount - 1 do
  begin
    btn := TSpeedButton.Create(StringGrid1);
    btn.Name := Format('SP%d', [row]);
    btn.Parent := StringGrid1;
    btn.OnClick := SpeedButton1Click;
    btn.tag := row;
    btn.Width := StringGrid1.ColWidths[C_COL];
    btn.Height := StringGrid1.DefaultRowHeight;
    btn.Visible := false;
  end;
  StringGrid1TopLeftChanged(TStringGrid(Sender));
end;

an enhanced version as suggested by @Tlama would make it necessary to implement an interposer class or use an own component to override ColWidthsChanged and RowHeightsChanged to keep the buttons painted correct not just on scrolling but on row/column sizing.

//.....

type
  TStringGrid=Class(Grids.TStringGrid)
    procedure ColWidthsChanged; override;
    procedure RowHeightsChanged; override;
  End;

  TForm3 = class(TForm)
    StringGrid1: TStringGrid;
    SpeedButton1: TSpeedButton;
    procedure FormCreate(Sender: TObject);
    procedure StringGrid1TopLeftChanged(Sender: TObject);
  private
    procedure SpeedButton1Click(Sender: TObject);
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form3: TForm3;

implementation

{$R *.dfm}


{ TStringGrid }

procedure TStringGrid.ColWidthsChanged;
begin
  inherited;
  TopLeftChanged;
end;

procedure TStringGrid.RowHeightsChanged;
begin
  inherited;
  TopLeftChanged;
end;



procedure TForm3.SpeedButton1Click(Sender: TObject);
begin
  Showmessage(TSpeedButton(Sender).Name  + ' ' +  IntToStr(TSpeedButton(Sender).Tag));
end;

const
  C_COL = 4;

procedure TForm3.StringGrid1TopLeftChanged(Sender: TObject);
var
  point: TPoint;
  btn: TSpeedButton;
  row: integer;
  rect: TRect;
  y: integer;
begin
  for row := 0 to TStringGrid(Sender).RowCount - 1 do
  begin
    btn := TSpeedButton(TStringGrid(Sender).FindComponent(Format('SP%d', [row])));
    if row >= TStringGrid(Sender).TopRow then
    begin
      rect := TStringGrid(Sender).CellRect(C_COL, row);
      btn.BoundsRect := rect;
      btn.Visible := rect.Right > 0;
      y := y + TStringGrid(Sender).DefaultRowHeight;
    end
    else
      btn.Visible := false;
  end;
end;

procedure TForm3.FormCreate(Sender: TObject);
var
  point: TPoint;
  btn: TSpeedButton;
  row: integer;
  rect: TRect;
  y: integer;
begin
  rect := StringGrid1.CellRect(C_COL, StringGrid1.TopRow);
  point := ScreenToClient(ClientToScreen(rect.TopLeft));
  y := rect.Top;
  for row := 0 to StringGrid1.RowCount - 1 do
  begin
    btn := TSpeedButton.Create(StringGrid1);
    btn.Name := Format('SP%d', [row]);
    btn.Parent := StringGrid1;
    btn.OnClick := SpeedButton1Click;
    btn.tag := row;

    btn.Visible := false;
  end;
  StringGrid1TopLeftChanged(TStringGrid(Sender));
end;