Merge cells in a TStringGrid

Problem/Question/Abstract:

Is it possible to create an OnDrawCell event to draw the cell text in a way that it looks like in Excel? For example, I don't want to truncate the text if the right adjacent cell is empty.

Answer:

You can do that but it is not quite as easy as it may look at first glance. The problem you may run into is that something may invalidate the right adjacent cell in your scenario but not the cell holding the text. So the OnDrawCell event would only fire for the empty cell, not for the one holding the text. So some work has to be done to make sure the cell holding the text is invalidated as well when one of the adjacent cells is invalidated.

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var
  i, x, y: Integer;
begin
  if gdFixed in State then
    Exit;
  if ARow > 1 then
    Exit;
  {Draw row 1 with text from cell 1,1 spanning all cells in the row}
  with sender as TStringGrid do
  begin
    {Extend rect to include grid line on right, if not last cell in row}
    if aCol < Pred(ColCount) then
      Rect.Right := Rect.Right + GridlineWidth;
    {Figure out where the text of the first cell would start relative to the
                        current cells rect}
    y := Rect.Top + 2;
    x := Rect.Left + 2;
    for i := 1 to aCol - 1 do
      x := x - ColWidths[i] - GridlineWidth;
    {Paint cell pale yellow}
    Canvas.Brush.Color := $7FFFFF;
    Canvas.Brush.Style := bsSolid;
    Canvas.FillRect(Rect);
    {Paint text of cell 1,1 clipped to current cell}
    Canvas.TextRect(Rect, x, y, Cells[1, 1]);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  i, k: Integer;
begin
  with StringGrid1 do
  begin
    cells[1, 1] := 'A rather long line which will span cells';
    for i := 1 to colcount - 1 do
      for k := 2 to rowcount - 1 do
        cells[i, k] := Format('Cell[%d, %d]', [i, k]);
  end;
end;