TStringGrid cell merge

Question

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

This / pic link shows what is my code below.

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 contents of the unit1.dfm file.

 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 due to code merging into StringGridDrawCell just below the comment //Attempt to merge 3 cells into one .

I am sure that this is probably something obvious, but for me I do not see life.

NOTE. If someone can turn links into inline images that will be highly appreciated since I don't have enough reputation to post images.

Answer 1

Try the following:

 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

There are other StringGrid components that can join cells. For example, this one that I wrote myself (download sources: NLDStringGrid + NLDSparseList ), possibly with 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; 

Answer 3

The main problem is that the next piece of code that draws the background of the cell with the color clWebLinen always runs after the code that combines the cell.

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

Not to run this code in cells for merging, and also to run a merge code for each cell in a merge (for example, 1,2,3, and not just 1) eliminates most of the problems.

The last part centers the text on 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 complete 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;