delphi - TStringGrid merge cell drawing -

delphi - TStringGrid merge cell drawing -

this link/pic shows trying accomplish tstringgrid.

this link/pic show code below 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) begin celltext := stringgrid.cells[acol, arow]; if ((arow = 0) , (acol in [1, 4, 7])) begin // effort merge 3 cells 1 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]) begin stringgrid.canvas.brush.color := clweblinen; stringgrid.canvas.fillrect(rect); end else stringgrid.canvas.brush.color := clwindow; if (arow > 0) stringgrid.canvas.textout(rect.left + 2, rect.top, celltext); end; end; end.

and 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 merging code in stringgriddrawcell below //attempt merge 3 cells one comment.

i'm sure it's obvious, life of me can't see it.

note: if turn links embedded images much appreciated don't seem have plenty reputation post images.

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 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]) <> [] 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 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 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 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 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 begin stringgrid.canvas.moveto(rect.right-1, rect.top); stringgrid.canvas.lineto(rect.right-1, rect.bottom); end; end; if (state * [gdselected, gdrowselected]) <> [] 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 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 begin celltext := stringgrid.cells[acol, arow]; rect.inflate(-2, -2); if acol = 0 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

delphi delphi-2006 tstringgrid