TStringGrid with SpeedButtons

Question

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

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 does not look like a live one, although the click event works. No click, animation, focus, etc.

Answer 1

The problem is that you constantly create a new speed button every time a cell needs to be updated. You must create 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

Assuming you want to scroll in your StringGrid and have buttons associated with the selected row, you will need to implement a handler for TopLeftChanged. Buttons will not move if you scroll through the text in a Stringgrid without using code.

 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; 

the extended version proposed by @Tlama would require to implement the interpolator class or use its own component to redefine ColWidthsChanged and RowHeightsChanged so that the buttons are correctly drawn not only when scrolling, but also in rows / columns.

 //..... 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 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;