TStringGrid with SpeedButtons - delphi

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

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;

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

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;