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.

Gintz

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;

Waits

Oh, I was going to do that but I thought it will not solve my problem. I though it was repainting only when I fill it with values and when windows updates (like resizing, etc.) – Gintz

Alex, resizing and scrolling you will still need to handle somehow. See this post e.g. – Chlor

I know, I wasn't talking about grid resizing, in my case it is fixed and without scrollbars. I meant that I thought that DrawCell event fires only when content changes or when something like windows resize happens, so just for quick test I placed that code in it. But looks like it fires a lot more often and that's was my problem. – Gintz

Answer 2

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;

Nitrobenzene

This is more precise than the accepted answer, although it doesn't count with row, col sizing. However, that would require overriding of ColWidthsChanged and RowHeightsChanged methods in a subclass. – Chlor

@Chlor you are right, I'm not sure if this case should be added as code too, might become a bigger project. – Nitrobenzene

Yup, it's not that easy, but I'd say your update easily covers all what is needed here (except col and row moving, but I'll be quiet, I promise :-) – Chlor

Answer 3

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;

Foretopmast