TStringGrid merge cell drawing

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

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;

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;