diff --git a/components/fpspreadsheet/fpsfunc.pas b/components/fpspreadsheet/fpsfunc.pas index 7d9ff2f72..46fdd11db 100644 --- a/components/fpspreadsheet/fpsfunc.pas +++ b/components/fpspreadsheet/fpsfunc.pas @@ -184,7 +184,7 @@ function fpsVALUE (Args: TsArgumentStack; NumArgs: Integer): TsArgument; implementation uses - Math, lazutf8, StrUtils, DateUtils, fpsUtils; + Math, lazutf8, DateUtils, fpsUtils; { Helpers } diff --git a/components/fpspreadsheet/tests/formattests.pas b/components/fpspreadsheet/tests/formattests.pas index a407c29d5..c53fd0c23 100644 --- a/components/fpspreadsheet/tests/formattests.pas +++ b/components/fpspreadsheet/tests/formattests.pas @@ -122,6 +122,8 @@ type procedure TestWriteRead_OOXML_Alignment; procedure TestWriteRead_OOXML_Border; procedure TestWriteRead_OOXML_BorderStyles; + procedure TestWriteRead_OOXML_ColWidths; + procedure TestWriteRead_OOXML_RowHeights; procedure TestWriteRead_OOXML_DateTimeFormats; procedure TestWriteRead_OOXML_NumberFormats; procedure TestWriteRead_OOXML_TextRotation; @@ -934,6 +936,12 @@ begin TestWriteReadColWidths(sfOpenDocument); end; +procedure TSpreadWriteReadFormatTests.TestWriteRead_OOXML_ColWidths; +begin + TestWriteReadColWidths(sfOOXML); +end; + + { --- Row height tests --- } procedure TSpreadWriteReadFormatTests.TestWriteReadRowHeights(AFormat: TsSpreadsheetFormat); @@ -1005,6 +1013,11 @@ begin TestWriteReadRowHeights(sfOpenDocument); end; +procedure TSpreadWriteReadFormatTests.TestWriteRead_OOXML_RowHeights; +begin + TestWriteReadRowHeights(sfOOXML); +end; + { --- Text rotation tests --- } diff --git a/components/fpspreadsheet/tests/formulatests.pas b/components/fpspreadsheet/tests/formulatests.pas index 9fefbda07..836f52848 100644 --- a/components/fpspreadsheet/tests/formulatests.pas +++ b/components/fpspreadsheet/tests/formulatests.pas @@ -87,38 +87,43 @@ begin // Create test workbook MyWorkbook := TsWorkbook.Create; - MyWorkSheet:= MyWorkBook.AddWorksheet(SHEET); + try + MyWorkSheet:= MyWorkBook.AddWorksheet(SHEET); - // Write out all test formulas - // All formulas are in column B - WriteRPNFormulaSamples(MyWorksheet, AFormat, true); - MyWorkBook.WriteToFile(TempFile, AFormat, true); - MyWorkbook.Free; + // Write out all test formulas + // All formulas are in column B + WriteRPNFormulaSamples(MyWorksheet, AFormat, true); + MyWorkBook.WriteToFile(TempFile, AFormat, true); + finally + MyWorkbook.Free; + end; // Open the spreadsheet MyWorkbook := TsWorkbook.Create; - MyWorkbook.ReadFormulas := true; + try + MyWorkbook.ReadFormulas := true; - MyWorkbook.ReadFromFile(TempFile, AFormat); - if AFormat = sfExcel2 then - MyWorksheet := MyWorkbook.GetFirstWorksheet - else - MyWorksheet := GetWorksheetByName(MyWorkBook, SHEET); - if MyWorksheet=nil then - fail('Error in test code. Failed to get named worksheet'); - for Row := 0 to MyWorksheet.GetLastRowIndex do - begin - cell := MyWorksheet.FindCell(Row, 1); - if (cell <> nil) and (Length(cell^.RPNFormulaValue) > 0) then begin - actual := MyWorksheet.ReadRPNFormulaAsString(cell); - expected := MyWorksheet.ReadAsUTF8Text(Row, 0); - CheckEquals(expected, actual, 'Test read formula mismatch, cell '+CellNotation(MyWorkSheet,Row,1)); + MyWorkbook.ReadFromFile(TempFile, AFormat); + if AFormat = sfExcel2 then + MyWorksheet := MyWorkbook.GetFirstWorksheet + else + MyWorksheet := GetWorksheetByName(MyWorkBook, SHEET); + if MyWorksheet=nil then + fail('Error in test code. Failed to get named worksheet'); + for Row := 0 to MyWorksheet.GetLastRowIndex do + begin + cell := MyWorksheet.FindCell(Row, 1); + if (cell <> nil) and (Length(cell^.RPNFormulaValue) > 0) then begin + actual := MyWorksheet.ReadRPNFormulaAsString(cell); + expected := MyWorksheet.ReadAsUTF8Text(Row, 0); + CheckEquals(expected, actual, 'Test read formula mismatch, cell '+CellNotation(MyWorkSheet,Row,1)); + end; end; - end; - // Finalization - MyWorkbook.Free; - DeleteFile(TempFile); + finally + MyWorkbook.Free; + DeleteFile(TempFile); + end; end; procedure TSpreadWriteReadFormulaTests.TestWriteRead_BIFF2_FormulaStrings; @@ -174,94 +179,99 @@ begin // Create test workbook MyWorkbook := TsWorkbook.Create; - MyWorkSheet:= MyWorkBook.AddWorksheet(SHEET); - MyWorkSheet.Options := MyWorkSheet.Options + [soCalcBeforeSaving]; - // Calculation of rpn formulas must be activated explicitly! + try + MyWorkSheet:= MyWorkBook.AddWorksheet(SHEET); + MyWorkSheet.Options := MyWorkSheet.Options + [soCalcBeforeSaving]; + // Calculation of rpn formulas must be activated explicitly! - { Write out test formulas. - This include file creates various rpn formulas and stores the expected - results in array "sollValues". - The test file contains the text representation in column A, and the - formula in column B. } - Row := 0; - {$I testcases_calcrpnformula.inc} - TempFile:=GetTempFileName; - MyWorkBook.WriteToFile(TempFile, AFormat, true); - MyWorkbook.Free; + { Write out test formulas. + This include file creates various rpn formulas and stores the expected + results in array "sollValues". + The test file contains the text representation in column A, and the + formula in column B. } + Row := 0; + {$I testcases_calcrpnformula.inc} + TempFile:=GetTempFileName; + MyWorkBook.WriteToFile(TempFile, AFormat, true); + finally + MyWorkbook.Free; + end; // Open the workbook MyWorkbook := TsWorkbook.Create; - MyWorkbook.ReadFromFile(TempFile, AFormat); - if AFormat = sfExcel2 then - MyWorksheet := MyWorkbook.GetFirstWorksheet - else - MyWorksheet := GetWorksheetByName(MyWorkBook, SHEET); - if MyWorksheet=nil then - fail('Error in test code. Failed to get named worksheet'); + try + MyWorkbook.ReadFromFile(TempFile, AFormat); + if AFormat = sfExcel2 then + MyWorksheet := MyWorkbook.GetFirstWorksheet + else + MyWorksheet := GetWorksheetByName(MyWorkBook, SHEET); + if MyWorksheet=nil then + fail('Error in test code. Failed to get named worksheet'); - for Row := 0 to MyWorksheet.GetLastRowIndex do - begin - formula := MyWorksheet.ReadAsUTF8Text(Row, 0); - cell := MyWorksheet.FindCell(Row, 1); - if (cell = nil) then - fail('Error in test code: Failed to get cell ' + CellNotation(MyWorksheet, Row, 1)); - case cell^.ContentType of - cctBool : actual := CreateBoolArg(cell^.BoolValue); - cctNumber : actual := CreateNumberArg(cell^.NumberValue); - cctError : actual := CreateErrorArg(cell^.ErrorValue); - cctUTF8String : actual := CreateStringArg(cell^.UTF8StringValue); - else fail('ContentType not supported'); - end; - expected := SollValues[row]; - CheckEquals(ord(expected.ArgumentType), ord(actual.ArgumentType), - 'Test read calculated formula data type mismatch, formula "' + formula + - '", cell '+CellNotation(MyWorkSheet,Row,1)); + for Row := 0 to MyWorksheet.GetLastRowIndex do + begin + formula := MyWorksheet.ReadAsUTF8Text(Row, 0); + cell := MyWorksheet.FindCell(Row, 1); + if (cell = nil) then + fail('Error in test code: Failed to get cell ' + CellNotation(MyWorksheet, Row, 1)); + case cell^.ContentType of + cctBool : actual := CreateBoolArg(cell^.BoolValue); + cctNumber : actual := CreateNumberArg(cell^.NumberValue); + cctError : actual := CreateErrorArg(cell^.ErrorValue); + cctUTF8String : actual := CreateStringArg(cell^.UTF8StringValue); + else fail('ContentType not supported'); + end; + expected := SollValues[row]; + CheckEquals(ord(expected.ArgumentType), ord(actual.ArgumentType), + 'Test read calculated formula data type mismatch, formula "' + formula + + '", cell '+CellNotation(MyWorkSheet,Row,1)); - // The now function result is volatile, i.e. changes continuously. The - // time for the soll value was created such that we can expect to have - // the file value in the same second. Therefore we neglect the milliseconds. - if formula = '=NOW()' then begin - // Round soll value to seconds - DecodeTime(expected.NumberValue, hr,min,sec,msec); - expected.NumberValue := EncodeTime(hr, min, sec, 0); - // Round formula value to seconds - DecodeTime(actual.NumberValue, hr,min,sec,msec); - actual.NumberValue := EncodeTime(hr,min,sec,0); + // The now function result is volatile, i.e. changes continuously. The + // time for the soll value was created such that we can expect to have + // the file value in the same second. Therefore we neglect the milliseconds. + if formula = '=NOW()' then begin + // Round soll value to seconds + DecodeTime(expected.NumberValue, hr,min,sec,msec); + expected.NumberValue := EncodeTime(hr, min, sec, 0); + // Round formula value to seconds + DecodeTime(actual.NumberValue, hr,min,sec,msec); + actual.NumberValue := EncodeTime(hr,min,sec,0); + end; + + case actual.ArgumentType of + atBool: + CheckEquals(BoolToStr(expected.BoolValue), BoolToStr(actual.BoolValue), + 'Test read calculated formula result mismatch, formula "' + formula + + '", cell '+CellNotation(MyWorkSheet,Row,1)); + atNumber: + {$if (defined(mswindows)) or (FPC_FULLVERSION>=20701)} + // FPC 2.6.x and trunk on Windows need this, also FPC trunk on Linux x64 + CheckEquals(expected.NumberValue, actual.NumberValue, ErrorMargin, + 'Test read calculated formula result mismatch, formula "' + formula + + '", cell '+CellNotation(MyWorkSheet,Row,1)); + {$else} + // Non-Windows: test without error margin + CheckEquals(expected.NumberValue, actual.NumberValue, + 'Test read calculated formula result mismatch, formula "' + formula + + '", cell '+CellNotation(MyWorkSheet,Row,1)); + {$endif} + atString: + CheckEquals(expected.StringValue, actual.StringValue, + 'Test read calculated formula result mismatch, formula "' + formula + + '", cell '+CellNotation(MyWorkSheet,Row,1)); + atError: + CheckEquals( + GetEnumName(TypeInfo(TsErrorValue), ord(expected.ErrorValue)), + GetEnumname(TypeInfo(TsErrorValue), ord(actual.ErrorValue)), + 'Test read calculated formula error value mismatch, formula ' + formula + + ', cell '+CellNotation(MyWorkSheet,Row,1)); + end; end; - case actual.ArgumentType of - atBool: - CheckEquals(BoolToStr(expected.BoolValue), BoolToStr(actual.BoolValue), - 'Test read calculated formula result mismatch, formula "' + formula + - '", cell '+CellNotation(MyWorkSheet,Row,1)); - atNumber: - {$if (defined(mswindows)) or (FPC_FULLVERSION>=20701)} - // FPC 2.6.x and trunk on Windows need this, also FPC trunk on Linux x64 - CheckEquals(expected.NumberValue, actual.NumberValue, ErrorMargin, - 'Test read calculated formula result mismatch, formula "' + formula + - '", cell '+CellNotation(MyWorkSheet,Row,1)); - {$else} - // Non-Windows: test without error margin - CheckEquals(expected.NumberValue, actual.NumberValue, - 'Test read calculated formula result mismatch, formula "' + formula + - '", cell '+CellNotation(MyWorkSheet,Row,1)); - {$endif} - atString: - CheckEquals(expected.StringValue, actual.StringValue, - 'Test read calculated formula result mismatch, formula "' + formula + - '", cell '+CellNotation(MyWorkSheet,Row,1)); - atError: - CheckEquals( - GetEnumName(TypeInfo(TsErrorValue), ord(expected.ErrorValue)), - GetEnumname(TypeInfo(TsErrorValue), ord(actual.ErrorValue)), - 'Test read calculated formula error value mismatch, formula ' + formula + - ', cell '+CellNotation(MyWorkSheet,Row,1)); - end; + finally + MyWorkbook.Free; + DeleteFile(TempFile); end; - - // Finalization - MyWorkbook.Free; - DeleteFile(TempFile); end; procedure TSpreadWriteReadFormulaTests.TestWriteRead_BIFF2_CalcRPNFormula; diff --git a/components/fpspreadsheet/xlsxooxml.pas b/components/fpspreadsheet/xlsxooxml.pas index 522987479..6b46691c5 100755 --- a/components/fpspreadsheet/xlsxooxml.pas +++ b/components/fpspreadsheet/xlsxooxml.pas @@ -68,6 +68,7 @@ type procedure ReadBorders(ANode: TDOMNode); procedure ReadCell(ANode: TDOMNode; AWorksheet: TsWorksheet); procedure ReadCellXfs(ANode: TDOMNode); + procedure ReadCols(ANode: TDOMNode; AWorksheet: TsWorksheet); procedure ReadDateMode(ANode: TDOMNode); procedure ReadFileVersion(ANode: TDOMNode); procedure ReadFills(ANode: TDOMNode); @@ -75,6 +76,7 @@ type procedure ReadFonts(ANode: TDOMNode); procedure ReadNumFormats(ANode: TDOMNode); procedure ReadPalette(ANode: TDOMNode); + procedure ReadRowHeight(ANode: TDOMNode; AWorksheet: TsWorksheet); procedure ReadSharedStrings(ANode: TDOMNode); procedure ReadSheetList(ANode: TDOMNode; AList: TStrings); procedure ReadWorksheet(ANode: TDOMNode; AWorksheet: TsWorksheet); @@ -688,6 +690,35 @@ begin end; end; +procedure TsSpreadOOXMLReader.ReadCols(ANode: TDOMNode; AWorksheet: TsWorksheet); +var + colNode: TDOMNode; + col, col1, col2: Cardinal; + w: Double; + s: String; +begin + if ANode = nil then + exit; + + colNode := ANode.FirstChild; + while Assigned(colNode) do begin + s := GetAttrValue(colNode, 'customWidth'); + if s = '1' then begin + s := GetAttrValue(colNode, 'min'); + if s <> '' then col1 := StrToInt(s)-1 else col1 := 0; + s := GetAttrValue(colNode, 'max'); + if s <> '' then col2 := StrToInt(s)-1 else col2 := col1; + s := GetAttrValue(colNode, 'width'); + if s <> '' then begin + w := StrToFloat(s, FPointSeparatorSettings); + for col := col1 to col2 do + FWorksheet.WriteColWidth(col, w); + end; + end; + colNode := colNode.NextSibling; + end; +end; + procedure TsSpreadOOXMLReader.ReadDateMode(ANode: TDOMNode); var s: String; @@ -929,6 +960,30 @@ begin FWorkbook.UsePalette(@pal[0], n); end; +procedure TsSpreadOOXMLReader.ReadRowHeight(ANode: TDOMNode; AWorksheet: TsWorksheet); +var + s: String; + ht: Single; + r: Cardinal; + row: PRow; +begin + if ANode = nil then + exit; + s := GetAttrValue(ANode, 'customHeight'); + if s = '1' then begin + s := GetAttrValue(ANode, 'r'); + r := StrToInt(s) - 1; + s := GetAttrValue(ANode, 'ht'); + ht := StrToFloat(s, FPointSeparatorSettings); // seems to be in "Points" + row := FWorksheet.GetRow(r); + row^.Height := ht / FWorkbook.GetDefaultFontSize; + if row^.Height > ROW_HEIGHT_CORRECTION then + row^.Height := row^.Height - ROW_HEIGHT_CORRECTION + else + row^.Height := 0; + end; +end; + procedure TsSpreadOOXMLReader.ReadSharedStrings(ANode: TDOMNode); var valuenode: TDOMNode; @@ -967,6 +1022,7 @@ begin rownode := ANode.FirstChild; while Assigned(rownode) do begin if rownode.NodeName = 'row' then begin + ReadRowHeight(rownode, AWorksheet); cellnode := rownode.FirstChild; while Assigned(cellnode) do begin if cellnode.NodeName = 'c' then @@ -1068,6 +1124,7 @@ begin FWorksheet := AData.AddWorksheet(SheetList[i]); + ReadCols(Doc.DocumentElement.FindNode('cols'), FWorksheet); ReadWorksheet(Doc.DocumentElement.FindNode('sheetData'), FWorksheet); FreeAndNil(Doc);