TStringGrid merge cell drawing
Solution 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
Solution 2
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;
Solution 3
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;
Related videos on Youtube
Jason Fowler
Updated on June 04, 2022Comments
-
Jason Fowler almost 2 years
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.