Change the cell of a TStringGrid into a button (Views: 28)
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. |