diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas index 3a6790577..717f1bdb6 100755 --- a/components/fpspreadsheet/fpspreadsheet.pas +++ b/components/fpspreadsheet/fpspreadsheet.pas @@ -1321,8 +1321,8 @@ function GetFileFormatName(AFormat: TsSpreadsheetFormat): String; procedure MakeLEPalette(APalette: PsPalette; APaletteSize: Integer); function SameCellBorders(ACell1, ACell2: PCell): Boolean; -procedure InitCell(out ACell: TCell); overload; -procedure InitCell(ARow, ACol: Cardinal; out ACell: TCell); overload; +procedure InitCell(var ACell: TCell); overload; +procedure InitCell(ARow, ACol: Cardinal; var ACell: TCell); overload; function HasFormula(ACell: PCell): Boolean; @@ -1573,12 +1573,13 @@ end; Initalizes a new cell. @return New cell record -------------------------------------------------------------------------------} -procedure InitCell(out ACell: TCell); +procedure InitCell(var ACell: TCell); begin ACell.FormulaValue := ''; ACell.UTF8StringValue := ''; ACell.NumberFormatStr := ''; FillChar(ACell, SizeOf(ACell), 0); + ACell.BorderStyles := DEFAULT_BORDERSTYLES; end; {@@ ---------------------------------------------------------------------------- @@ -1589,7 +1590,7 @@ end; @param ACol Column index of the new cell @return New cell record with row and column fields preset to passed values. -------------------------------------------------------------------------------} -procedure InitCell(ARow, ACol: Cardinal; out ACell: TCell); +procedure InitCell(ARow, ACol: Cardinal; var ACell: TCell); begin InitCell(ACell); ACell.Row := ARow; @@ -2287,14 +2288,9 @@ begin if (Result = nil) then begin New(Result); - FillChar(Result^, SizeOf(TCell), #0); - - Result^.Row := ARow; - Result^.Col := ACol; - Result^.ContentType := cctEmpty; - Result^.BorderStyles := DEFAULT_BORDERSTYLES; - + InitCell(ARow, ACol, Result^); Cells.Add(Result); + if FFirstColIndex = $FFFFFFFF then FFirstColIndex := GetFirstColIndex(true) else FFirstColIndex := Min(FFirstColIndex, ACol); if FFirstRowIndex = $FFFFFFFF then FFirstRowIndex := GetFirstRowIndex(true) diff --git a/components/fpspreadsheet/tests/copytests.pas b/components/fpspreadsheet/tests/copytests.pas index 622a0904a..1061c5cc6 100644 --- a/components/fpspreadsheet/tests/copytests.pas +++ b/components/fpspreadsheet/tests/copytests.pas @@ -14,7 +14,7 @@ uses testsutility; var - SourceCells: Array[0..6] of TCell; + SourceCells: Array[0..9] of TCell; procedure InitCopyData; @@ -32,48 +32,68 @@ type published procedure Test_CopyValuesToEmptyCells; -// procedure Test_Copy_Format; -// procedure Test_Copy_Formula; + procedure Test_CopyValuesToOccupiedCells; + + procedure Test_CopyFormatsToEmptyCells; + procedure Test_CopyFormatsToOccupiedCells; end; implementation uses - TypInfo, Math, fpsutils; + TypInfo, fpsutils; const CopyTestSheet = 'Copy'; -function InitNumber(ANumber: Double): TCell; +function InitNumber(ANumber: Double; ABkColor: TsColor): TCell; begin InitCell(Result); Result.ContentType := cctNumber; Result.Numbervalue := ANumber; + if (ABkColor <> scNotDefined) and (ABkColor <> scTransparent) then + begin + Result.UsedFormattingFields := Result.UsedFormattingFields + [uffBackgroundColor]; + Result.BackgroundColor := ABkColor; + end; end; -function InitString(AString: String): TCell; +function InitString(AString: String; ABkColor: TsColor): TCell; begin InitCell(Result); Result.ContentType := cctUTF8String; Result.UTF8StringValue := AString; + if (ABkColor <> scNotDefined) and (ABkColor <> scTransparent) then + begin + Result.UsedFormattingFields := Result.UsedFormattingFields + [uffBackgroundColor]; + Result.BackgroundColor := ABkColor; + end; end; -function InitFormula(AFormula: String; ANumberResult: Double): TCell; +function InitFormula(AFormula: String; ANumberResult: Double; ABkColor: TsColor): TCell; begin InitCell(Result); Result.FormulaValue := AFormula; Result.NumberValue := ANumberResult; Result.ContentType := cctNumber; + if (ABkColor <> scNotDefined) and (ABkColor <> scTransparent) then + begin + Result.UsedFormattingFields := Result.UsedFormattingFields + [uffBackgroundColor]; + Result.BackgroundColor := ABkColor; + end; end; procedure InitCopyData; begin - SourceCells[0] := InitNumber(1.0); // will be in A1 - SourceCells[1] := InitNumber(2.0); - SourceCells[2] := InitNumber(3.0); - SourceCells[3] := InitString('Lazarus'); - SourceCells[4] := InitFormula('A1+1', 2.0); - InitCell(SourceCells[5]); // empty but existing + SourceCells[0] := InitNumber(1.0, scTransparent); // will be in A1 + SourceCells[1] := InitNumber(2.0, scTransparent); + SourceCells[2] := InitNumber(3.0, scYellow); + SourceCells[3] := InitString('Lazarus', scRed); + SourceCells[4] := InitFormula('A1+1', 2.0, scTransparent); + SourceCells[5] := InitFormula('$A1+1', 2.0, scTransparent); + SourceCells[6] := InitFormula('A$1+1', 2.0, scTransparent); + SourceCells[7] := InitFormula('$A$1+1', 2.0, scGray); + InitCell(SourceCells[8]); // empty but existing end; @@ -112,28 +132,60 @@ begin MyWorkSheet:= MyWorkBook.AddWorksheet(CopyTestSheet); - // Create two identical columns A and B - for row := 0 to High(SourceCells) do - for col := 0 to 1 do + // Prepare the worksheet in which cells are copied: + // Store the SourceCells to column A and B; in B shifted down by 1 cell + { A B + 1 1.0 + 2 2.0 1.0 + 3 3.0 (yellow) 2.0 + 4 Lazarus (red) 3.0 + 5 A1+1 Lazarus + 6 $A1+1 A1+1 + 7 A$1+1 $A1+1 + 8 $A$1+1 (gray) A$1+1 + 9 (empty) $A$1+1 (gray) + 10 (empty) + } + for col := 0 to 1 do + for row := 0 to High(SourceCells) do begin + // Why is there a row index of "row + col" below? The first column has the + // data starting at the top, in cell A1. In the second column each row + // index is incremented by 1, i.e. the data are shifted down by 1 cell. case SourceCells[row].ContentType of cctNumber: - cell := MyWorksheet.WriteNumber(row, col, SourceCells[row].NumberValue); + cell := MyWorksheet.WriteNumber(row+col, col, SourceCells[row].NumberValue); cctUTF8String: - cell := Myworksheet.WriteUTF8Text(row, col, SourceCells[row].UTF8StringValue); + cell := Myworksheet.WriteUTF8Text(row+col, col, SourceCells[row].UTF8StringValue); cctEmpty: - cell := MyWorksheet.WriteBlank(row, col); + cell := MyWorksheet.WriteBlank(row+col, col); end; if SourceCells[row].FormulaValue <> '' then - Myworksheet.WriteFormula(row, col, SourceCells[row].FormulaValue); + Myworksheet.WriteFormula(row+col, col, SourceCells[row].FormulaValue); + if (uffBackgroundColor in SourceCells[row].UsedFormattingFields) then + MyWorksheet.WriteBackgroundColor(cell, SourceCells[row].BackgroundColor); end; MyWorksheet.CalcFormulas; + // Now perform the "copy" operations case ATestKind of - 1: // copy the source cell values to the empty column C - for row := 0 to High(SourceCells) do - Myworksheet.CopyValue(MyWorksheet.FindCell(row, 0), row, 2); + 1, 2: + // copy the source cell VALUES to the empty column C (ATestKind = 1) + // or occupied column B (ATestKind = 2) + begin + if ATestKind = 1 then col := 2 else col := 1; + for row := 0 to High(SourceCells) do + Myworksheet.CopyValue(MyWorksheet.FindCell(row, 0), row, col); + end; + 3, 4: + // copy the source cell FORMATS to the empty column C (ATestKind = 1) + // or occupied column B (ATestKind = 2) + begin + if ATestKind = 1 then col := 2 else col := 1; + for row := 0 to High(SourceCells) do + MyWorksheet.CopyFormat(MyWorksheet.FindCell(row, 0), row, col); + end; end; // Write to file @@ -150,41 +202,186 @@ begin MyWorksheet := MyWorkbook.GetFirstWorksheet; case ATestKind of - 1: // Copied values in first colum to empty third column - // The formula cell should contain the result of A1+1 (only value copied) - begin - col := 2; - // Number cells - for row := 0 to High(SourceCells) do - begin - cell := MyWorksheet.FindCell(row, col); - if (SourceCells[row].ContentType in [cctNumber, cctUTF8String, cctEmpty]) then - CheckEquals( - GetEnumName(TypeInfo(TCellContentType), Integer(SourceCells[row].ContentType)), - GetEnumName(TypeInfo(TCellContentType), Integer(cell^.ContentType)), - 'Content type mismatch, cell '+CellNotation(MyWorksheet, row, col)); + 1, 2: + // Copied VALUES in first colum to empty third column (ATestKind = 1) or + // occuopied second column (ATestKind = 2) + // The formula cell should contain the result of A1+1 (only value copied) + begin + if ATestKind = 1 then col := 2 else col := 1; + for row := 0 to Length(SourceCells) do + begin + cell := MyWorksheet.FindCell(row, col); - case SourceCells[row].ContentType of - cctNumber: - CheckEquals( - SourceCells[row].NumberValue, - cell^.NumberValue, - 'Number value mismatch, cell ' + CellNotation(MyWorksheet, row, col)); - cctUTF8String: - CheckEquals( - SourceCells[row].UTF8StringValue, - cell^.UTF8StringValue, - 'String value mismatch, cell ' + CellNotation(MyWorksheet, row, col)); - end; + if row < Length(SourceCells) then + begin + // Check content type + if (SourceCells[row].ContentType in [cctNumber, cctUTF8String, cctEmpty]) then + CheckEquals( + GetEnumName(TypeInfo(TCellContentType), Integer(SourceCells[row].ContentType)), + GetEnumName(TypeInfo(TCellContentType), Integer(cell^.ContentType)), + 'Content type mismatch, cell '+CellNotation(MyWorksheet, row, col) + ); - if HasFormula(@SourceCells[row]) then - CheckEquals( - SourceCells[0].NumberValue + 1, - cell^.NumberValue, - 'Result of copied formula mismatch, cell ' + CellNotation(MyWorksheet, row, col)); + // Check values + case SourceCells[row].ContentType of + cctNumber: + CheckEquals( + SourceCells[row].NumberValue, + cell^.NumberValue, + 'Number value mismatch, cell ' + CellNotation(MyWorksheet, row, col) + ); + cctUTF8String: + CheckEquals( + SourceCells[row].UTF8StringValue, + cell^.UTF8StringValue, + 'String value mismatch, cell ' + CellNotation(MyWorksheet, row, col) + ); + end; + + // Check formula results + if HasFormula(@SourceCells[row]) then + CheckEquals( + SourceCells[0].NumberValue + 1, + cell^.NumberValue, + 'Result of copied formula mismatch, cell ' + CellNotation(MyWorksheet, row, col) + ); + end; + + // Check format: it should not be changed when copying only values + case ATestKind of + 1: // Copy to empty column --> no formatting + CheckEquals( + true, // true = "the cell has default formatting" + (cell = nil) or (cell^.UsedFormattingFields = []), + 'Default format mismatch, cell ' + CellNotation(MyWorksheet, row,col) + ); + 2: // Copy to occupied column --> format like source, but shifted down 1 cvell + if row = 0 then // this cell should not be formatted + CheckEquals( + true, + cell^.UsedFormattingFields = [], + 'Formatting fields mismatch, cell ' + CellNotation(MyWorksheet, row, col) + ) + else + begin + CheckEquals( + true, + SourceCells[row-1].UsedFormattingFields = cell^.UsedFormattingFields, + 'Formatting fields mismatch, cell ' + CellNotation(MyWorksheet, row, col) + ); + if (uffBackgroundColor in cell^.UsedFormattingFields) then + CheckEquals( + SourceCells[row-1].BackgroundColor, + cell^.BackgroundColor, + 'Background color mismatch, cell '+ CellNotation(MyWorksheet, row, col) + ); + end; + end; + end; + end; + + { ------------------------------------------------ } + + 3: // FORMATs copied from first column to empty third column + begin + col := 2; + for row :=0 to Length(SourceCells)-1 do + begin + cell := MyWorksheet.FindCell(row, col); + + // There should not be any content because the column was empty and + // we had copied only formats + CheckEquals( + true, // true = "the cell has no content" + (cell = nil) or (cell^.ContentType = cctEmpty), + 'No content mismatch, cell ' + CellNotation(MyWorksheet, row,col) + ); + + // Check the format: it should be identical to that in column A + if cell <> nil then + begin + CheckEquals( + true, + SourceCells[row].UsedFormattingFields = cell^.UsedFormattingFields, + 'Formatting fields mismatch, cell ' + CellNotation(MyWorksheet, row, col) + ); + if (uffBackgroundColor in cell^.UsedFormattingFields) then + CheckEquals( + SourceCells[row].BackgroundColor, + cell^.BackgroundColor, + 'Background color mismatch, cell '+ CellNotation(MyWorksheet, row, col) + ); + end; + end; + end; + + { ---------------------------- } + + 4: // FORMATs copied from 1st to second column. + begin + col := 1; + + // Check values: they should be unchanged, i.e. identical to column A, + // but there is a vertical offset by 1 cell + cell := MyWorksheet.FindCell(0, col); + CheckEquals( + true, // true = "the cell has no content" + (cell = nil) or (cell^.ContentType = cctEmpty), + 'No content mismatch, cell ' + CellNotation(MyWorksheet, row,col) + ); + for row := 1 to Length(SourceCells) do + begin + cell := MyWorksheet.FindCell(row, col); + // Check content type + if (SourceCells[row-1].ContentType in [cctNumber, cctUTF8String, cctEmpty]) then + CheckEquals( + GetEnumName(TypeInfo(TCellContentType), Integer(SourceCells[row-1].ContentType)), + GetEnumName(TypeInfo(TCellContentType), Integer(cell^.ContentType)), + 'Content type mismatch, cell '+CellNotation(MyWorksheet, row, col) + ); + // Check values + case SourceCells[row-1].ContentType of + cctNumber: + CheckEquals( + SourceCells[row-1].NumberValue, + cell^.NumberValue, + 'Number value mismatch, cell ' + CellNotation(MyWorksheet, row, col) + ); + cctUTF8String: + CheckEquals( + SourceCells[row-1].UTF8StringValue, + cell^.UTF8StringValue, + 'String value mismatch, cell ' + CellNotation(MyWorksheet, row, col) + ); + end; + // Check formula results + if HasFormula(@SourceCells[row-1]) then + CheckEquals( + SourceCells[0].NumberValue + 1, + cell^.NumberValue, + 'Result of copied formula mismatch, cell ' + CellNotation(MyWorksheet, row, col) + ); + end; + + // Now check formatting - it should be equal to first column + for row := 0 to Length(SourceCells)-1 do + begin + cell := MyWorksheet.FindCell(row, col); + CheckEquals( + true, + SourceCells[row].UsedFormattingFields = cell^.UsedFormattingFields, + 'Formatting fields mismatch, cell ' + CellNotation(MyWorksheet, row, col) + ); + + if (uffBackgroundColor in cell^.UsedFormattingFields) then + CheckEquals( + SourceCells[row].BackgroundColor, + cell^.BackgroundColor, + 'Background color mismatch, cell '+ CellNotation(MyWorksheet, row, col) + ); + end; + end; - end; - end; end; finally @@ -200,6 +397,24 @@ begin Test_Copy(1); end; +{ Copy given cell values to occupied cells } +procedure TSpreadCopyTests.Test_CopyValuesToOccupiedCells; +begin + Test_Copy(2); +end; + +{ Copy given cell formats to empty cells } +procedure TSpreadCopyTests.Test_CopyFormatsToEmptyCells; +begin + Test_Copy(3); +end; + +{ Copy given cell formats to occupied cells } +procedure TSpreadCopyTests.Test_CopyFormatsToOccupiedCells; +begin + Test_Copy(4); +end; + initialization RegisterTest(TSpreadCopyTests); diff --git a/components/fpspreadsheet/tests/formattests.pas b/components/fpspreadsheet/tests/formattests.pas index 01fd62fd0..860abb8c1 100644 --- a/components/fpspreadsheet/tests/formattests.pas +++ b/components/fpspreadsheet/tests/formattests.pas @@ -639,8 +639,8 @@ begin if MyCell = nil then fail('Error in test code. Failed to get cell.'); vertAlign := TsVertAlignment(row); - if (vertAlign = vaDefault) and (AFormat in [sfExcel5, sfExcel8]) then - vertAlign := vaBottom; + if (vertAlign = vaBottom) and (AFormat in [sfExcel5, sfExcel8]) then + vertAlign := vaDefault; CheckEquals( GetEnumName(TypeInfo(TsVertAlignment), Integer(vertAlign)), GetEnumName(TypeInfo(TsVertAlignment), Integer(MyCell^.VertAlignment)), diff --git a/components/fpspreadsheet/tests/spreadtestgui.lpi b/components/fpspreadsheet/tests/spreadtestgui.lpi index d9c45b0a4..9b7f3012a 100644 --- a/components/fpspreadsheet/tests/spreadtestgui.lpi +++ b/components/fpspreadsheet/tests/spreadtestgui.lpi @@ -48,6 +48,7 @@ + @@ -60,6 +61,7 @@ + @@ -68,6 +70,7 @@ + @@ -106,6 +109,7 @@ + @@ -114,11 +118,11 @@ + - diff --git a/components/fpspreadsheet/xlsbiff5.pas b/components/fpspreadsheet/xlsbiff5.pas index 6185be6e4..5417d8c5b 100755 --- a/components/fpspreadsheet/xlsbiff5.pas +++ b/components/fpspreadsheet/xlsbiff5.pas @@ -1380,7 +1380,15 @@ begin // Vertical text alignment b := (xf.Align_TextBreak AND MASK_XF_VERT_ALIGN) shr 4; if (b + 1 <= ord(high(TsVertAlignment))) then - lData.VertAlignment := tsVertAlignment(b + 1) // + 1 due to vaDefault + begin + lData.VertAlignment := tsVertAlignment(b + 1); // + 1 due to vaDefault + // Unfortunately BIFF does not provide a "default" vertical alignment code. + // Without the following correction "non-formatted" cells would always have + // the uffVertAlign FormattingField set which contradicts the statement of + // not being formatted. + if lData.VertAlignment = vaBottom then + lData.VertAlignment := vaDefault; + end else lData.VertAlignment := vaDefault; @@ -1403,22 +1411,26 @@ begin // The case of "no line" is not included in the TsLineStyle enumeration. // --> correct by subtracting 1! dw := xf.Border_Background_1 and MASK_XF_BORDER_BOTTOM; - if dw <> 0 then begin + if dw <> 0 then + begin Include(lData.Borders, cbSouth); lData.BorderStyles[cbSouth].LineStyle := TsLineStyle(dw shr 22 - 1); end; dw := xf.Border_Background_2 and MASK_XF_BORDER_LEFT; - if dw <> 0 then begin + if dw <> 0 then + begin Include(lData.Borders, cbWest); lData.BorderStyles[cbWest].LineStyle := TsLineStyle(dw shr 3 - 1); end; dw := xf.Border_Background_2 and MASK_XF_BORDER_RIGHT; - if dw <> 0 then begin + if dw <> 0 then + begin Include(lData.Borders, cbEast); lData.BorderStyles[cbEast].LineStyle := TsLineStyle(dw shr 6 - 1); end; dw := xf.Border_Background_2 and MASK_XF_BORDER_TOP; - if dw <> 0 then begin + if dw <> 0 then + begin Include(lData.Borders, cbNorth); lData.BorderStyles[cbNorth].LineStyle := TsLineStyle(dw - 1); end; diff --git a/components/fpspreadsheet/xlsbiff8.pas b/components/fpspreadsheet/xlsbiff8.pas index b45736c66..9120077ff 100755 --- a/components/fpspreadsheet/xlsbiff8.pas +++ b/components/fpspreadsheet/xlsbiff8.pas @@ -1966,7 +1966,15 @@ begin // Vertical text alignment b := (xf.Align_TextBreak AND MASK_XF_VERT_ALIGN) shr 4; if (b + 1 <= ord(high(TsVertAlignment))) then - lData.VertAlignment := tsVertAlignment(b + 1) // + 1 due to vaDefault + begin + lData.VertAlignment := tsVertAlignment(b + 1); // + 1 due to vaDefault + // Unfortunately BIFF does not provide a "default" vertical alignment code. + // Without the following correction "non-formatted" cells would always have + // the uffVertAlign FormattingField set which contradicts the statement of + // not being formatted. + if lData.VertAlignment = vaBottom then + lData.VertAlignment := vaDefault; + end else lData.VertAlignment := vaDefault; @@ -1988,27 +1996,32 @@ begin // the 4 masked bits encode the line style of the border line. 0 = no line dw := xf.Border_Background_1 and MASK_XF_BORDER_LEFT; - if dw <> 0 then begin + if dw <> 0 then + begin Include(lData.Borders, cbWest); lData.BorderStyles[cbWest].LineStyle := FixLineStyle(dw); end; dw := xf.Border_Background_1 and MASK_XF_BORDER_RIGHT; - if dw <> 0 then begin + if dw <> 0 then + begin Include(lData.Borders, cbEast); lData.BorderStyles[cbEast].LineStyle := FixLineStyle(dw shr 4); end; dw := xf.Border_Background_1 and MASK_XF_BORDER_TOP; - if dw <> 0 then begin + if dw <> 0 then + begin Include(lData.Borders, cbNorth); lData.BorderStyles[cbNorth].LineStyle := FixLineStyle(dw shr 8); end; dw := xf.Border_Background_1 and MASK_XF_BORDER_BOTTOM; - if dw <> 0 then begin + if dw <> 0 then + begin Include(lData.Borders, cbSouth); lData.BorderStyles[cbSouth].LineStyle := FixLineStyle(dw shr 12); end; dw := xf.Border_Background_2 and MASK_XF_BORDER_DIAGONAL; - if dw <> 0 then begin + if dw <> 0 then + begin lData.BorderStyles[cbDiagUp].LineStyle := FixLineStyle(dw shr 21); lData.BorderStyles[cbDiagDown].LineStyle := lData.BorderStyles[cbDiagUp].LineStyle; if xf.Border_Background_1 and MASK_XF_BORDER_SHOW_DIAGONAL_UP <> 0 then diff --git a/components/fpspreadsheet/xlscommon.pas b/components/fpspreadsheet/xlscommon.pas index 2e1c03b39..e6e9bc52d 100644 --- a/components/fpspreadsheet/xlscommon.pas +++ b/components/fpspreadsheet/xlscommon.pas @@ -321,7 +321,6 @@ type function GetLastRowIndex(AWorksheet: TsWorksheet): Integer; procedure GetLastColCallback(ACell: PCell; AStream: TStream); function GetLastColIndex(AWorksheet: TsWorksheet): Word; -// function FormulaElementKindToExcelTokenID(AElementKind: TFEKind; out ASecondaryID: Word): Word; // Helper function for writing a string with 8-bit length } function WriteString_8BitLen(AStream: TStream; AString: String): Integer; virtual;