From 33a8fdcb430248b66ad2c4b01561d41c6708438a Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Sat, 31 May 2014 21:04:53 +0000 Subject: [PATCH] fpspreadsheet: Row height and column width reading/writing code for ods files complete. Test cases ok, but extremely slow speed of test application for numbertest and datetimetests. Changed units of row heights in worksheet: used to be points, is "lines" now (more consistent user interface - column width is in "standard characters", I prefer these units over centimeters because row heights/column widths become independent of screen pixels per inch this way) git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3118 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../examples/excel2demo/excel2write.lpr | 10 +- .../examples/excel5demo/excel5write.lpr | 2 +- .../examples/excel8demo/excel8write.lpr | 2 +- .../examples/opendocdemo/opendocwrite.lpr | 1 + components/fpspreadsheet/fpsopendocument.pas | 838 ++++++++++++++---- components/fpspreadsheet/fpspreadsheet.pas | 124 ++- .../fpspreadsheet/fpspreadsheetgrid.pas | 15 +- components/fpspreadsheet/fpsutils.pas | 98 +- .../fpspreadsheet/tests/formattests.pas | 38 +- components/fpspreadsheet/xlsbiff2.pas | 18 +- components/fpspreadsheet/xlscommon.pas | 24 +- 11 files changed, 952 insertions(+), 218 deletions(-) diff --git a/components/fpspreadsheet/examples/excel2demo/excel2write.lpr b/components/fpspreadsheet/examples/excel2demo/excel2write.lpr index 3d967880a..16c40cded 100644 --- a/components/fpspreadsheet/examples/excel2demo/excel2write.lpr +++ b/components/fpspreadsheet/examples/excel2demo/excel2write.lpr @@ -33,7 +33,7 @@ begin //MyWorksheet.WriteColWidth(0, 5); //MyWorksheet.WriteColWidth(1, 30); - MyWorksheet.WriteRowHeight(0, 30); // 30 mm + MyWorksheet.WriteRowHeight(0, 3); // 3 lines // Turn off grid lines and hide headers //MyWorksheet.Options := MyWorksheet.Options - [soShowGridLines, soShowHeaders]; @@ -367,16 +367,16 @@ begin inc(r); // Set width of columns 0 to 3 - MyWorksheet.WriteColWidth(0, 50); - lCol.Width := 15; + MyWorksheet.WriteColWidth(0, 48); // 48 characters, default is 12 --> 4x default width + lCol.Width := 24; // 24 characters, default is 12 --> 2x default width MyWorksheet.WriteColInfo(1, lCol); MyWorksheet.WriteColInfo(2, lCol); MyWorksheet.WriteColInfo(3, lCol); // Set height of rows 5 and 6 - lRow.Height := 10; + lRow.Height := 4; // 4 lines MyWorksheet.WriteRowInfo(5, lRow); - lRow.Height := 5; + lRow.Height := 2; // 2 lines MyWorksheet.WriteRowInfo(6, lRow); // Save the spreadsheet to a file diff --git a/components/fpspreadsheet/examples/excel5demo/excel5write.lpr b/components/fpspreadsheet/examples/excel5demo/excel5write.lpr index c4db79c3b..7b83e2b9f 100644 --- a/components/fpspreadsheet/examples/excel5demo/excel5write.lpr +++ b/components/fpspreadsheet/examples/excel5demo/excel5write.lpr @@ -45,7 +45,7 @@ begin MyWorkbook.AddFont('Calibri', 20, [], scRed); // Change row height - MyWorksheet.WriteRowHeight(0, 20); // modify height of row 0 to 20 mm + MyWorksheet.WriteRowHeight(0, 1.1); // modify height of row 0 to 3 lines // Change colum widths MyWorksheet.WriteColWidth(0, 40); diff --git a/components/fpspreadsheet/examples/excel8demo/excel8write.lpr b/components/fpspreadsheet/examples/excel8demo/excel8write.lpr index a02252bc4..d8668c4b4 100644 --- a/components/fpspreadsheet/examples/excel8demo/excel8write.lpr +++ b/components/fpspreadsheet/examples/excel8demo/excel8write.lpr @@ -383,7 +383,7 @@ begin MyWorksheet.WriteColInfo(5, lCol); // Set height of rows 0 - MyWorksheet.WriteRowHeight(0, 30); // 30 mm + MyWorksheet.WriteRowHeight(0, 5); // 5 lines // Creates a new worksheet MyWorksheet := MyWorkbook.AddWorksheet(Str_Worksheet2); diff --git a/components/fpspreadsheet/examples/opendocdemo/opendocwrite.lpr b/components/fpspreadsheet/examples/opendocdemo/opendocwrite.lpr index 23885550b..5a3d120d4 100644 --- a/components/fpspreadsheet/examples/opendocdemo/opendocwrite.lpr +++ b/components/fpspreadsheet/examples/opendocdemo/opendocwrite.lpr @@ -32,6 +32,7 @@ begin MyWorksheet.WriteUTF8Text(4, 2, 'Total:');// C5 MyWorksheet.WriteNumber(4, 3, 10); // D5 MyWorksheet.WriteDateTime(5, 0, now); + // Add some formatting MyWorksheet.WriteUsedFormatting(0, 0, [uffBold]); diff --git a/components/fpspreadsheet/fpsopendocument.pas b/components/fpspreadsheet/fpsopendocument.pas index 9d58f83ad..6eca158ae 100755 --- a/components/fpspreadsheet/fpsopendocument.pas +++ b/components/fpspreadsheet/fpsopendocument.pas @@ -61,7 +61,11 @@ type FCellStyleList: TFPList; FColumnStyleList: TFPList; FColumnList: TFPList; + FRowStyleList: TFPList; + FRowList: TFPList; FDateMode: TDateMode; + // Applies internally stored column widths to current worksheet + procedure ApplyColWidths; // Applies a style to a cell procedure ApplyStyleToCell(ARow, ACol: Cardinal; AStyleName: String); // Searches a style by its name in the StyleList @@ -69,13 +73,16 @@ type // Searches a column style by its column index or its name in the StyleList function FindColumnByCol(AColIndex: Integer): Integer; function FindColStyleByName(AStyleName: String): integer; + function FindRowStyleByName(AStyleName: String): Integer; // Gets value for the specified attribute. Returns empty string if attribute // not found. function GetAttrValue(ANode : TDOMNode; AAttrName : string) : string; - procedure ReadCells(ATableNode: TDOMNode); procedure ReadColumns(ATableNode: TDOMNode); + procedure ReadColumnStyle(AStyleNode: TDOMNode); // Figures out the base year for times in this file (dates are unambiguous) procedure ReadDateMode(SpreadSheetNode: TDOMNode); + procedure ReadRowsAndCells(ATableNode: TDOMNode); + procedure ReadRowStyle(AStyleNode: TDOMNode); protected procedure CreateNumFormatList; override; procedure ReadNumFormats(AStylesNode: TDOMNode); @@ -97,22 +104,36 @@ type TsSpreadOpenDocWriter = class(TsCustomSpreadWriter) private + FColumnStyleList: TFPList; + FRowStyleList: TFPList; + + // Routines to write parts of files + function WriteCellStylesXMLAsString: string; + function WriteColStylesXMLAsString: String; + function WriteRowStylesXMLAsString: String; + + function WriteColumnsXMLAsString(ASheet: TsWorksheet): String; + function WriteRowsAndCellsXMLAsString(ASheet: TsWorksheet): String; + function WriteBackgroundColorStyleXMLAsString(const AFormat: TCell): String; function WriteBorderStyleXMLAsString(const AFormat: TCell): String; function WriteHorAlignmentStyleXMLAsString(const AFormat: TCell): String; function WriteTextRotationStyleXMLAsString(const AFormat: TCell): String; function WriteVertAlignmentStyleXMLAsString(const AFormat: TCell): String; function WriteWordwrapStyleXMLAsString(const AFormat: TCell): String; + protected FPointSeparatorSettings: TFormatSettings; // Strings with the contents of files - FMeta, FSettings, FStyles, FContent, FMimetype: string; + FMeta, FSettings, FStyles, FContent, FCellContent, FMimetype: string; FMetaInfManifest: string; // Streams with the contents of files FSMeta, FSSettings, FSStyles, FSContent, FSMimetype: TStringStream; FSMetaInfManifest: TStringStream; // Helpers procedure CreateNumFormatList; override; + procedure ListAllColumnStyles; + procedure ListAllRowStyles; // Routines to write those files procedure WriteMimetype; procedure WriteMetaInfManifest; @@ -121,8 +142,6 @@ type procedure WriteStyles; procedure WriteContent; procedure WriteWorksheet(CurSheet: TsWorksheet); - // Routines to write parts of those files - function WriteStylesXMLAsString: string; { Record writing methods } procedure WriteBlank(AStream: TStream; const ARow, ACol: Cardinal; ACell: PCell); override; @@ -136,6 +155,7 @@ type const AValue: TDateTime; ACell: PCell); override; public constructor Create(AWorkbook: TsWorkbook); override; + destructor Destroy; override; { General writing methods } procedure WriteStringToFile(AString, AFileName: string); procedure WriteToFile(const AFileName: string; @@ -202,6 +222,9 @@ const BORDER_LINEWIDTHS: array[TsLinestyle] of string = ('0.002cm', '2pt', '0.002cm', '0.002cm', '3pt', '0.039cm', '0.002cm'); + COLWIDTH_EPS = 1e-2; // for mm + ROWHEIGHT_EPS = 1e-2; // for lines + type { Cell style items relevant to FPSpreadsheet. Stored in the CellStyleList of the reader. } TCellStyleData = class @@ -222,10 +245,10 @@ type TColumnStyleData = class public Name: String; - ColWidth: Double; + ColWidth: Double; // in mm end; - { Column data items stored in the ColList of the reader } + { Column data items stored in the ColumnList } TColumnData = class public Col: Integer; @@ -233,6 +256,21 @@ type DefaultCellStyleIndex: Integer; // Index of default cell style in FCellStyleList of reader end; + { Row style items stored in RowStyleList of the reader } + TRowStyleData = class + public + Name: String; + RowHeight: Double; // in mm + AutoRowHeight: Boolean; + end; + + { Row data items stored in the RowList of the reader } + TRowData = class + Row: Integer; + RowStyleIndex: Integer; // index into FRowStyleList of reader + DefaultCellStyleIndex: Integer; // Index of default row style in FCellStyleList of reader + end; + { TsSpreadOpenDocNumFormatList } @@ -250,6 +288,8 @@ begin FCellStyleList := TFPList.Create; FColumnStyleList := TFPList.Create; FColumnList := TFPList.Create; + FRowStyleList := TFPList.Create; + FRowList := TFPList.Create; // Set up the default palette in order to have the default color names correct. Workbook.UseDefaultPalette; // Initial base date in case it won't be read from file @@ -266,12 +306,49 @@ begin for j := FColumnStyleList.Count-1 downto 0 do TObject(FColumnStyleList[j]).Free; FColumnStyleList.Free; + for j := FRowList.Count-1 downto 0 do TObject(FRowList[j]).Free; + FRowList.Free; + + for j := FRowStyleList.Count-1 downto 0 do TObject(FRowStyleList[j]).Free; + FRowStyleList.Free; + for j := FCellStyleList.Count-1 downto 0 do TObject(FCellStyleList[j]).Free; FCellStyleList.Free; inherited Destroy; end; +{ Creates for each non-default column width stored internally in FColumnList + a TCol record in the current worksheet. } +procedure TsSpreadOpenDocReader.ApplyColWidths; +var + colIndex: Integer; + colWidth: Single; + colStyleIndex: Integer; + colStyle: TColumnStyleData; + factor: Double; + col: PCol; + i: Integer; +begin + factor := FWorkbook.GetFont(0).Size/2; + for i:=0 to FColumnList.Count-1 do begin + colIndex := TColumnData(FColumnList[i]).Col; + colStyleIndex := TColumnData(FColumnList[i]).ColStyleIndex; + colStyle := TColumnStyleData(FColumnStyleList[colStyleIndex]); + { The column width stored in colStyle is in mm (see ReadColumnStyles). + We convert it to character count by converting it to points and then by + dividing the points by the approximate width of the '0' character which + is assumed to be 50% of the default font point size. } + colWidth := mmToPts(colStyle.ColWidth)/factor; + { Add only column records to the worksheet if their width is different from + the default column width. } + if not SameValue(colWidth, Workbook.DefaultColWidth, COLWIDTH_EPS) then begin + col := FWorksheet.GetCol(colIndex); + col^.Width := colWidth; + end; + end; +end; + { Applies the style data referred to by the style name to the specified cell } procedure TsSpreadOpenDocReader.ApplyStyleToCell(ARow, ACol: Cardinal; AStyleName: String); @@ -313,20 +390,19 @@ begin cell^.FontIndex := styleData.FontIndex; } - // Alignment - cell^.HorAlignment := styleData.HorAlignment; - cell^.VertAlignment := styleData.VertAlignment; - // Word wrap + // Word wrap if styleData.WordWrap then Include(cell^.UsedFormattingFields, uffWordWrap) else Exclude(cell^.UsedFormattingFields, uffWordWrap); - // Text rotation + + // Text rotation if styleData.TextRotation > trHorizontal then Include(cell^.UsedFormattingFields, uffTextRotation) else Exclude(cell^.UsedFormattingFields, uffTextRotation); cell^.TextRotation := styledata.TextRotation; + // Text alignment if styleData.HorAlignment <> haDefault then begin Include(cell^.UsedFormattingFields, uffHorAlign); @@ -338,6 +414,7 @@ begin cell^.VertAlignment := styleData.VertAlignment; end else Exclude(cell^.UsedFormattingFields, uffVertAlign); + // Borders cell^.BorderStyles := styleData.BorderStyles; if styleData.Borders <> [] then begin @@ -345,6 +422,7 @@ begin cell^.Border := styleData.Borders; end else Exclude(cell^.UsedFormattingFields, uffBorder); + // Background color if styleData.BackgroundColor <> scNotDefined then begin Include(cell^.UsedFormattingFields, uffBackgroundColor); @@ -398,6 +476,14 @@ begin Result := -1; end; +function TsSpreadOpenDocReader.FindRowStyleByName(AStyleName: String): Integer; +begin + for Result := 0 to FRowStyleList.Count-1 do + if TRowStyleData(FRowStyleList[Result]).Name = AStyleName then + exit; + Result := -1; +end; + function TsSpreadOpenDocReader.GetAttrValue(ANode : TDOMNode; AAttrName : string) : string; var i : integer; @@ -425,55 +511,6 @@ begin ApplyStyleToCell(ARow, ACol, stylename); end; -{ Reads the cells in the given table. Loops through all rows, and then finds all - cells of each row. } -procedure TsSpreadOpenDocReader.ReadCells(ATableNode: TDOMNode); -var - row: Integer; - col: Integer; - cellNode, rowNode: TDOMNode; - paramValueType, paramFormula, tableStyleName: String; - paramColsRepeated, paramRowsRepeated: String; -begin - row := 0; - rowNode := ATableNode.FindNode('table:table-row'); - while Assigned(rowNode) do begin - col := 0; - - //process each cell of the row - cellNode := rowNode.FindNode('table:table-cell'); - while Assigned(cellNode) do begin - // select this cell value's type - paramValueType := GetAttrValue(CellNode, 'office:value-type'); - paramFormula := GetAttrValue(CellNode, 'table:formula'); - tableStyleName := GetAttrValue(CellNode, 'table:style-name'); - - if paramValueType = 'string' then - ReadLabel(row, col, cellNode) - else if (paramValueType = 'float') or (paramValueType = 'percentage') then - ReadNumber(row, col, cellNode) - else if (paramValueType = 'date') or (paramValueType = 'time') then - ReadDate(row, col, cellNode) - else if (paramValueType = '') and (tableStyleName <> '') then - ReadBlank(row, col, cellNode) - else if ParamFormula <> '' then - ReadLabel(row, col, cellNode); - - paramColsRepeated := GetAttrValue(cellNode, 'table:number-columns-repeated'); - if paramColsRepeated = '' then paramColsRepeated := '1'; - col := col + StrToInt(paramColsRepeated); - - cellNode := cellNode.NextSibling; - end; //while Assigned(cellNode) - - paramRowsRepeated := GetAttrValue(RowNode, 'table:number-rows-repeated'); - if paramRowsRepeated = '' then paramRowsRepeated := '1'; - row := row + StrToInt(paramRowsRepeated); - - rowNode := rowNode.NextSibling; - end; // while Assigned(rowNode) -end; - { Collection columns used in the given table. The columns contain links to styles that must be used when cells in that columns are without styles. } procedure TsSpreadOpenDocReader.ReadColumns(ATableNode: TDOMNode); @@ -481,10 +518,17 @@ var col: Integer; colNode: TDOMNode; s: String; + defCellStyleIndex: Integer; colStyleIndex: Integer; colStyleData: TColumnStyleData; colData: TColumnData; + colsRepeated: Integer; + j: Integer; begin + // clear previous column list (from other sheets) + for j:=FColumnList.Count-1 downto 0 do TObject(FColumnList[j]).Free; + FColumnList.Clear; + col := 0; colNode := ATableNode.FindNode('table:table-column'); while Assigned(colNode) do begin @@ -492,26 +536,68 @@ begin s := GetAttrValue(colNode, 'table:style-name'); colStyleIndex := FindColStyleByName(s); if colStyleIndex <> -1 then begin + defCellStyleIndex := -1; colStyleData := TColumnStyleData(FColumnStyleList[colStyleIndex]); s := GetAttrValue(ColNode, 'table:default-cell-style-name'); if s <> '' then begin + defCellStyleIndex := FindCellStyleByName(s); colData := TColumnData.Create; colData.Col := col; colData.ColStyleIndex := colStyleIndex; - colData.DefaultCellStyleIndex := FindCellStyleByName(s); + colData.DefaultCellStyleIndex := defCellStyleIndex; FColumnList.Add(colData); end; + s := GetAttrValue(ColNode, 'table:number-columns-repeated'); + if s = '' then + inc(col) + else begin + colsRepeated := StrToInt(s); + if defCellStyleIndex > -1 then + for j:=1 to colsRepeated-1 do begin + colData := TColumnData.Create; + colData.Col := col + j; + colData.ColStyleIndex := colStyleIndex; + colData.DefaultCellStyleIndex := defCellStyleIndex; + FColumnList.Add(colData); + end; + inc(col, colsRepeated); + end; end; - s := GetAttrValue(ColNode, 'table:number-columns-repeated'); - if s = '' then - inc(col) - else - inc(col, StrToInt(s)); end; colNode := colNode.NextSibling; end; end; +{ Reads the column styles and stores them in the FColumnStyleList for later use } +procedure TsSpreadOpenDocReader.ReadColumnStyle(AStyleNode: TDOMNode); +var + colStyle: TColumnStyleData; + styleName: String; + styleChildNode: TDOMNode; + colWidth: double; + s: String; +begin + styleName := GetAttrValue(AStyleNode, 'style:name'); + styleChildNode := AStyleNode.FirstChild; + colWidth := -1; + + while Assigned(styleChildNode) do begin + if styleChildNode.NodeName = 'style:table-column-properties' then begin + s := GetAttrValue(styleChildNode, 'style:column-width'); + if s <> '' then begin + colWidth := PtsToMM(HTMLLengthStrToPts(s)); // convert to mm + break; + end; + end; + styleChildNode := styleChildNode.NextSibling; + end; + + colStyle := TColumnStyleData.Create; + colStyle.Name := styleName; + colStyle.ColWidth := colWidth; + FColumnStyleList.Add(colStyle); +end; + procedure TsSpreadOpenDocReader.ReadDateMode(SpreadSheetNode: TDOMNode); var CalcSettingsNode, NullDateNode: TDOMNode; @@ -592,7 +678,8 @@ begin // Collect column styles used ReadColumns(TableNode); // Process each row inside the sheet and process each cell of the row - ReadCells(TableNode); + ReadRowsAndCells(TableNode); + ApplyColWidths; // Continue with next table TableNode := TableNode.NextSibling; end; //while Assigned(TableNode) @@ -664,11 +751,12 @@ begin fmt.TimeSeparator:=':'; Value:=GetAttrValue(ACellNode,'office:date-value'); if Value<>'' then - begin + begin (* // confuses fpc! {$IFDEF FPSPREADDEBUG} end; writeln('Row (1based): ',ARow+1,'office:date-value: '+Value); - {$ENDIF} + {$ENDIF} *) + // Date or date/time string Value:=StringReplace(Value,'T',' ',[rfIgnoreCase,rfReplaceAll]); // Strip milliseconds? @@ -877,6 +965,117 @@ begin end; end; +{ Reads the cells in the given table. Loops through all rows, and then finds all + cells of each row. } +procedure TsSpreadOpenDocReader.ReadRowsAndCells(ATableNode: TDOMNode); +var + row: Integer; + col: Integer; + cellNode, rowNode: TDOMNode; + paramValueType, paramFormula, tableStyleName: String; + paramColsRepeated, paramRowsRepeated: String; + colsRepeated, rowsRepeated: Integer; + rowStyleName: String; + rowStyleIndex: Integer; + rowStyle: TRowStyleData; + rowHeight: Single; + autoRowHeight: Boolean; + i: Integer; + lRow: PRow; +begin + rowsRepeated := 0; + row := 0; + rowNode := ATableNode.FindNode('table:table-row'); + while Assigned(rowNode) do begin + // Read rowstyle + rowStyleName := GetAttrValue(rowNode, 'table:style-name'); + rowStyleIndex := FindRowStyleByName(rowStyleName); + rowStyle := TRowStyleData(FRowStyleList[rowStyleIndex]); + rowHeight := rowStyle.RowHeight; // in mm (see ReadRowStyles) + rowHeight := mmToPts(rowHeight) / Workbook.GetDefaultFontSize; + if rowHeight > ROW_HEIGHT_CORRECTION + then rowHeight := rowHeight - ROW_HEIGHT_CORRECTION // in "lines" + else rowHeight := 0; + autoRowHeight := rowStyle.AutoRowHeight; + + col := 0; + + //process each cell of the row + cellNode := rowNode.FindNode('table:table-cell'); + while Assigned(cellNode) do begin + // select this cell value's type + paramValueType := GetAttrValue(CellNode, 'office:value-type'); + paramFormula := GetAttrValue(CellNode, 'table:formula'); + tableStyleName := GetAttrValue(CellNode, 'table:style-name'); + + if paramValueType = 'string' then + ReadLabel(row, col, cellNode) + else if (paramValueType = 'float') or (paramValueType = 'percentage') then + ReadNumber(row, col, cellNode) + else if (paramValueType = 'date') or (paramValueType = 'time') then + ReadDate(row, col, cellNode) + else if (paramValueType = '') and (tableStyleName <> '') then + ReadBlank(row, col, cellNode) + else if ParamFormula <> '' then + ReadLabel(row, col, cellNode); + + paramColsRepeated := GetAttrValue(cellNode, 'table:number-columns-repeated'); + if paramColsRepeated = '' then paramColsRepeated := '1'; + col := col + StrToInt(paramColsRepeated); + + cellNode := cellNode.NextSibling; + end; //while Assigned(cellNode) + + paramRowsRepeated := GetAttrValue(RowNode, 'table:number-rows-repeated'); + if paramRowsRepeated = '' then + rowsRepeated := 1 + else + rowsRepeated := StrToInt(paramRowsRepeated); + + // Transfer non-default row heights to sheet's rows + if not autoRowHeight then + for i:=1 to rowsRepeated do + FWorksheet.WriteRowHeight(row + i - 1, rowHeight); + + row := row + rowsRepeated; + + rowNode := rowNode.NextSibling; + end; // while Assigned(rowNode) +end; + +procedure TsSpreadOpenDocReader.ReadRowStyle(AStyleNode: TDOMNode); +var + styleName: String; + styleChildNode: TDOMNode; + rowHeight: Double; + auto: Boolean; + s: String; + rowStyle: TRowStyleData; +begin + styleName := GetAttrValue(AStyleNode, 'style:name'); + styleChildNode := AStyleNode.FirstChild; + rowHeight := -1; + auto := false; + + while Assigned(styleChildNode) do begin + if styleChildNode.NodeName = 'style:table-row-properties' then begin + s := GetAttrValue(styleChildNode, 'style:row-height'); + if s <> '' then + rowHeight := PtsToMm(HTMLLengthStrToPts(s)); // convert to mm + s := GetAttrValue(styleChildNode, 'style:use-optimal-row-height'); + if s = 'true' then + auto := true; + end; + styleChildNode := styleChildNode.NextSibling; + end; + + rowStyle := TRowStyleData.Create; + rowStyle.Name := styleName; + rowStyle.RowHeight := rowHeight; + rowStyle.AutoRowHeight := auto; + FRowStyleList.Add(rowStyle); +end; + procedure TsSpreadOpenDocReader.ReadStyles(AStylesNode: TDOMNode); var fs: TFormatSettings; @@ -983,26 +1182,12 @@ begin family := GetAttrValue(styleNode, 'style:family'); // Column styles - if family = 'table-column' then begin - styleName := GetAttrValue(styleNode, 'style:name'); - styleChildNode := styleNode.FirstChild; - colWidth := -1; - while Assigned(styleChildNode) do begin - if styleChildNode.NodeName = 'style:table-column-properties' then begin - s := GetAttrValue(styleChildNode, 'style:column-width'); - if s <> '' then begin - s := Copy(s, 1, Length(s)-2); // TO DO: use correct units! - colWidth := StrToFloat(s, fs); - break; - end; - end; - styleChildNode := styleChildNode.NextSibling; - end; - colStyle := TColumnStyleData.Create; - colStyle.Name := styleName; - colStyle.ColWidth := colWidth; - FColumnStyleList.Add(colStyle); - end; + if family = 'table-column' then + ReadColumnStyle(styleNode); + + // Row styles + if family = 'table-row' then + ReadRowStyle(styleNode); // Cell styles if family = 'table-cell' then begin @@ -1122,6 +1307,108 @@ begin FNumFormatList := TsSpreadOpenDocNumFormatList.Create(Workbook); end; +procedure TsSpreadOpenDocWriter.ListAllColumnStyles; +var + i, j, c: Integer; + sheet: TsWorksheet; + found: Boolean; + colstyle: TColumnStyleData; + w: Double; + multiplier: Double; +begin + { At first, add the default column width } + colStyle := TColumnStyleData.Create; + colStyle.Name := 'co1'; + colStyle.ColWidth := Workbook.DefaultColWidth; + FColumnStyleList.Add(colStyle); + + for i:=0 to Workbook.GetWorksheetCount-1 do begin + sheet := Workbook.GetWorksheetByIndex(i); + for c:=0 to sheet.GetLastColIndex do begin + w := sheet.GetColWidth(c); + // Look for this width in the current ColumnStyleList + found := false; + for j := 0 to FColumnStyleList.Count-1 do + if SameValue(TColumnStyleData(FColumnStyleList[j]).ColWidth, w, COLWIDTH_EPS) + then begin + found := true; + break; + end; + // Not found? Then add the column as new column style + if not found then begin + colStyle := TColumnStyleData.Create; + colStyle.Name := Format('co%d', [FColumnStyleList.Count+1]); + colStyle.ColWidth := w; + FColumnStyleList.Add(colStyle); + end; + end; + end; + + { fpspreadsheet's column width is the count of '0' characters of the + default font. On average, the width of the '0' is about half of the + point size of the font. --> we can convert the fps col width to pts and + then to millimeters. } + multiplier := Workbook.GetFont(0).Size / 2; + for i:=0 to FColumnStyleList.Count-1 do begin + w := TColumnStyleData(FColumnStyleList[i]).ColWidth * multiplier; + TColumnStyleData(FColumnStyleList[i]).ColWidth := PtsToMM(w); + end; +end; + +procedure TsSpreadOpenDocWriter.ListAllRowStyles; +var + i, j, r: Integer; + sheet: TsWorksheet; + row: PRow; + found: Boolean; + rowstyle: TRowStyleData; + h, multiplier: Double; +begin + { At first, add the default row height } + { Initially, row height units will be the same as in the sheet, i.e. in "lines" } + rowStyle := TRowStyleData.Create; + rowStyle.Name := 'ro1'; + rowStyle.RowHeight := Workbook.DefaultRowHeight; + rowStyle.AutoRowHeight := true; + FRowStyleList.Add(rowStyle); + + for i:=0 to Workbook.GetWorksheetCount-1 do begin + sheet := Workbook.GetWorksheetByIndex(i); + for r:=0 to sheet.GetLastRowIndex do begin + row := sheet.FindRow(r); + if row <> nil then begin + h := sheet.GetRowHeight(r); + // Look for this height in the current RowStyleList + found := false; + for j:=0 to FRowStyleList.Count-1 do + if SameValue(TRowStyleData(FRowStyleList[j]).RowHeight, h, ROWHEIGHT_EPS) and + (not TRowStyleData(FRowStyleList[j]).AutoRowHeight) + then begin + found := true; + break; + end; + // Not found? Then add the row as a new row style + if not found then begin + rowStyle := TRowStyleData.Create; + rowStyle.Name := Format('ro%d', [FRowStyleList.Count+1]); + rowStyle.RowHeight := h; + rowStyle.AutoRowHeight := false; + FRowStyleList.Add(rowStyle); + end; + end; + end; + end; + + { fpspreadsheet's row heights are measured as line count of the default font. + Using the default font size (which is in points) we convert the line count + to points and then to millimeters as needed by ods. } + multiplier := Workbook.GetDefaultFontSize;; + for i:=0 to FRowStyleList.Count-1 do begin + h := (TRowStyleData(FRowStyleList[i]).RowHeight + ROW_HEIGHT_CORRECTION) * multiplier; + TRowStyleData(FRowStyleList[i]).RowHeight := PtsToMM(h); + end; +end; + procedure TsSpreadOpenDocWriter.WriteMimetype; begin FMimetype := 'application/vnd.oasis.opendocument.spreadsheet'; @@ -1229,11 +1516,27 @@ end; procedure TsSpreadOpenDocWriter.WriteContent; var i: Integer; - lStylesCode: string; + lCellStylesCode: string; + lColStylesCode: String; + lRowStylesCode: String; begin + ListAllColumnStyles; + ListAllRowStyles; ListAllFormattingStyles; - lStylesCode := WriteStylesXMLAsString; + lColStylesCode := WriteColStylesXMLAsString; + if lColStylesCode = '' then lColStylesCode := + ' ' + LineEnding + + ' ' + LineEnding + + ' ' + LineEnding; + + lRowStylesCode := WriteRowStylesXMLAsString; + if lRowStylesCode = '' then lRowStylesCode := + ' ' + LineEnding + + ' ' + LineEnding + + ' ' + LineEnding; + + lCellStylesCode := WriteCellStylesXMLAsString; FContent := XML_HEADER + LineEnding + @@ -1266,17 +1569,14 @@ begin // Automatic styles ' ' + LineEnding + - ' ' + LineEnding + - ' ' + LineEnding + - ' ' + LineEnding + - ' ' + LineEnding + - ' ' + LineEnding + - ' ' + LineEnding + + lColStylesCode + + lRowStylesCode + ' ' + LineEnding + ' ' + LineEnding + ' ' + LineEnding + + // Automatically Generated Styles - lStylesCode + + lCellStylesCode + ' ' + LineEnding + // Body @@ -1301,45 +1601,35 @@ var LastColIndex: Cardinal; LCell: TCell; AVLNode: TAVLTreeNode; + defFontSize: Single; + h, h_mm: Double; + styleName: String; + rowStyleData: TRowStyleData; + row: PRow; begin LastColIndex := CurSheet.GetLastColIndex; + defFontSize := Workbook.GetFont(0).Size; // Header FContent := FContent + - ' ' + LineEnding + - ' ' + LineEnding; + ' ' + LineEnding; + // columns + FContent := FContent + WriteColumnsXMLAsString(CurSheet); + + // rows and cells // The cells need to be written in order, row by row, cell by cell - for j := 0 to CurSheet.GetLastRowIndex do - begin - FContent := FContent + - ' ' + LineEnding; - - // Write cells from this row. - for k := 0 to LastColIndex do - begin - LCell.Row := j; - LCell.Col := k; - AVLNode := CurSheet.Cells.Find(@LCell); - if Assigned(AVLNode) then - WriteCellCallback(PCell(AVLNode.Data), nil) - else - FContent := FContent + '' + LineEnding; - end; - - FContent := FContent + - ' ' + LineEnding; - end; + FContent := FContent + WriteRowsAndCellsXMLAsString(CurSheet); // Footer FContent := FContent + ' ' + LineEnding; end; -function TsSpreadOpenDocWriter.WriteStylesXMLAsString: string; +function TsSpreadOpenDocWriter.WriteCellStylesXMLAsString: string; var i: Integer; + s: String; begin Result := ''; @@ -1357,29 +1647,20 @@ begin ' ' + LineEnding; // style:table-cell-properties - if (FFormattingStyles[i].UsedFormattingFields * - [uffBorder, uffBackgroundColor, uffWordWrap, uffTextRotation, uffVertAlign] <> []) - then begin + s := WriteBorderStyleXMLAsString(FFormattingStyles[i]) + + WriteBackgroundColorStyleXMLAsString(FFormattingStyles[i]) + + WriteWordwrapStyleXMLAsString(FFormattingStyles[i]) + + WriteTextRotationStyleXMLAsString(FFormattingStyles[i]) + + WriteVertAlignmentStyleXMLAsString(FFormattingStyles[i]); + if s <> '' then Result := Result + - ' ' + LineEnding; - end; + ' ' + LineEnding; // style:paragraph-properties - if (uffHorAlign in FFormattingStyles[i].UsedFormattingFields) and - (FFormattingStyles[i].HorAlignment <> haDefault) - then begin + s := WriteHorAlignmentStyleXMLAsString(FFormattingStyles[i]); + if s <> '' then Result := Result + - ' ' + LineEnding; - end; - + ' ' + LineEnding; // End Result := Result + @@ -1387,14 +1668,260 @@ begin end; end; +function TsSpreadOpenDocWriter.WriteColStylesXMLAsString: string; +var + i: Integer; + s: String; + colstyle: TColumnStyleData; +begin + Result := ''; + + for i := 0 to FColumnStyleList.Count-1 do begin + colStyle := TColumnStyleData(FColumnStyleList[i]); + + // Start and Name + Result := Result + + ' ' + LineEnding; + + // Column width + Result := Result + + ' ' + LineEnding; + + // End + Result := Result + + ' ' + LineEnding; + + Result := Format(Result, [colStyle.Name, colStyle.ColWidth], FPointSeparatorSettings); + end; +end; + +function TsSpreadOpenDocWriter.WriteColumnsXMLAsString(ASheet: TsWorksheet): String; +var + lastCol: Integer; + j, k: Integer; + w, w_mm: Double; + widthMultiplier: Double; + styleName: String; + colsRepeated: Integer; + colsRepeatedStr: String; +begin + Result := ''; + + widthMultiplier := Workbook.GetFont(0).Size / 2; + lastCol := ASheet.GetLastColIndex; + + j := 0; + while (j <= lastCol) do begin + w := ASheet.GetColWidth(j); + // Convert to mm + w_mm := PtsToMM(w * widthMultiplier); + + // Find width in ColumnStyleList to retrieve corresponding style name + styleName := ''; + for k := 0 to FColumnStyleList.Count-1 do + if SameValue(TColumnStyleData(FColumnStyleList[k]).ColWidth, w_mm, COLWIDTH_EPS) then begin + styleName := TColumnStyleData(FColumnStyleList[k]).Name; + break; + end; + if stylename = '' then + raise Exception.Create('Column style not found.'); + + // Determine value for "number-columns-repeated" + colsRepeated := 1; + k := j+1; + while (k <= lastCol) do begin + if ASheet.GetColWidth(k) = w then + inc(colsRepeated) + else + break; + inc(k); + end; + colsRepeatedStr := IfThen(colsRepeated = 1, '', Format(' table:number-columns-repeated="%d"', [colsRepeated])); + + Result := Result + Format( + ' ', + [styleName, colsRepeatedStr]) + LineEnding; + + j := j + colsRepeated; + end; +end; + +function TsSpreadOpenDocWriter.WriteRowsAndCellsXMLAsString(ASheet: TsWorksheet): String; +var + r, rr: Cardinal; // row index in sheet + c, cc: Cardinal; // column index in sheet + row: PRow; // sheet row record + cell: PCell; // current cell + styleName: String; + k: Integer; + h, h_mm: Single; // row height in "lines" and millimeters, respectively + h1: Single; + colsRepeated: Integer; + rowsRepeated: Integer; + colsRepeatedStr: String; + rowsRepeatedStr: String; + lastCol, lastRow: Cardinal; + rowStyleData: TRowStyleData; + colData: TColumnData; + colStyleData: TColumnStyleData; + defFontSize: Single; + sameRowStyle: Boolean; +begin + Result := ''; + + // some abbreviations... + lastCol := ASheet.GetLastColIndex; + lastRow := ASheet.GetLastRowIndex; + defFontSize := Workbook.GetFont(0).Size; + + // Now loop through all rows + r := 0; + while (r <= lastRow) do begin + // Look for the row style of the current row (r) + row := ASheet.FindRow(r); + if row = nil then + styleName := 'ro1' + else begin + styleName := ''; + + h := row^.Height; // row height in "lines" + h_mm := PtsToMM((h + ROW_HEIGHT_CORRECTION) * defFontSize); // in mm + for k := 0 to FRowStyleList.Count-1 do begin + rowStyleData := TRowStyleData(FRowStyleList[k]); + // Compare row heights, but be aware of rounding errors + if SameValue(rowStyleData.RowHeight, h_mm, 1E-3) then begin + styleName := rowStyleData.Name; + break; + end; + end; + if styleName = '' then + raise Exception.Create('Row style not found.'); + end; + + // Look for empty rows with the same style, they need the "number-rows-repeated" element. + rowsRepeated := 1; + if ASheet.GetCellCountInRow(r) = 0 then begin + rr := r + 1; + while (rr <= lastRow) do begin + if ASheet.GetCellCountInRow(rr) > 0 then begin + break; + end; + h1 := ASheet.GetRowHeight(rr); + if not SameValue(h, h1, ROWHEIGHT_EPS) then + break; + inc(rr); + end; + rowsRepeated := rr - r; + rowsRepeatedStr := IfThen(rowsRepeated = 1, '', + Format('table:number-rows-repeated="%d"', [rowsRepeated])); + colsRepeated := lastCol+1; + colsRepeatedStr := IfThen(colsRepeated = 1, '', + Format('table:number-columns-repeated="%d"', [colsRepeated])); + Result := Result + Format( + ' ' + LineEnding + + ' ' + LineEnding + + ' ' + LineEnding, + [styleName, rowsRepeatedStr, colsRepeatedStr]); + r := rr; + continue; + end; + + // Now we know that there are cells. + // Write the row XML + Result := Result + Format( + ' ', [styleName]) + LineEnding; + + // Loop along the row and find the cells. + c := 0; + while c <= lastCol do begin + // Get the cell from the sheet + cell := ASheet.FindCell(r, c); + // Empty cell? Need to count how many to add "table:number-columns-repeated" + colsRepeated := 1; + if cell = nil then begin + cc := c + 1; + while (cc <= lastCol) do begin + cell := ASheet.FindCell(r, cc); + if cell <> nil then + break; + inc(cc) + end; + colsRepeated := cc - c; + colsRepeatedStr := IfThen(colsRepeated = 1, '', + Format('table:number-columns-repeated="%d"', [colsRepeated])); + Result := Result + Format( + ' ', [colsRepeatedStr]) + LineEnding; + end + else begin + WriteCellCallback(cell, nil); + Result := Result + FCellContent; + end; + inc(c, colsRepeated); + end; + + Result := Result + + ' ' + LineEnding; + + // Next row + inc(r, rowsRepeated); + end; +end; + +function TsSpreadOpenDocWriter.WriteRowStylesXMLAsString: string; +const + FALSE_TRUE: array[boolean] of string = ('false', 'true'); +var + i: Integer; + s: String; + rowstyle: TRowStyleData; +begin + Result := ''; + + for i := 0 to FRowStyleList.Count-1 do begin + rowStyle := TRowStyleData(FRowStyleList[i]); + + // Start and Name + Result := Result + + ' ' + LineEnding; + + // Column width + Result := Result + + ' ' + LineEnding; + + // End + Result := Result + + ' ' + LineEnding; + + Result := Format(Result, + [rowStyle.Name, rowStyle.RowHeight, FALSE_TRUE[rowStyle.AutoRowHeight]], + FPointSeparatorSettings + ); + end; +end; + + constructor TsSpreadOpenDocWriter.Create(AWorkbook: TsWorkbook); begin inherited Create(AWorkbook); + FColumnStyleList := TFPList.Create; + FRowStyleList := TFPList.Create; + FPointSeparatorSettings := SysUtils.DefaultFormatSettings; FPointSeparatorSettings.DecimalSeparator:='.'; end; +destructor TsSpreadOpenDocWriter.Destroy; +var + j: Integer; +begin + for j:=FColumnStyleList.Count-1 downto 0 do TObject(FColumnStyleList[j]).Free; + FColumnStyleList.Free; + + for j:=FRowStyleList.Count-1 downto 0 do TObject(FRowStyleList[j]).Free; + FRowStyleList.Free; +end; + { Writes a string to a file. Helper convenience method. } @@ -1495,10 +2022,11 @@ begin if ACell^.UsedFormattingFields <> [] then begin lIndex := FindFormattingInList(ACell); lStyle := ' table:style-name="ce' + IntToStr(lIndex) + '" '; - FContent := FContent + + FCellContent := ' ' + LineEnding + ' ' + LineEnding; - end; + end else + FCellContent := ''; end; { Creates an XML string for inclusion of the background color into the @@ -1649,14 +2177,14 @@ var lStyle: string = ''; lIndex: Integer; begin - if ACell^.UsedFormattingFields <> [] then - begin + if ACell^.UsedFormattingFields <> [] then begin lIndex := FindFormattingInList(ACell); lStyle := ' table:style-name="ce' + IntToStr(lIndex) + '" '; - end; + end else + lStyle := ''; // The row should already be the correct one - FContent := FContent + + FCellContent := ' ' + LineEnding + ' ' + UTF8TextToXMLText(AValue) + '' + LineEnding + ' ' + LineEnding; @@ -1670,11 +2198,11 @@ var lStyle: string = ''; lIndex: Integer; begin - if ACell^.UsedFormattingFields <> [] then - begin + if ACell^.UsedFormattingFields <> [] then begin lIndex := FindFormattingInList(ACell); lStyle := ' table:style-name="ce' + IntToStr(lIndex) + '" '; - end; + end else + lStyle := ''; // The row should already be the correct one if IsInfinite(AValue) then begin @@ -1684,7 +2212,7 @@ begin StrValue:=FloatToStr(AValue,FPointSeparatorSettings); //Uses '.' as decimal separator DisplayStr:=FloatToStr(AValue); // Uses locale decimal separator end; - FContent := FContent + + FCellContent := ' ' + LineEnding + ' ' + DisplayStr + '' + LineEnding + ' ' + LineEnding; @@ -1703,14 +2231,14 @@ var lStyle: string = ''; lIndex: Integer; begin - if ACell^.UsedFormattingFields <> [] then - begin + if ACell^.UsedFormattingFields <> [] then begin lIndex := FindFormattingInList(ACell); lStyle := ' table:style-name="ce' + IntToStr(lIndex) + '" '; - end; + end else + lStyle := ''; // The row should already be the correct one - FContent := FContent + + FCellContent := ' ' + LineEnding + ' ' + LineEnding; end; diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas index e8cc117de..6a76b6319 100755 --- a/components/fpspreadsheet/fpspreadsheet.pas +++ b/components/fpspreadsheet/fpspreadsheet.pas @@ -335,16 +335,22 @@ type PCell = ^TCell; +const + // Takes account of effect of cell margins on row height by adding this + // value to the nominal row height. Note that this is an empirical value and may be wrong. + ROW_HEIGHT_CORRECTION = 0.2; + +type TRow = record Row: Cardinal; - Height: Single; // in millimeters + Height: Single; // in "lines" end; PRow = ^TRow; TCol = record Col: Cardinal; - Width: Single; // in "characters". Excel uses the with of char "0" in 1st font + Width: Single; // in "characters". Excel uses the width of char "0" in 1st font end; PCol = ^TCol; @@ -368,7 +374,7 @@ type FWorkbook: TsWorkbook; FCells: TAvlTree; // Items are TCell FCurrentNode: TAVLTreeNode; // For GetFirstCell and GetNextCell - FRows, FCols: TIndexedAVLTree; // This lists contain only rows or cols with styles different from the standard + FRows, FCols: TIndexedAVLTree; // This lists contain only rows or cols with styles different from default FLeftPaneWidth: Integer; FTopPaneHeight: Integer; FOptions: TsSheetOptions; @@ -475,8 +481,12 @@ type { Data manipulation methods - For Rows and Cols } function FindRow(ARow: Cardinal): PRow; function FindCol(ACol: Cardinal): PCol; + function GetCellCountInRow(ARow: Cardinal): Cardinal; + function GetCellCountInCol(ACol: Cardinal): Cardinal; function GetRow(ARow: Cardinal): PRow; + function GetRowHeight(ARow: Cardinal): Single; function GetCol(ACol: Cardinal): PCol; + function GetColWidth(ACol: Cardinal): Single; procedure RemoveAllRows; procedure RemoveAllCols; procedure WriteRowInfo(ARow: Cardinal; AData: TRow); @@ -511,10 +521,15 @@ type FBuiltinFontCount: Integer; FPalette: array of TsColorValue; FReadFormulas: Boolean; + FDefaultColWidth: Single; // in "characters". Excel uses the width of char "0" in 1st font + FDefaultRowHeight: Single; // in "character heights", i.e. line count + { Internal methods } procedure RemoveWorksheetsCallback(data, arg: pointer); + public FormatSettings: TFormatSettings; + { Base methods } constructor Create; destructor Destroy; override; @@ -530,6 +545,7 @@ type const AOverwriteExisting: Boolean = False); overload; procedure WriteToFile(const AFileName: String; const AOverwriteExisting: Boolean = False); overload; procedure WriteToStream(AStream: TStream; AFormat: TsSpreadsheetFormat); + { Worksheet list handling methods } function AddWorksheet(AName: string): TsWorksheet; function GetFirstWorksheet: TsWorksheet; @@ -537,6 +553,7 @@ type function GetWorksheetByName(AName: String): TsWorksheet; function GetWorksheetCount: Cardinal; procedure RemoveAllWorksheets; + { Font handling } function AddFont(const AFontName: String; ASize: Single; AStyle: TsFontStyles; AColor: TsColor): Integer; overload; @@ -544,11 +561,13 @@ type procedure CopyFontList(ASource: TFPList); function FindFont(const AFontName: String; ASize: Single; AStyle: TsFontStyles; AColor: TsColor): Integer; + function GetDefaultFontSize: Single; function GetFont(AIndex: Integer): TsFont; function GetFontCount: Integer; procedure InitFonts; procedure RemoveAllFonts; procedure SetDefaultFont(const AFontName: String; ASize: Single); + { Color handling } function AddColorToPalette(AColorValue: TsColorValue): TsColor; function FPSColorToHexString(AColor: TsColor; ARGBColor: TFPColor): String; @@ -560,6 +579,13 @@ type procedure UseDefaultPalette; procedure UsePalette(APalette: PsPalette; APaletteCount: Word; ABigEndian: Boolean = false); + + {@@ The default column width given in "character units" (width of the + character "0" in the default font) } + property DefaultColWidth: Single read FDefaultColWidth; + {@@ The default row height is given in "line count" (height of the + default font } + property DefaultRowHeight: Single read FDefaultRowHeight; {@@ This property is only used for formats which don't support unicode and support a single encoding for the whole document, like Excel 2 to 5 } property Encoding: TsEncoding read FEncoding write FEncoding; @@ -1366,6 +1392,7 @@ end; function TsWorksheet.GetLastColIndex: Cardinal; var AVLNode: TAVLTreeNode; + i: Integer; begin Result := 0; @@ -1378,6 +1405,12 @@ begin Result := Math.Max(Result, PCell(AVLNode.Data)^.Col); AVLNode := FCells.FindSuccessor(AVLNode); end; + + // In addition, there may be column records defining the column width even + // without content + for i:=0 to FCols.Count-1 do + if FCols[i] <> nil then + Result := Math.Max(Result, PCol(FCols[i])^.Col); end; function TsWorksheet.GetLastColNumber: Cardinal; @@ -1424,12 +1457,18 @@ end; function TsWorksheet.GetLastRowIndex: Cardinal; var AVLNode: TAVLTreeNode; + i: Integer; begin Result := 0; AVLNode := FCells.FindHighest; if Assigned(AVLNode) then Result := PCell(AVLNode.Data).Row; + + // In addition, there may be row records even for empty rows. + for i:=0 to FRows.Count-1 do + if FRows[i] <> nil then + Result := Math.Max(Result, PRow(FRows[i])^.Row); end; function TsWorksheet.GetLastRowNumber: Cardinal; @@ -2243,7 +2282,6 @@ var AVLNode: TAVGLVLTreeNode; begin Result := nil; - LElement.Row := ARow; AVLNode := FRows.Find(@LElement); if Assigned(AVLNode) then @@ -2256,7 +2294,6 @@ var AVLNode: TAVGLVLTreeNode; begin Result := nil; - LElement.Col := ACol; AVLNode := FCols.Find(@LElement); if Assigned(AVLNode) then @@ -2285,6 +2322,72 @@ begin end; end; +{ Counts how many cells exist in the given column. Blank cells do contribute + to the sum, as well as rows with a non-default style. } +function TsWorksheet.GetCellCountInCol(ACol: Cardinal): Cardinal; +var + cell: PCell; + r: Cardinal; + row: PRow; +begin + Result := 0; + for r := 0 to GetLastRowIndex do begin + cell := FindCell(r, ACol); + if cell <> nil then + inc(Result) + else begin + row := FindRow(r); + if row <> nil then inc(Result); + end; + end; +end; + +{ Counts how many cells exist in the given row. Blank cells do contribute + to the sum, as well as columns with a non-default style. } +function TsWorksheet.GetCellCountInRow(ARow: Cardinal): Cardinal; +var + cell: PCell; + c: Cardinal; + col: PCol; +begin + Result := 0; + for c := 0 to GetLastColIndex do begin + cell := FindCell(ARow, c); + if cell <> nil then + inc(Result) + else begin + col := FindCol(c); + if col <> nil then inc(Result); + end; + end; +end; + +{ Returns the width of the given column. If there is no column record then + the default column width is returned. } +function TsWorksheet.GetColWidth(ACol: Cardinal): Single; +var + col: PCol; +begin + col := FindCol(ACol); + if col <> nil then + Result := col^.Width + else + Result := FWorkbook.DefaultColWidth; +end; + +{ Returns the height of the given row. If there is no row record then the + default row height is returned } +function TsWorksheet.GetRowHeight(ARow: Cardinal): Single; +var + row: PRow; +begin + row := FindRow(ARow); + if row <> nil then + Result := row^.Height + else + Result := FWorkbook.DefaultRowHeight; +end; + procedure TsWorksheet.RemoveAllRows; var Node: Pointer; @@ -2359,6 +2462,8 @@ constructor TsWorkbook.Create; begin inherited Create; FWorksheets := TFPList.Create; + FDefaultColWidth := 12; + FDefaultRowHeight := 1; FormatSettings := DefaultFormatSettings; FFontList := TFPList.Create; SetDefaultFont('Arial', 10.0); @@ -2777,7 +2882,6 @@ begin // FONT4 which does not exist in BIFF is added automatically with nil as place-holder AddFont(fntName, fntSize, [fssBold, fssItalic], scBlack); // FONT5 for uffBoldItalic - FBuiltinFontCount := FFontList.Count; end; @@ -2816,6 +2920,14 @@ begin end; end; +{@@ + Returns the point size of the default font +} +function TsWorkbook.GetDefaultFontSize: Single; +begin + Result := GetFont(0).Size; +end; + {@@ Returns the font with the given index. } diff --git a/components/fpspreadsheet/fpspreadsheetgrid.pas b/components/fpspreadsheet/fpspreadsheetgrid.pas index ce747981b..4bd9d6496 100644 --- a/components/fpspreadsheet/fpspreadsheetgrid.pas +++ b/components/fpspreadsheet/fpspreadsheetgrid.pas @@ -525,10 +525,13 @@ begin Result := h; end; -{ Converts the row height, given in mm, to pixels } +{ Converts the row height (from a worksheet row), given in lines, to pixels } function TsCustomWorksheetGrid.CalcRowHeight(AHeight: Single): Integer; +var + h_pts: Single; begin - Result := round(AHeight / 25.4 * Screen.PixelsPerInch) + 4; + h_pts := AHeight * (Workbook.GetFont(0).Size + ROW_HEIGHT_CORRECTION); + Result := PtsToPX(h_pts, Screen.PixelsPerInch) + 4; end; procedure TsCustomWorksheetGrid.ChangedCellHandler(ASender: TObject; ARow, ACol:Cardinal); @@ -1871,7 +1874,7 @@ end; procedure TsCustomWorksheetGrid.HeaderSized(IsColumn: Boolean; index: Integer); var w0: Integer; - h: Single; + h, h_pts: Single; begin if FWorksheet = nil then exit; @@ -1884,8 +1887,9 @@ begin FWorksheet.WriteColWidth(GetWorksheetCol(Index), ColWidths[Index] div w0); end else begin // The grid's row heights are in "pixels", the worksheet's row heights are - // in millimeters. - h := (RowHeights[Index] - 4) / Screen.PixelsPerInch * 25.4; + // in "lines" + h_pts := PxToPts(RowHeights[Index] - 4, Screen.PixelsPerInch); // in points + h := h_pts / (FWorkbook.GetFont(0).Size + ROW_HEIGHT_CORRECTION); FWorksheet.WriteRowHeight(GetWorksheetRow(Index), h); end; end; @@ -2616,6 +2620,7 @@ end; initialization + fpsutils.ScreenPixelsPerInch := Screen.PixelsPerInch; finalization FreeAndNil(FillPattern_BIFF2); diff --git a/components/fpspreadsheet/fpsutils.pas b/components/fpspreadsheet/fpsutils.pas index dae8e180b..021d463ae 100644 --- a/components/fpspreadsheet/fpsutils.pas +++ b/components/fpspreadsheet/fpsutils.pas @@ -66,9 +66,6 @@ function GetErrorValueStr(AErrorValue: TsErrorValue): String; function UTF8TextToXMLText(AText: ansistring): ansistring; -function TwipsToMillimeters(AValue: Integer): Single; -function MillimetersToTwips(AValue: Single): Integer; - function IfThen(ACondition: Boolean; AValue1,AValue2: TsNumberFormat): TsNumberFormat; overload; function IsDateTimeFormat(AFormat: TsNumberFormat): Boolean; @@ -102,12 +99,24 @@ function FormatDateTime(const FormatStr: string; DateTime: TDateTime; function FormatDateTime(const FormatStr: string; DateTime: TDateTime; const FormatSettings: TFormatSettings; Options : TFormatDateTimeOptions = []): string; +function TwipsToPts(AValue: Integer): Single; +function PtsToTwips(AValue: Single): Integer; function cmToPts(AValue: Double): Double; +function PtsToCm(AValue: Double): Double; +function InToPts(AValue: Double): Double; function mmToPts(AValue: Double): Double; +function PtsToMM(AValue: Double): Double; +function pxToPts(AValue, AScreenPixelsPerInch: Integer): Double; +function PtsToPx(AValue: Double; AScreenPixelsPerInch: Integer): Integer; +function HTMLLengthStrToPts(AValue: String): Double; +//function HMTLLengthStrToPts(AValue: String): Double; function HTMLColorStrToColor(AValue: String): TsColorValue; function ColorToHTMLColorStr(AValue: TsColorValue): String; +var + ScreenPixelsPerInch: Integer = 96; + implementation uses @@ -533,19 +542,6 @@ begin Result:=WrkStr; end; -{ Excel's unit of row heights is "twips", i.e. 1/20 point. 72 pts = 1 inch = 25.4 mm - The procedure TwipsToMillimeters performs the conversion to millimeters. } -function TwipsToMillimeters(AValue: Integer): Single; -begin - Result := 25.4 * AValue / (20 * 72); -end; - -{ Converts Millimeters to Twips, i.e. 1/20 pt } -function MillimetersToTwips(AValue: Single): Integer; -begin - Result := Round((AValue * 20 * 72) / 25.4); -end; - { Returns either AValue1 or AValue2, depending on the condition. For reduciton of typing... } function IfThen(ACondition: Boolean; AValue1, AValue2: TsNumberFormat): TsNumberFormat; @@ -1296,16 +1292,82 @@ begin DateTimeToString(Result, FormatStr, DateTime, FormatSettings,Options); end; +{ Excel's unit of row heights is "twips", i.e. 1/20 point. + Converts Twips to points. } +function TwipsToPts(AValue: Integer): Single; +begin + Result := AValue / 20; +end; + +{ Converts points to twips (1 twip = 1/20 point) } +function PtsToTwips(AValue: Single): Integer; +begin + Result := round(AValue * 20); +end; + { Converts centimeters to points (72 pts = 1 inch) } function cmToPts(AValue: Double): Double; begin - Result := AValue/2.54*72; + Result := AValue * 72 / 2.54; +end; + +{ Converts points to centimeters } +function PtsToCm(AValue: Double): Double; +begin + Result := AValue / 72 * 2.54; +end; + +{ Converts inches to points (72 pts = 1 inch) } +function InToPts(AValue: Double): Double; +begin + Result := AValue * 72; end; { Converts millimeters to points (72 pts = 1 inch) } function mmToPts(AValue: Double): Double; begin - Result := AValue/25.4*72; + Result := AValue * 72 / 25.4; +end; + +{ Converts points to millimeters } +function PtsToMM(AValue: Double): Double; +begin + Result := AValue / 72 * 25.4; +end; + +{ Converts pixels to points. } +function pxToPts(AValue, AScreenPixelsPerInch: Integer): Double; +begin + Result := (AValue / AScreenPixelsPerInch) * 72; +end; + +{ Converts points to pixels } +function PtsToPx(AValue: Double; AScreenPixelsPerInch: Integer): Integer; +begin + Result := Round(AValue / 72 * AScreenPixelsPerInch); +end; + +{ converts a HTML length string to points. The units are assumed to be the last + two digits of the string } +function HTMLLengthStrToPts(AValue: String): Double; +var + units: String; + x: Double; + res: Word; +begin + units := lowercase(Copy(AValue, Length(AValue)-1, 2)); + val(copy(AValue, 1, Length(AValue)-2), x, res); + // No hasseling with the decimal point... + if units = 'in' then + Result := InToPts(x) + else if units = 'cm' then + Result := cmToPts(x) + else if units = 'mm' then + Result := mmToPts(x) + else if units = 'px' then + Result := pxToPts(Round(x), ScreenPixelsPerInch) + else + raise Exception.Create('Unknown length units'); end; { converts a HTML color string to a TsColorValue. For ods } diff --git a/components/fpspreadsheet/tests/formattests.pas b/components/fpspreadsheet/tests/formattests.pas index fbcf03657..82402d6a7 100644 --- a/components/fpspreadsheet/tests/formattests.pas +++ b/components/fpspreadsheet/tests/formattests.pas @@ -107,6 +107,8 @@ type procedure TestWriteRead_ODS_Alignment; procedure TestWriteRead_ODS_Border; procedure TestWriteRead_ODS_BorderStyles; + procedure TestWriteRead_ODS_ColWidths; + procedure TestWriteRead_ODS_RowHeights; procedure TestWriteRead_ODS_TextRotation; procedure TestWriteRead_ODS_WordWrap; end; @@ -203,13 +205,13 @@ begin end; // Column width - SollColWidths[0] := 20; // characters based on width of "0" + SollColWidths[0] := 20; // characters based on width of "0" of default font SollColWidths[1] := 40; // Row heights - SollRowHeights[0] := 5; - SollRowHeights[1] := 10; - SollRowHeights[2] := 50; + SollRowHeights[0] := 1; // Lines of default font + SollRowHeights[1] := 2; + SollRowHeights[2] := 4; // Cell borders SollBorders[0] := []; @@ -723,6 +725,7 @@ begin MyWorkSheet:= MyWorkBook.AddWorksheet(ColWidthSheet); for Col := Low(SollColWidths) to High(SollColWidths) do begin lCol.Width := SollColWidths[Col]; + //MyWorksheet.WriteNumber(0, Col, 1); MyWorksheet.WriteColInfo(Col, lCol); end; MyWorkBook.WriteToFile(TempFile, AFormat, true); @@ -742,8 +745,9 @@ begin if lpCol = nil then fail('Error in test code. Failed to return saved column width'); ActualColWidth := lpCol^.Width; - CheckEquals(SollColWidths[Col], ActualColWidth, - 'Test saved colwidth mismatch, column '+ColNotation(MyWorkSheet,Col)); + if abs(SollColWidths[Col] - ActualColWidth) > 1E-2 then // take rounding errors into account + CheckEquals(SollColWidths[Col], ActualColWidth, + 'Test saved colwidth mismatch, column '+ColNotation(MyWorkSheet,Col)); end; // Finalization MyWorkbook.Free; @@ -766,6 +770,10 @@ begin TestWriteReadColWidths(sfExcel8); end; +procedure TSpreadWriteReadFormatTests.TestWriteRead_ODS_ColWidths; +begin + TestWriteReadColWidths(sfOpenDocument); +end; { --- Row height tests --- } @@ -801,14 +809,11 @@ begin if MyWorksheet=nil then fail('Error in test code. Failed to get named worksheet'); for Row := Low(SollRowHeights) to High(SollRowHeights) do begin - lpRow := MyWorksheet.GetRow(Row); - if lpRow = nil then - fail('Error in test code. Failed to return saved row height'); - // Rounding to twips in Excel would cause severe rounding error if we'd compare millimeters - // --> go back to twips - ActualRowHeight := MillimetersToTwips(lpRow^.Height); - CheckEquals(MillimetersToTwips(SollRowHeights[Row]), ActualRowHeight, - 'Test saved row height mismatch, row '+RowNotation(MyWorkSheet,Row)); + ActualRowHeight := MyWorksheet.GetRowHeight(Row); + // Take care of rounding errors + if abs(ActualRowHeight - SollRowHeights[Row]) > 1e-2 then + CheckEquals(SollRowHeights[Row], ActualRowHeight, + 'Test saved row height mismatch, row '+RowNotation(MyWorkSheet,Row)); end; // Finalization MyWorkbook.Free; @@ -831,6 +836,11 @@ begin TestWriteReadRowHeights(sfExcel8); end; +procedure TSpreadWriteReadFormatTests.TestWriteRead_ODS_RowHeights; +begin + TestWriteReadRowHeights(sfOpenDocument); +end; + { --- Text rotation tests --- } diff --git a/components/fpspreadsheet/xlsbiff2.pas b/components/fpspreadsheet/xlsbiff2.pas index 503944a22..b7a806eef 100755 --- a/components/fpspreadsheet/xlsbiff2.pas +++ b/components/fpspreadsheet/xlsbiff2.pas @@ -708,7 +708,12 @@ begin if h and $8000 = 0 then begin // if this bit were set, rowheight would be default lRow := FWorksheet.GetRow(WordLEToN(rowrec.RowIndex)); // Row height is encoded into the 15 remaining bits in units "twips" (1/20 pt) - lRow^.Height := TwipsToMillimeters(h and $7FFF); + // We need it in "lines" units. + lRow^.Height := TwipsToPts(h and $7FFF) / Workbook.GetFont(0).Size; + if lRow^.Height > ROW_HEIGHT_CORRECTION then + lRow^.Height := lRow^.Height - ROW_HEIGHT_CORRECTION + else + lRow^.Height := 0; end; end; @@ -1632,6 +1637,7 @@ var containsXF: Boolean; rowheight: Word; w: Word; + h: Single; begin containsXF := false; @@ -1649,10 +1655,14 @@ begin AStream.WriteWord(WordToLE(Word(ALastColIndex) + 1)); { Row height (in twips, 1/20 point) and info on custom row height } - if (ARow = nil) or (ARow^.Height = 0) then - rowheight := round(Workbook.GetFont(0).Size*20) + h := Workbook.GetFont(0).Size; + if (ARow = nil) or (ARow^.Height = Workbook.DefaultRowHeight) then + rowheight := PtsToTwips((Workbook.DefaultRowHeight + ROW_HEIGHT_CORRECTION) * h) else - rowheight := MillimetersToTwips(ARow^.Height); + if (ARow^.Height = 0) then + rowheight := 0 + else + rowheight := PtsToTwips((ARow^.Height + ROW_HEIGHT_CORRECTION) * h); w := rowheight and $7FFF; AStream.WriteWord(WordToLE(w)); diff --git a/components/fpspreadsheet/xlscommon.pas b/components/fpspreadsheet/xlscommon.pas index 887ba96c4..f77ea1a29 100644 --- a/components/fpspreadsheet/xlscommon.pas +++ b/components/fpspreadsheet/xlscommon.pas @@ -1329,12 +1329,13 @@ begin if h and $8000 = 0 then begin // if this bit were set, rowheight would be default lRow := FWorksheet.GetRow(WordLEToN(rowrec.RowIndex)); // Row height is encoded into the 15 remaining bits in units "twips" (1/20 pt) - lRow^.Height := TwipsToMillimeters(h and $7FFF); - end else - lRow^.Height := 0; - //lRow^.AutoHeight := rowrec.Flags and $00000040 = 0; - // If this bit is set row height does not change with font height, i.e. has been - // changed manually. + // We need it in "lines", i.e. we divide the points by the point size of the default font + lRow^.Height := TwipsToPts(h and $7FFF) / FWorkbook.GetFont(0).Size; + if lRow^.Height > ROW_HEIGHT_CORRECTION then + lRow^.Height := lRow^.Height - ROW_HEIGHT_CORRECTION + else + lRow^.Height := 0; + end; end; { Reads the cell address used in an RPN formula element. Evaluates the corresponding @@ -1903,6 +1904,7 @@ var spaceabove, spacebelow: Boolean; colindex: Cardinal; rowheight: Word; + h: Single; begin // Check for additional space above/below row spaceabove := false; @@ -1934,10 +1936,14 @@ begin AStream.WriteWord(WordToLE(Word(ALastColIndex) + 1)); { Row height (in twips, 1/20 point) and info on custom row height } - if (ARow = nil) or (ARow^.Height = 0) then - rowheight := round(Workbook.GetFont(0).Size*20) + h := Workbook.GetFont(0).Size; // Point size of default font + if (ARow = nil) or (ARow^.Height = Workbook.DefaultRowHeight) then + rowheight := PtsToTwips((Workbook.DefaultRowHeight + ROW_HEIGHT_CORRECTION) * h) else - rowheight := MillimetersToTwips(ARow^.Height); + if (ARow^.Height = 0) then + rowheight := 0 + else + rowheight := PtsToTwips((ARow^.Height + ROW_HEIGHT_CORRECTION)*h); w := rowheight and $7FFF; AStream.WriteWord(WordToLE(w));