Paint a border around the selection in a TStringGrid (Views: 28)
Problem/Question/Abstract: Is there any way to draw just borders around the selected cell(s) or row of a string grid? Similar to what you can do in Excel? Answer: Using the OnDrawCell event you have full control over how a cell is drawn since you do all the work, including drawing a cells background and content yourself. Paint a thick border around the selection in a grid: unit Unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ComCtrls, Grids; type TForm1 = class(TForm) StatusBar1: TStatusBar; 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 StringGrid1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); private { Private declarations } FLastCell: TGridCoord; public { Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); procedure DrawLine(onCanvas: TCanvas; x1, y1, x2, y2: Integer); begin onCanvas.MoveTo(x1, y1); onCanvas.LineTo(x2, y2); end; begin if gdFixed in State then Exit; with Sender as TStringgrid do begin Canvas.Brush.Color := $C0FFFF; Canvas.Brush.Style := bsSolid; Canvas.FillRect(Rect); if gdSelected in State then begin Canvas.Pen.Width := 1; Canvas.Pen.Color := clBlue; Canvas.Pen.Style := psSolid; if aCol = Selection.Left then begin DrawLine(Canvas, rect.left, rect.top, rect.left, rect.bottom); DrawLine(Canvas, rect.left + 1, rect.top, rect.left + 1, rect.bottom); end; if aCol = Selection.Right then begin DrawLine(Canvas, rect.right, rect.top, rect.right, rect.bottom); DrawLine(Canvas, rect.right - 1, rect.top, rect.right - 1, rect.bottom); end; if arow = Selection.Top then begin DrawLine(Canvas, rect.left, rect.top, rect.right, rect.top); DrawLine(Canvas, rect.left, rect.top + 1, rect.right, rect.top + 1); end; if arow = Selection.Bottom then begin DrawLine(Canvas, rect.left, rect.bottom, rect.right, rect.bottom); DrawLine(Canvas, rect.left, rect.bottom - 1, rect.right, rect.bottom - 1); end; Canvas.Font.Color := clBlack; end; InflateRect(rect, -2, -2); Canvas.TextRect(rect, rect.left, rect.top, Cells[acol, arow]); end; end; type tgridcracker = class(tstringgrid); procedure TForm1.StringGrid1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin (Sender as TStringgrid).MouseToCell(X, Y, FLastCell.X, FLastCell.Y); end; procedure TForm1.StringGrid1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); var currentcell: TGridCoord; i, k: Integer; begin if ssLeft in Shift then begin (Sender as TStringgrid).MouseToCell(X, Y, currentcell.X, currentcell.Y); if (FLastCell.X <> CurrentCell.X) or (FLastCell.Y <> CurrentCell.Y) then begin with TGridCracker(Sender) do for i := Selection.Left to Selection.Right do for k := selection.top to Selection.bottom do InvalidateCell(i, k); end; end; end; end. |