Paint a border around the selection in a TStringGrid

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.