TStringGrid merge cell drawing

Question

This link/pic shows what I am trying to achieve with a TStringGrid.

This link/pic show what my code below is resulting in.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids;

type
  TForm1 = class(TForm)
    StringGrid: TStringGrid;
    procedure FormCreate(Sender: TObject);
    procedure StringGridDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
  private
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
const
  cProdWidth = 70;
  cCountWidth = 45;
  cWeightWidth = 55;
var
  Index: Integer;
  Col, Row: Integer;
begin
  StringGrid.ColCount := 10;
  StringGrid.RowCount := 2;
  StringGrid.Cells[1, 0] := 'Shoulder';
  StringGrid.ColWidths[1] := cProdWidth;
  StringGrid.Cells[4, 0] := 'Barrel';
  StringGrid.ColWidths[4] := cProdWidth;
  StringGrid.Cells[7, 0] := 'Leg';
  StringGrid.ColWidths[7] := cProdWidth;

  StringGrid.Cells[0, 1] := 'Carcass Prod';
  StringGrid.ColWidths[0] := cProdWidth;
  StringGrid.Cells[1, 1] := 'Product';
  StringGrid.Cells[2, 1] := 'Count';
  StringGrid.ColWidths[2] := cCountWidth;
  StringGrid.Cells[3, 1] := 'Weight %';
  StringGrid.ColWidths[3] := cWeightWidth;
  StringGrid.Cells[4, 1] := 'Product';
  StringGrid.Cells[5, 1] := 'Count';
  StringGrid.ColWidths[5] := cCountWidth;
  StringGrid.Cells[6, 1] := 'Weight %';
  StringGrid.ColWidths[6] := cWeightWidth;
  StringGrid.Cells[7, 1] := 'Product';
  StringGrid.Cells[8, 1] := 'Count';
  StringGrid.ColWidths[8] := cCountWidth;
  StringGrid.Cells[9, 1] := 'Weight %';
  StringGrid.ColWidths[9] := cWeightWidth;
  StringGrid.Invalidate;
end;

procedure TForm1.StringGridDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
var
  CellText: String;
begin
  if (ACol > 0)
    then begin
          CellText := StringGrid.Cells[ACol, ARow];
          if ((ARow = 0) and (ACol in [1, 4, 7]))
            then begin
                  // Attempt to merge 3 cells into one
                  Rect.Right := StringGrid.ColWidths[ACol] + StringGrid.ColWidths[ACol + 1] + StringGrid.ColWidths[ACol + 2];
                  StringGrid.Canvas.Brush.Color := clWindow;
                  StringGrid.Canvas.Brush.Style := bsSolid;
                  StringGrid.Canvas.Pen.Style := psClear;
                  StringGrid.Canvas.FillRect(rect);
                  DrawText(StringGrid.Canvas.Handle, PChar(CellText), Length(CellText), Rect, DT_SINGLELINE or DT_LEFT or DT_VCENTER or DT_END_ELLIPSIS);
                 end;
          if (ACol in [1,2,3,7,8,9])
            then begin
                  StringGrid.Canvas.Brush.Color := clWebLinen;
                  StringGrid.Canvas.FillRect(Rect);
                 end
            else StringGrid.Canvas.Brush.Color := clWindow;
          if (ARow > 0)
            then StringGrid.Canvas.TextOut(Rect.Left + 2, Rect.Top, CellText);
         end;
end;

end.

And this is my unit1.dfm file contents.

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 371
  ClientWidth = 606
  Color = clBtnFace    
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object StringGrid: TStringGrid
    Left = 0
    Top = 0
    Width = 606
    Height = 371
    Align = alClient
    ColCount = 1
    FixedCols = 0
    RowCount = 1
    FixedRows = 0
    TabOrder = 0
    OnDrawCell = StringGridDrawCell
    ExplicitLeft = 160
    ExplicitTop = 88
    ExplicitWidth = 320
    ExplicitHeight = 120
  end
end

The problem seems to be with the merging code in StringGridDrawCell just below the //Attempt to merge 3 cells into one comment.

I'm sure it's probably something obvious, but for the life of me I can't see it.

NOTE: If someone could turn the links into embedded images that would be much appreciated as I don't seem to have enough reputation to post images.

Answer 1

Try this:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics,
  Controls, Forms, Dialogs, Grids;

type
  TForm1 = class(TForm)
    StringGrid: TStringGrid;
    procedure StringGridDrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
const
  cProdWidth = 70;
  cCountWidth = 45;
  cWeightWidth = 55;
  cNoSelection: TGridRect = (Left: -1; Top: -1; Right: -1; Bottom: -1);
begin
  StringGrid.ColCount := 10;
  StringGrid.RowCount := 3;
  StringGrid.FixedRows := 2;

  StringGrid.RowHeights[0] := StringGrid.Canvas.TextHeight('Shoulder') + 4;
  StringGrid.RowHeights[1] := (StringGrid.Canvas.TextHeight('Carcass Product') + 4) * 2;

  StringGrid.ColWidths[0] := cProdWidth;
  StringGrid.ColWidths[1] := cProdWidth;
  StringGrid.ColWidths[2] := cCountWidth;
  StringGrid.ColWidths[3] := cWeightWidth;
  StringGrid.ColWidths[4] := cProdWidth;
  StringGrid.ColWidths[5] := cCountWidth;
  StringGrid.ColWidths[6] := cWeightWidth;
  StringGrid.ColWidths[7] := cProdWidth;
  StringGrid.ColWidths[8] := cCountWidth;
  StringGrid.ColWidths[9] := cWeightWidth;

  StringGrid.Cells[1, 0] := 'Shoulder';
  StringGrid.Cells[4, 0] := 'Barrel';
  StringGrid.Cells[7, 0] := 'Leg';

  StringGrid.Cells[0, 1] := 'Carcass'#10'Product';
  StringGrid.Cells[1, 1] := 'Product';
  StringGrid.Cells[2, 1] := 'Count';
  StringGrid.Cells[3, 1] := 'Weight %';
  StringGrid.Cells[4, 1] := 'Product';
  StringGrid.Cells[5, 1] := 'Count';
  StringGrid.Cells[6, 1] := 'Weight %';
  StringGrid.Cells[7, 1] := 'Product';
  StringGrid.Cells[8, 1] := 'Count';
  StringGrid.Cells[9, 1] := 'Weight %';

  StringGrid.Cells[0, 2] := '22-110';
  StringGrid.Cells[1, 2] := '22-120';
  StringGrid.Cells[2, 2] := '2';
  StringGrid.Cells[3, 2] := '35';
  StringGrid.Cells[4, 2] := '22-130';
  StringGrid.Cells[5, 2] := '1';
  StringGrid.Cells[6, 2] := '25';
  StringGrid.Cells[7, 2] := '22-140';
  StringGrid.Cells[8, 2] := '2';
  StringGrid.Cells[9, 2] := '40';

  StringGrid.Selection := cNoSelection;
  StringGrid.Invalidate;
end;

procedure TForm1.StringGridDrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var
  CellText: String;
begin
  Rect := StringGrid.CellRect(ACol, ARow);

  if ARow = 0 then
  begin
    case ACol of
      1, 4, 7: begin
        Rect.Right := Rect.Right + StringGrid.GridLineWidth;
      end;
      2, 5, 8: begin
        Rect.Left := Rect.Left - StringGrid.GridLineWidth;
        Rect.Right := Rect.Right + StringGrid.GridLineWidth;
      end;
      3, 6, 9: begin
        Rect.Left := Rect.Left - StringGrid.GridLineWidth;
      end;
    end;
    case ACol of
      0, 4..6: begin
        StringGrid.Canvas.Brush.Color := clWindow;
      end;
      1..3, 7..9: begin
        StringGrid.Canvas.Brush.Color := clWebLinen;
      end;
    end;
  end else
  begin
    if (State * [gdSelected, gdRowSelected]) <> [] then
      StringGrid.Canvas.Brush.Color := clHighlight
    else
      StringGrid.Canvas.Brush.Color := clWindow;
  end;

  StringGrid.Canvas.Brush.Style := bsSolid;
  StringGrid.Canvas.Pen.Style := psClear;
  StringGrid.Canvas.FillRect(Rect);

  StringGrid.Canvas.Brush.Style := bsClear;
  StringGrid.Canvas.Pen.Style := psSolid;
  StringGrid.Canvas.Pen.Color := clWindowText;

  if ARow = 0 then
  begin
    StringGrid.Canvas.MoveTo(Rect.Left, Rect.Top);
    StringGrid.Canvas.LineTo(Rect.Right, Rect.Top);

    case ACol of
      0, 1, 4, 7: begin
        StringGrid.Canvas.MoveTo(Rect.Left, Rect.Top);
        StringGrid.Canvas.LineTo(Rect.Left, Rect.Bottom);
      end;
    end;

    if ACol = 9 then
    begin
      StringGrid.Canvas.MoveTo(Rect.Right-1, Rect.Top);
      StringGrid.Canvas.LineTo(Rect.Right-1, Rect.Bottom);
    end;

    StringGrid.Canvas.MoveTo(Rect.Left, Rect.Bottom);
    StringGrid.Canvas.LineTo(Rect.Right, Rect.Bottom);
  end
  else if ARow = 1 then
  begin
    StringGrid.Canvas.MoveTo(Rect.Left, Rect.Top);
    StringGrid.Canvas.LineTo(Rect.Right, Rect.Top);

    case ACol of
      1..9: begin
        StringGrid.Canvas.MoveTo(Rect.Left, Rect.Top);
        StringGrid.Canvas.LineTo(Rect.Left, Rect.Bottom);
      end;
    end;

    if ACol = 9 then
    begin
      StringGrid.Canvas.MoveTo(Rect.Right-1, Rect.Top);
      StringGrid.Canvas.LineTo(Rect.Right-1, Rect.Bottom);
    end;

    StringGrid.Canvas.MoveTo(Rect.Left, Rect.Bottom-1);
    StringGrid.Canvas.LineTo(Rect.Right, Rect.Bottom-1);
  end
  else begin
    case ACol of
      1..9: begin
        StringGrid.Canvas.MoveTo(Rect.Left, Rect.Top);
        StringGrid.Canvas.LineTo(Rect.Left, Rect.Bottom);
      end;
    end;

    if ACol = 9 then
    begin
      StringGrid.Canvas.MoveTo(Rect.Right-1, Rect.Top);
      StringGrid.Canvas.LineTo(Rect.Right-1, Rect.Bottom);
    end;
  end;

  if (State * [gdSelected, gdRowSelected]) <> [] then
  begin
    StringGrid.Canvas.Brush.Color := clHighlight;
    StringGrid.Canvas.Font.Color := clHighlightText;
  end else
  begin
    StringGrid.Canvas.Brush.Color := clWindow;
    StringGrid.Canvas.Font.Color := clWindowText;
  end;
  StringGrid.Canvas.Brush.Style := bsClear;

  if ARow = 0 then
  begin
    case ACol of
      1..3: begin
        Rect.TopLeft := StringGrid.CellRect(1, 0).TopLeft;
        Rect.BottomRight := StringGrid.CellRect(3, 0).BottomRight;
        CellText := StringGrid.Cells[1, 0];
      end;
      4..6: begin
        Rect.TopLeft := StringGrid.CellRect(4, 0).TopLeft;
        Rect.BottomRight := StringGrid.CellRect(6, 0).BottomRight;
        CellText := StringGrid.Cells[4, 0];
      end;
      7..9: begin
        Rect.TopLeft := StringGrid.CellRect(7, 0).TopLeft;
        Rect.BottomRight := StringGrid.CellRect(9, 0).BottomRight;
        CellText := StringGrid.Cells[7, 0];
      end;
    end;

    Rect.Inflate(-2, -2);
    DrawText(StringGrid.Canvas.Handle, PChar(CellText), Length(CellText), Rect, DT_SINGLELINE or DT_CENTER or DT_VCENTER or DT_END_ELLIPSIS);
  end
  else if ARow = 1 then
  begin
    CellText := StringGrid.Cells[ACol, ARow];
    Rect.Inflate(-2, -2);
    if ACol = 0 then
      DrawText(StringGrid.Canvas.Handle, PChar(CellText), Length(CellText), Rect, DT_WORDBREAK or DT_LEFT or DT_VCENTER or DT_END_ELLIPSIS)
    else
      DrawText(StringGrid.Canvas.Handle, PChar(CellText), Length(CellText), Rect, DT_SINGLELINE or DT_CENTER or DT_BOTTOM or DT_END_ELLIPSIS);
  end
  else begin
    CellText := StringGrid.Cells[ACol, ARow];
    Rect.Inflate(-2, -2);
    case ACol of
      0..1, 4, 7: begin
        DrawText(StringGrid.Canvas.Handle, PChar(CellText), Length(CellText), Rect, DT_SINGLELINE or DT_LEFT or DT_VCENTER or DT_END_ELLIPSIS);
      end;
      2..3, 5..6, 8..9: begin
        DrawText(StringGrid.Canvas.Handle, PChar(CellText), Length(CellText), Rect, DT_SINGLELINE or DT_RIGHT or DT_VCENTER or DT_END_ELLIPSIS);
      end;
    end;
  end;
end;

end.

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 371
  ClientWidth = 606
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object StringGrid: TStringGrid
    Left = 0
    Top = 0
    Width = 606
    Height = 371
    Align = alClient
    ColCount = 1
    FixedCols = 0
    RowCount = 1
    FixedRows = 0
    Options = [goRangeSelect, goRowSelect]
    TabOrder = 0
    OnDrawCell = StringGridDrawCell
  end
end

Answer 2

The main problem is that the following piece of code which draws the cell background with a clWebLinen colour is always run after the code which merges the cell.

if (ACol in [1,2,3,7,8,9])
  then begin
        StringGrid.Canvas.Brush.Color := clWebLinen;
        StringGrid.Canvas.FillRect(Rect);
       end;

Not running this code on cells to be merged, along with running the merge code for each cell in the merge (eg. 1,2,3. Not just 1) fixes most issues.

The final piece is centering the text across the merged cells, which can be achieved by changing DT_LEFT to DT_CENTER.

DrawText(StringGrid.Canvas.Handle, PChar(CellText), Length(CellText), Rect, DT_SINGLELINE or DT_CENTER or DT_VCENTER or DT_END_ELLIPSIS);

Below is the full solution.

procedure TForm1.StringGridDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
const
  cGridLineWidth = 1;
  cGroupCount = 3;
var
  CellText: String;    
  ProdCol: Integer;
  CountCol: Integer;
  WeightCol: Integer;
  Found: Boolean;
begin
  if ((ARow = 0) and (ACol > 0))
    then begin
          ProdCol := 1;
          CountCol := 2;
          WeightCol := 3;
          Found := False;
          while (not Found) do
            begin
              if ((ACol = ProdCol) or (ACol = CountCol) or (ACol = WeightCol))
                then begin
                      Found := True;
                      if (ACol = ProdCol)
                        then begin
                              Rect.Right := Rect.Right + StringGrid.ColWidths[CountCol] + cGridLineWidth + StringGrid.ColWidths[WeightCol] + cGridLineWidth;
                             end
                      else if (ACol = CountCol)
                        then begin
                              Rect.Right := Rect.Right + StringGrid.ColWidths[WeightCol] + cGridLineWidth;
                              Rect.Left := Rect.Left - cGridLineWidth - StringGrid.ColWidths[ProdCol];
                             end
                        else begin
                              Rect.Left := Rect.Left - cGridLineWidth - StringGrid.ColWidths[CountCol] - cGridLineWidth - StringGrid.ColWidths[ProdCol];
                             end;
                      CellText := StringGrid.Cells[ProdCol, ARow];
                      if (ACol in [1,2,3,7,8,9])
                        then StringGrid.Canvas.Brush.Color := clWebLinen
                        else StringGrid.Canvas.Brush.Color := clWindow;
                      StringGrid.Canvas.Brush.Style := bsSolid;
                      StringGrid.Canvas.Pen.Style := psClear;
                      StringGrid.Canvas.FillRect(rect);
                      StringGrid.Canvas.Pen.Style := psSolid;
                      DrawText(StringGrid.Canvas.Handle, PChar(CellText), Length(CellText), Rect, DT_SINGLELINE or DT_CENTER or DT_VCENTER or DT_END_ELLIPSIS);
                     end;
              ProdCol := ProdCol + cGroupCount;
              CountCol := CountCol + cGroupCount;
              WeightCol := WeightCol + cGroupCount;
            end;
         end
    else begin
          CellText := StringGrid.Cells[ACol, ARow];
          if (ACol in [1,2,3,7,8,9])
            then StringGrid.Canvas.Brush.Color := clWebLinen
            else StringGrid.Canvas.Brush.Color := clWindow;
          if (ARow = 0)
            then Exit;
          StringGrid.Canvas.FillRect(Rect);
          DrawText(StringGrid.Canvas.Handle, PChar(CellText), Length(CellText), Rect, DT_SINGLELINE or DT_LEFT or DT_VCENTER);
         end;
end;

Answer 3

There are other StringGrid components able of merging cells. For instance, this one which I wrote myself (download source: NLDStringGrid) with possibly this result:

var
  R: TRect;
begin
  NLDStringGrid1.Columns.Add;
  NLDStringGrid1.Columns.Add;
  NLDStringGrid1.Cells[1, 1] := 'Sample test'#13#10'Second line';
  NLDStringGrid1.Columns[1].MultiLine := True;
  NLDStringGrid1.AutoRowHeights := True;
  SetRect(R, 2, 2, 3, 3);
  NLDStringGrid1.MergeCells(TGridRect(R), True, True);
  NLDStringGrid1.ColWidths[2] := 40;
  NLDStringGrid1.Cells[2, 2] := 'Sample test'#13#10'Second line';
end;