Recent

Author Topic: Merged cell height calculation [ANSWERED]  (Read 765 times)

totya

  • Hero Member
  • *****
  • Posts: 627
Merged cell height calculation [ANSWERED]
« on: July 12, 2020, 04:07:04 pm »
Hi wp master!

I have an excel table with many merged cells (with line break). Can I determine and set the height of this row to fit the text?

See sample picture.

And what is the present time recommended auto row height force recalculation method for non-merged cells?

Thank you!
« Last Edit: July 12, 2020, 05:12:09 pm by totya »

wp

  • Hero Member
  • *****
  • Posts: 7356
Re: Merged cell height calculation
« Reply #1 on: July 12, 2020, 04:36:48 pm »
I guess you mean "lines with line break" rather than "merged cells". The former ones are simple cells which contain line ending characters in their text; the latter ones is a single cell which extends over the adjacent horizontal and/or vertical cells. The content of the merged block is given by the top/left cell; therefore, it is not possible to merge cells with content in A1, A2 and A3 into a common block extending from A1 to A3 - the merged block will only display the content of cell A1.

In order to define a cell with line break just call WriteWordWrap for it:

Code: Pascal  [Select][+][-]
  1. worksheet.WriteWordWrap(row, col, 'line1' + lineending + 'line2');

In order to determine the wrapped row height you can call CalcAutoRowHeight(row). Note, however, that fpspreadsheet does not know the font metrics here, and the calculated value will only be approximate.

In order to make Excel use the wrapped row height you must call WriteRowHeight with the result of CalcAutoRowHeight as a parameter. This is exactly what Excel seems to be doing itself.

Code: Pascal  [Select][+][-]
  1. procedure TForm1.Button1Click(Sender: TObject);
  2. var
  3.   wb: TsWorkbook;
  4.   sh: TsWorksheet;
  5.   cell: PCell;
  6. begin
  7.   wb := TsWorkbook.Create;
  8.   try
  9.     sh := wb.AddWorksheet('Test');
  10.     cell := sh.WriteText(0, 0, 'Line 1' + Lineending + 'Line 2' + LineEnding + 'Line 3');
  11.     sh.WriteWordwrap(cell, true);
  12.     sh.WriteRowHeight(0, sh.CalcAutoRowHeight(0));
  13.     wb.WritetoFile('d:\test.xlsx', true);
  14.   finally
  15.     wb. Free;
  16.   end;
  17. end;
Mainly Lazarus trunk / fpc 3.2.0 / all 32-bit on Win-10, but many more...

totya

  • Hero Member
  • *****
  • Posts: 627
Re: Merged cell height calculation
« Reply #2 on: July 12, 2020, 05:11:56 pm »
Hi master!

Thanks for the detailed answer!

Sorry my English, with linebreak I mean the excel function name is (translated): line breaks into multiple lines. I need this, the cell text do not contain any linebreak. Modified code:

Code: Pascal  [Select][+][-]
  1. procedure TForm1.Button1Click(Sender: TObject);
  2. var
  3.   wb: TsWorkbook;
  4.   sh: TsWorksheet;
  5.   cell: PCell;
  6. begin
  7.   wb := TsWorkbook.Create;
  8.   try
  9.     sh := wb.AddWorksheet('Test');
  10.     cell := sh.WriteText(0, 0,
  11.       'Long line without linebreak in the cell xyz xyz xyz' +
  12.       'ŐÚŰ xyz xyz xyz xyz xyz xyz ŐÚŰ xyz xyz' +
  13.       'xyz xyz xyz xyz xyz ŐÚŰ xyz xyz xyz xyz xyz ŐÚŰ xyz');
  14.     sh.WriteWordwrap(cell, True);
  15.     sh.MergeCells(0, 0, 0, 2);
  16.     sh.WriteRowHeight(0, sh.CalcAutoRowHeight(0));
  17.     wb.WritetoFile('test.xlsx', True);
  18.   finally
  19.     wb.Free;
  20.   end;
  21. end;

The result is perfect, see attached picture. Thank you!

Otherwise
Quote
This is exactly what Excel seems to be doing itself.
The Excel (2013) can't handle these merged cell, the MS Excel auto row height function doesn't work with these cells... so, the fps is better than MS Excel... :)

ps.: I got
Quote
unit1.pas(48,50) Warning: Symbol "WriteRowHeight" is deprecated: "Use version with parameter AUnits"
message for the WriteRowHeight... but works...

wp

  • Hero Member
  • *****
  • Posts: 7356
Re: Merged cell height calculation [ANSWERED]
« Reply #3 on: July 12, 2020, 07:44:13 pm »
Sorry about the "deprecated" - there is still a lot with the old Microsoft length units (characters and lines) in the library... You can avoid the "deprecated" by using one of the following lines:

Code: Pascal  [Select][+][-]
  1. sh.WriteRowHeight(0, sh.CalcAutoRowHeight(0), wb.Units, rhtAuto);
  2. // or
  3. sh.WriteRowHeight(0, sh.CalcRowHeight(0), wb.Units, rhtAuto);

The second line is a bit more general than the first one because it also takes care of lines having a fixed height.
Mainly Lazarus trunk / fpc 3.2.0 / all 32-bit on Win-10, but many more...

totya

  • Hero Member
  • *****
  • Posts: 627
Re: Merged cell height calculation [ANSWERED]
« Reply #4 on: July 12, 2020, 08:14:14 pm »
Thank for this code, but doesn't work none of them. Only this produce good result:
Code: Pascal  [Select][+][-]
  1. sh.WriteRowHeight(0, sh.CalcAutoRowHeight(0));

Edit.: ... and I say again: in Office 2013 it doesn't work too... :) Perhaps the new MS method wrong... (click to format/autorowheight).
« Last Edit: July 12, 2020, 08:30:15 pm by totya »

wp

  • Hero Member
  • *****
  • Posts: 7356
Re: Merged cell height calculation [ANSWERED]
« Reply #5 on: July 12, 2020, 11:44:25 pm »
I checked again. My code is correct, at least with Office 2016 and with OpenOffice Calc. I had developed this code with Excel2007 (which I do not have any more), but it definitely was correctly working here, too.

In contrast to what I posted previously, "sh.WriteRowHeight(0, CalcAutoRowHeight(0))" is not correct because WriteRowHeight expects the row height in lines, but CalcAutoRowHeight returns it in Workbook.Units, i.e. millimeters. That it was working in my first test must have been a matter of coincidence.

Here is an extended version with easily changeable line count in the cell and with modifiable font size:
Code: Pascal  [Select][+][-]
  1. procedure TForm1.Button1Click(Sender: TObject);
  2. var
  3.   wb: TsWorkbook;
  4.   sh: TsWorksheet;
  5.   cell: PCell;
  6.   s: String;
  7.   i: Integer;
  8. begin
  9.   wb := TsWorkbook.Create;
  10.   try
  11.     sh := wb.AddWorksheet('Test');
  12.     s := 'Line 1';
  13.     for i := 2 to 10 do
  14.       s := s + LineEnding + ' Line' + IntToStr(i);
  15.     cell := sh.WriteText(0, 0, s);
  16.     sh.WriteWordwrap(cell, true);
  17.  
  18.     // Change font height
  19.     sh.WriteFont(cell, 'Calibri', 16, [], scBlack);
  20.  
  21.     // Select one of these cases:
  22.  
  23.     // This is wrong...
  24. //    sh.WriteRowHeight(0, sh.CalcAutoRowHeight(0));
  25.  
  26.     // This is correct (each one):
  27. //    sh.WriteRowHeight(0, sh.CalcAutoRowHeight(0), wb.Units, rhtAuto);
  28.     sh.WriteRowHeight(0, sh.CalcRowHeight(0), wb.Units, rhtAuto);
  29.  
  30.     wb.WritetoFile('d:\test.xlsx', true);
  31.     wb.WriteToFile('d:\test.ods', true);
  32.   finally
  33.     wb. Free;
  34.   end;
  35. end;
Mainly Lazarus trunk / fpc 3.2.0 / all 32-bit on Win-10, but many more...

totya

  • Hero Member
  • *****
  • Posts: 627
Re: Merged cell height calculation [ANSWERED]
« Reply #6 on: July 13, 2020, 06:30:41 am »
Hi wp master :)

As I said, the new two code lines doesn't work, that's simple. I open (check) created excel file in the Office 2013.

Now I see in the Libre Office v6.2.4.2. Well, the new methods are both wrong too. The old methods slightly better, but not perfect here, see attachment.

Again, I tested this situation with this code with latest svn fps:

Code: Pascal  [Select][+][-]
  1. procedure TForm1.Button1Click(Sender: TObject);
  2. var
  3.   wb: TsWorkbook;
  4.   sh: TsWorksheet;
  5.   cell: PCell;
  6. begin
  7.   wb := TsWorkbook.Create;
  8.   try
  9.     sh := wb.AddWorksheet('Test');
  10.     cell := sh.WriteText(0, 0,
  11.       'Long line without linebreak in the cell xyz xyz xyz' +
  12.       'ŐÚŰ xyz xyz xyz xyz xyz xyz ŐÚŰ xyz xyz' +
  13.       'xyz xyz xyz xyz xyz ŐÚŰ xyz xyz xyz xyz xyz ŐÚŰ xyz');
  14.     sh.WriteWordwrap(cell, True);
  15.     sh.MergeCells(0, 0, 0, 2);
  16.  
  17.     // Old worikng method...
  18.     sh.WriteRowHeight(0, sh.CalcAutoRowHeight(0));
  19.  
  20.     // New unworkable methods...
  21.     //sh.WriteRowHeight(0, sh.CalcAutoRowHeight(0), wb.Units, rhtAuto);
  22.     //sh.WriteRowHeight(0, sh.CalcRowHeight(0), wb.Units, rhtAuto);
  23.  
  24.     wb.WritetoFile('test.xlsx', True);
  25.   finally
  26.     wb.Free;
  27.   end;
  28. end;


totya

  • Hero Member
  • *****
  • Posts: 627
Re: Merged cell height calculation [ANSWERED]
« Reply #7 on: July 13, 2020, 11:17:29 am »
I tested it with MS Office 2010 too... but the result same as with the MS Office 2013. "Old" method produce good output, but the two new methods doesn't work. Thank you!

wp

  • Hero Member
  • *****
  • Posts: 7356
Re: Merged cell height calculation [ANSWERED]
« Reply #8 on: July 13, 2020, 11:48:36 am »
Sorry I missed that your cell text does not contain linebreaks (yes, you said that...) and thus fpspreadsheet must find the break positions. But I fear this is not possible because it does not know the font metrics.

Your favoured "old working method" (sh.WriteRowHeight(0, sh.CalcAutoRowHeight(0)) is not working, too - it just looks like... Add a '123' to the cell string, and run the modified program. When open the saved xlsx file in Exel you will see a wrapped block, but you will not see the '123' at the end, i.e. the height of the row is too small. A similar effect with ods and Calc.

Let me investigate how Excel/Calc are doing this.
Mainly Lazarus trunk / fpc 3.2.0 / all 32-bit on Win-10, but many more...

wp

  • Hero Member
  • *****
  • Posts: 7356
Re: Merged cell height calculation [ANSWERED]
« Reply #9 on: July 13, 2020, 11:42:57 pm »
Here is a usable solution, not very elegant, though.

The problem is that you merge cells, want to wrap the long text inside the merged cells and adjust the row height such that the text fits into the merged block vertically. I was astonished that Excel 2016 is not able to solve this task. Calc is able to, and fpspreadsheet, of course, as well.

It is not simple, though, because the basic spreadsheet library does not know the character size of the fonts and thus cannot wrap the lines at the word boundaries. The TsWorksheetGrid, however, is an LCL-based control and does know the font metrics. Therefore you can use an auxiliary, hidden worksheetgrid and let it do the work:

Code: Pascal  [Select][+][-]
  1. procedure TForm1.Button1Click(Sender: TObject);
  2. const
  3.   s = 'Long line without linebreak in the cell xyz xyz xyz' +
  4.       'ŐÚŰ xyz xyz xyz xyz xyz xyz ŐÚŰ xyz xyz' +
  5.       'xyz xyz xyz xyz xyz ŐÚŰ xyz xyz xyz xyz xyz ŐÚŰ xyz 123';
  6. var
  7.   wb: TsWorkbook;
  8.   sh: TsWorksheet;
  9.   cell: PCell;
  10.   h: Single;
  11.   grid: TsWorksheetGrid;
  12.   r: Integer;
  13. begin
  14.   wb := TsWorkbook.Create;
  15.  
  16.   sh := wb.AddWorksheet('Test');
  17.   cell := sh.WriteText(0, 0, s);
  18.   sh.WriteWordwrap(cell, True);
  19.   sh.MergeCells(0, 0, 0, 2);
  20.  
  21.   cell := sh.WriteText(5, 0, s);
  22.   sh.WriteWordWrap(cell, true);
  23.  
  24.   grid := TsWorksheetGrid.Create(self);
  25.   try
  26.     grid.Visible := false;
  27.     grid.Parent := self;
  28.     grid.LoadfromWorkbook(wb);
  29.  
  30.     // calc auto-row height of row 0
  31.     r := grid.GetGridRow(0);
  32.     grid.AutoRowHeight(r);
  33.     h := pxToPts(grid.RowHeights[r], Screen.PixelsPerInch);
  34.     sh.WriteRowHeight(0, h, suPoints, rhtCustom);
  35.  
  36.     // calc auto-row height of row 4
  37.     r := grid.GetGridRow(5);
  38.     grid.AutoRowHeight(r);
  39.     h := pxToPts(grid.RowHeights[r], Screen.PixelsPerInch);
  40.     sh.WriteRowHeight(5, h, suPoints, rhtCustom);
  41.  
  42.     wb.WritetoFile('test.xlsx', True);
  43.     wb.WritetoFile('test.ods', True);
  44.   finally
  45.     grid.Free;
  46.   end;
  47.  
  48.   // DO NOT FREE THE WORKBOOK (wb) - it was destroyed by the grid
  49. end;  

There are still problems left, however: The way Excel calculates the row height is not documented, there are some mysterious margins which I do not understand quantitatively. Therefore it might occur that the cell is too tight for the wrapped text. I'd recommend to increase the AutoRowHeight value (h, in the example) by some value.
Mainly Lazarus trunk / fpc 3.2.0 / all 32-bit on Win-10, but many more...

totya

  • Hero Member
  • *****
  • Posts: 627
Re: Merged cell height calculation [ANSWERED]
« Reply #10 on: July 14, 2020, 03:29:03 pm »
Thank you master, but it slightly overcomplicated, working partially, and hard to use from own class (for me).

In old times I calculate textwidth/height from text and font, but I can't remember how can I do it. :)

Can I get the merged cells width easily (without I add merged cells column width one by one)?

Thank you fro this huge component! This problem doesn't matter really, and the Excel myself too can't do it...

totya

  • Hero Member
  • *****
  • Posts: 627
Re: Merged cell height calculation [ANSWERED]
« Reply #11 on: July 14, 2020, 08:45:31 pm »
Hi Master!

Quick, dirty, but works with all merged cells, and no except!

Code: Pascal  [Select][+][-]
  1. function TsWorksheetHelper.myGetColsWidthPixel(
  2.   const AFirstCol, ALastCol: cardinal): integer;
  3. var
  4.   i: integer;
  5. begin
  6.   Result := 0;
  7.  
  8.   for i := AFirstCol to ALastCol do
  9.     Result := Result + Round(GetColWidth(i, suPoints));
  10. end;
  11.  
  12. function TsWorksheetHelper.myCalcTextWidthPixel(const AText: string;
  13.   const AFontName: string; const AFontSize: integer;
  14.   const AFontStyle: TsFontStyles): integer;
  15. var
  16.   bmp: TBitmap;
  17.   FS: TsFontStyle;
  18. begin
  19.   Result := 0;
  20.  
  21.   bmp := TBitmap.Create;
  22.   try
  23.     bmp.Canvas.Font.Name := AFontName;
  24.     bmp.Canvas.Font.Size := AFontSize;
  25.     bmp.Canvas.Font.Style := [];
  26.  
  27.     with bmp.Canvas.Font do
  28.       for FS := Low(AFontStyle) to High(AFontStyle) do
  29.         case FS of
  30.           fssBold: Style := Style + [fsBold];
  31.           fssItalic: Style := Style + [fsItalic];
  32.           fssUnderline: Style := Style + [fsUnderline];
  33.         end;
  34.  
  35.     Result := bmp.Canvas.TextWidth(AText);
  36.   finally
  37.     bmp.Free;
  38.   end;
  39. end;
  40.  
  41. function TsWorksheetHelper.myCalcTextHeightPixel(const AText: string;
  42.   const AFontName: string; const AFontSize: integer;
  43.   const AFontStyle: TsFontStyles): integer;
  44. var
  45.   bmp: TBitmap;
  46.   FS: TsFontStyle;
  47. begin
  48.   Result := 0;
  49.  
  50.   bmp := TBitmap.Create;
  51.   try
  52.     bmp.Canvas.Font.Name := AFontName;
  53.     bmp.Canvas.Font.Size := AFontSize;
  54.     bmp.Canvas.Font.Style := [];
  55.  
  56.     with bmp.Canvas.Font do
  57.       for FS := Low(AFontStyle) to High(AFontStyle) do
  58.         case FS of
  59.           fssBold: Style := Style + [fsBold];
  60.           fssItalic: Style := Style + [fsItalic];
  61.           fssUnderline: Style := Style + [fsUnderline];
  62.         end;
  63.  
  64.     Result := bmp.Canvas.TextHeight(AText);
  65.   finally
  66.     bmp.Free;
  67.   end;
  68. end;
  69.  
  70. procedure TsWorksheetHelper.myWriteAutoRowHeight(const ARow: cardinal;
  71.   const AFirstCol, ALastCol: cardinal; const AFontName: string;
  72.   const AFontSize: integer; const AFontStyle: TsFontStyles);
  73. var
  74.   MergedColsWidthPixel: integer;
  75.   TextWidthPixel, TextHeightPixel: integer;
  76. begin
  77.   MergedColsWidthPixel := myGetColsWidthPixel(AFirstCol, ALastCol);
  78.  
  79.   TextWidthPixel := myCalcTextWidthPixel(ReadAsText(ARow, AFirstCol),
  80.     AFontName, AFontSize, AFontStyle);
  81.  
  82.   TextHeightPixel := myCalcTextHeightPixel(ReadAsText(ARow, AFirstCol),
  83.     AFontName, AFontSize, AFontStyle);
  84.  
  85.   if TextWidthPixel < MergedColsWidthPixel then
  86.     WriteRowHeight(ARow, TextHeightPixel + (TextHeightPixel div 2), suPoints)
  87.   else
  88.     WriteRowHeight(ARow, Trunc(((TextWidthPixel / MergedColsWidthPixel) + 1) *
  89.       TextHeightPixel), suPoints);
  90. end;

Code: Pascal  [Select][+][-]
  1. + (TextHeightPixel div 2)
only looks good like... but not needed.

wp

  • Hero Member
  • *****
  • Posts: 7356
Re: Merged cell height calculation [ANSWERED]
« Reply #12 on: July 14, 2020, 10:14:49 pm »
Good that you found a solution for yourself. Just let me give you a hint on already existing code in unit fpsVisualUtils (in the laz_fpspreadsheet_visual package) doing the same but in a more general way:

Code: Pascal  [Select][+][-]
  1. function RichTextWidth(ACanvas: TCanvas; AWorkbook: TsWorkbook; ARect: TRect;
  2.   const AText: String; ARichTextParams: TsRichTextParams; AFontIndex: Integer;
  3.   ATextRotation: TsTextRotation; AWordWrap, ARightToLeft: Boolean;
  4.   AZoomFactor: Double): Integer;
  5.  
  6. function RichTextHeight(ACanvas: TCanvas; AWorkbook: TsWorkbook; ARect: TRect;
  7.   const AText: String; ARichTextParams: TsRichTextParams; AFontIndex: Integer;
  8.   ATextRotation: TsTextRotation; AWordWrap, ARightToLeft: Boolean;
  9.   AZoomFactor: Double): Integer;

These routines (used by the grid's AutoRowHeight) also take care of
- individually formatted characters within each cell ("rich text")
- rotated text (vertical painting direction)
- zoomed text (worksheet's ZoomFactor <> 1)

"AText" is the cell text to be measured, ARichTextParams an array of parameters for individual character fonts (set to nil if not needed). "ARect" is the rectangle within the text should fit (assumung WordWrap). The other arguments are self-explanatory. The function result is in pixels.
Mainly Lazarus trunk / fpc 3.2.0 / all 32-bit on Win-10, but many more...

totya

  • Hero Member
  • *****
  • Posts: 627
Re: Merged cell height calculation [ANSWERED]
« Reply #13 on: July 15, 2020, 01:08:15 pm »
Thanks for the answer wp master, I will look your code later!

 

TinyPortal © 2005-2018