diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas index 34f132ad3..9f14cf1ce 100755 --- a/components/fpspreadsheet/fpspreadsheet.pas +++ b/components/fpspreadsheet/fpspreadsheet.pas @@ -28,6 +28,7 @@ type TsSpreadsheetFormatLimitations = record MaxRowCount: Cardinal; MaxColCount: Cardinal; + MaxPaletteSize: Cardinal; end; const @@ -859,7 +860,8 @@ type { Color handling } function AddColorToPalette(AColorValue: TsColorValue): TsColor; - function FindClosestColor(AColorValue: TsColorValue): TsColor; + function FindClosestColor(AColorValue: TsColorValue; + AMaxPaletteCount: Integer): TsColor; function FPSColorToHexString(AColor: TsColor; ARGBColor: TFPColor): String; function GetColorName(AColorIndex: TsColor): string; function GetPaletteColor(AColorIndex: TsColor): TsColorValue; @@ -869,6 +871,7 @@ type procedure UseDefaultPalette; procedure UsePalette(APalette: PsPalette; APaletteCount: Word; ABigEndian: Boolean = false); + function UsesColor(AColorIndex: TsColor): Boolean; { Error messages } procedure AddErrorMsg(const AMsg: String); overload; @@ -987,6 +990,8 @@ type FWorkbook: TsWorkbook; {@@ Instance of the worksheet which is currently being read. } FWorksheet: TsWorksheet; + {@@ Limitations for the specific data file format } + FLimitations: TsSpreadsheetFormatLimitations; protected {@@ List of number formats found in the file } FNumFormatList: TsCustomNumFormatList; @@ -994,6 +999,7 @@ type public constructor Create(AWorkbook: TsWorkbook); virtual; // to allow descendents to override it destructor Destroy; override; + function Limitations: TsSpreadsheetFormatLimitations; {@@ Instance of the workbook which is currently being read/written. } property Workbook: TsWorkbook read FWorkbook; {@@ List of number formats found in the workbook. } @@ -1048,13 +1054,13 @@ type for each individual file format. } TsCustomSpreadWriter = class(TsCustomSpreadReaderWriter) protected - {@@ Limitations for the specific data file format } - FLimitations: TsSpreadsheetFormatLimitations; { Helper routines } procedure AddDefaultFormats(); virtual; procedure CheckLimitations; function ExpandFormula(AFormula: TsFormula): TsExpandedFormula; function FindFormattingInList(AFormat: PCell): Integer; + procedure FixCellColors(ACell: PCell); + function FixColor(AColor: TsColor): TsColor; virtual; procedure FixFormat(ACell: PCell); virtual; procedure GetSheetDimensions(AWorksheet: TsWorksheet; out AFirstRow, ALastRow, AFirstCol, ALastCol: Cardinal); virtual; @@ -1089,7 +1095,6 @@ type public constructor Create(AWorkbook: TsWorkbook); override; - function Limitations: TsSpreadsheetFormatLimitations; { General writing methods } procedure IterateThroughCells(AStream: TStream; ACells: TAVLTree; ACallback: TCellsCallback); procedure WriteToFile(const AFileName: string; const AOverwriteExisting: Boolean = False); virtual; @@ -1169,8 +1174,13 @@ resourcestring lpUnsupportedWriteFormat = 'Tried to write a spreadsheet using an unsupported format'; lpNoValidSpreadsheetFile = '"%s" is not a valid spreadsheet file'; lpUnknownSpreadsheetFormat = 'unknown format'; - lpMaxRowsExceeded = 'This workbook contains %d rows, but the selected file format does not support more than %d rows.'; - lpMaxColsExceeded = 'This workbook contains %d columns, but the selected file format does not support more than %d columns.'; + lpMaxRowsExceeded = 'This workbook contains %d rows, but the selected ' + + 'file format does not support more than %d rows.'; + lpMaxColsExceeded = 'This workbook contains %d columns, but the selected ' + + 'file format does not support more than %d columns.'; + lpTooManyPaletteColors = 'This workbook contains more colors (%d) than are ' + + 'supported by the file format (%d). The redundant colors are replaced by '+ + 'the best-matching palette colors.'; lpInvalidFontIndex = 'Invalid font index'; lpInvalidNumberFormat = 'Trying to use an incompatible number format.'; lpInvalidDateTimeFormat = 'Trying to use an incompatible date/time format.'; @@ -5315,7 +5325,7 @@ begin SameText(AFontName, fnt.FontName) and (abs(ASize - fnt.Size) < 0.001) and // careful when comparing floating point numbers (AStyle = fnt.Style) and - (AColor = fnt.Color) + (AColor = fnt.Color) // Take care of limited palette size! then exit; end; @@ -5496,27 +5506,33 @@ end; Finds the palette color index which points to a color that is closest to a given color. "Close" means here smallest length of the rgb-difference vector. - @param AColorValue Rgb color value to be considered + @param AColorValue Rgb color value to be considered + @param AMaxPaletteCount Number of palette entries considered. Example: + BIFF5/BIFF8 can write only 64 colors, i.e + AMaxPaletteCount = 64 @return Palette index of the color closest to AColorValue } -function TsWorkbook.FindClosestColor(AColorValue: TsColorValue): TsColor; +function TsWorkbook.FindClosestColor(AColorValue: TsColorValue; + AMaxPaletteCount: Integer): TsColor; type TRGBA = record r,g,b, a: Byte end; var rgb: TRGBA; rgb0: TRGBA absolute AColorValue; dist: Double; - mindist: Double; + minDist: Double; i: Integer; + n: Integer; begin Result := scNotDefined; - mindist := 1E108; - for i:=0 to Length(FPalette)-1 do begin + minDist := 1E108; + n := Min(Length(FPalette), AMaxPaletteCount); + for i:=0 to n-1 do begin rgb := TRGBA(GetPaletteColor(i)); dist := sqr(rgb.r - rgb0.r) + sqr(rgb.g - rgb0.g) + sqr(rgb.b - rgb0.b); - if dist < mindist then begin + if dist < minDist then begin Result := i; - mindist := dist; + minDist := dist; end; end; end; @@ -5685,6 +5701,45 @@ begin {$ENDIF} end; +{@@ + Checks whether a given color is used somewhere within the entire workbook + + @param AColorIndex Palette index of the color + @result True if the color is used by at least one cell, false if not. +} +function TsWorkbook.UsesColor(AColorIndex: TsColor): Boolean; +var + Node: TAVLTreeNode; + sheet: TsWorksheet; + cell: PCell; + i: Integer; + fnt: TsFont; + b: TsCellBorder; +begin + Result := true; + for i:=0 to GetWorksheetCount-1 do begin + sheet := GetWorksheetByIndex(i); + Node := sheet.Cells.FindLowest; + while Assigned(Node) do + begin + cell := PCell(Node.Data); + if (uffBackgroundColor in cell^.UsedFormattingFields) then + if cell^.BackgroundColor = AColorIndex then exit; + if (uffBorder in cell^.UsedFormattingFields) then + for b in TsCellBorders do + if cell^.BorderStyles[b].Color = AColorIndex then + exit; + if (uffFont in cell^.UsedFormattingFields) then + begin + fnt := GetFont(cell^.FontIndex); + if fnt.Color = AColorIndex then + exit; + end; + Node := sheet.Cells.FindSuccessor(Node); + end; + end; + Result := false; +end; { TsCustomNumFormatList } @@ -6073,6 +6128,11 @@ constructor TsCustomSpreadReaderWriter.Create(AWorkbook: TsWorkbook); begin inherited Create; FWorkbook := AWorkbook; + { A good starting point valid for many formats ... } + FLimitations.MaxColCount := 256; + FLimitations.MaxRowCount := 65536; + FLimitations.MaxPaletteSize := $FFFFFFFF; + // Number formats CreateNumFormatList; end; @@ -6097,6 +6157,14 @@ begin // nothing to do here end; +{@@ + Returns a record containing limitations of the specific file format of the + writer. +} +function TsCustomSpreadReaderWriter.Limitations: TsSpreadsheetFormatLimitations; +begin + Result := FLimitations; +end; { TsCustomSpreadReader } @@ -6209,9 +6277,6 @@ end; constructor TsCustomSpreadWriter.Create(AWorkbook: TsWorkbook); begin inherited Create(AWorkbook); - { A good starting point valid for many formats... } - FLimitations.MaxColCount := 256; - FLimitations.MaxRowCount := 65536; end; {@@ @@ -6226,6 +6291,7 @@ var i, n: Integer; b: TsCellBorder; equ: Boolean; + clr: TsColor; begin Result := -1; @@ -6251,7 +6317,7 @@ begin equ := false; Break; end; - if FFormattingStyles[i].BorderStyles[b].Color <> AFormat^.BorderStyles[b].Color + if FFormattingStyles[i].BorderStyles[b].Color <> FixColor(AFormat^.BorderStyles[b].Color) then begin equ := false; Break; @@ -6261,7 +6327,7 @@ begin end; if uffBackgroundColor in AFormat^.UsedFormattingFields then - if (FFormattingStyles[i].BackgroundColor <> AFormat^.BackgroundColor) then Continue; + if (FFormattingStyles[i].BackgroundColor <> FixColor(AFormat^.BackgroundColor)) then Continue; if uffNumberFormat in AFormat^.UsedFormattingFields then begin if (FFormattingStyles[i].NumberFormat <> AFormat^.NumberFormat) then Continue; @@ -6276,6 +6342,41 @@ begin end; end; +{@@ + Makes sure that all colors used in a given cell belong to the workbook's + color palette. +} +procedure TsCustomSpreadWriter.FixCellColors(ACell: PCell); +var + b: TsCellBorder; +begin + if ACell = nil then + exit; + + ACell^.BackgroundColor := FixColor(ACell^.BackgroundColor); + + for b in TsCellBorders do + ACell^.BorderStyles[b].Color := FixColor(ACell^.BorderStyles[b].Color); + + // Font color is not corrected here because this would affect other writers. + // Font color is handled immediately before writing. +end; + +{@@ + If a color index is greater then the maximum palette color count this + color is replaced by the closest palette color. + + The present implementation does not change the color. Must be overridden by + writers of formats with limited palette sizes. + + @param AColor Color palette index to be checked + @return Closest color to AColor. If AColor belongs to the palette it must + be returned unchanged. } +function TsCustomSpreadWriter.FixColor(AColor: TsColor): TsColor; +begin + Result := AColor; +end; + {@@ If formatting features of a cell are not supported by the destination file format of the writer, here is the place to apply replacements. @@ -6291,15 +6392,6 @@ begin // to be overridden end; -{@@ - Returns a record containing limitations of the specific file format of the - writer. -} -function TsCustomSpreadWriter.Limitations: TsSpreadsheetFormatLimitations; -begin - Result := FLimitations; -end; - {@@ Determines the size of the worksheet to be written. VirtualMode is respected. Is called when the writer needs the size for output. Column and row count @@ -6354,14 +6446,29 @@ end; procedure TsCustomSpreadWriter.CheckLimitations; var lastCol, lastRow: Cardinal; + i, n: Integer; + fnt: TsFont; begin Workbook.GetLastRowColIndex(lastRow, lastCol); + + // Check row count if lastRow >= FLimitations.MaxRowCount then Workbook.AddErrorMsg(lpMaxRowsExceeded, [lastRow+1, FLimitations.MaxRowCount]); + + // Check column count if lastCol >= FLimitations.MaxColCount then Workbook.AddErrorMsg(lpMaxColsExceeded, [lastCol+1, FLimitations.MaxColCount]); -end; + // Check color count. + n := Workbook.GetPaletteSize; + if n > FLimitations.MaxPaletteSize then + for i:= FLimitations.MaxPaletteSize to n-1 do + if Workbook.UsesColor(i) then + begin + Workbook.AddErrorMsg(lpTooManyPaletteColors, [n, FLimitations.MaxPaletteSize]); + break; + end; +end; {@@ Callback function for collecting all formatting styles found in the worksheet. @@ -6385,6 +6492,10 @@ begin SetLength(FFormattingStyles, Len+1); FFormattingStyles[Len] := ACell^; + // Make sure that all colors of the formatting style cell are used in the workbook's + // palette. + FixCellColors(@FFormattingStyles[Len]); + // We store the index of the XF record that will be assigned to this style in // the "row" of the style. Will be needed when writing the XF record. FFormattingStyles[Len].Row := NextXFIndex; diff --git a/components/fpspreadsheet/tests/errortests.pas b/components/fpspreadsheet/tests/errortests.pas index 4a441610d..c1b25ebb2 100644 --- a/components/fpspreadsheet/tests/errortests.pas +++ b/components/fpspreadsheet/tests/errortests.pas @@ -35,7 +35,7 @@ type implementation uses - StrUtils; + StrUtils, xlsbiff5; const ERROR_SHEET = 'ErrorTest'; //worksheet name @@ -65,6 +65,7 @@ var s: String; TempFile: String; ErrList: TStringList; + newColor: TsColor; begin formula.FormulaStr := '=A1'; formula.DoubleValue := 0.0; @@ -77,7 +78,7 @@ begin MyWorkSheet:= MyWorkBook.AddWorksheet(ERROR_SHEET); row1 := MAX_ROW_COUNT[TTestFormat(AFormat)] - 5; row2 := MAX_ROW_COUNT[TTestFormat(AFormat)] + 5; - for row :=row1 to row2 do begin + for row := row1 to row2 do begin MyWorksheet.WriteBlank(row, 0); MyWorksheet.WriteNumber(row, 1, 1.0); MyWorksheet.WriteUTF8Text(row, 2, 'A'); @@ -117,7 +118,31 @@ begin DeleteFile(TempFile); end; - // Test 3: Too long cell label + // Test 3: Too many colors + if (TTestFormat(AFormat) in [sfExcel2, sfExcel5, sfExcel8]) then begin + MyWorkbook := TsWorkbook.Create; + try + // Prepare a full palette + MyWorkbook.UsePalette(@PALETTE_BIFF5[0], Length(PALETTE_BIFF5)); + // Add 1 more color - this is one too many for BIFF5 and 8, and a lot + // too many for BIFF2 ! + newColor := MyWorkbook.AddColorToPalette($FF7878); + + MyWorkSheet:= MyWorkBook.AddWorksheet(ERROR_SHEET); + MyWorksheet.WriteUTF8Text(0, 0, s); + MyWorksheet.WriteFontColor(0, 0, newColor); + + TempFile:=NewTempFile; + MyWorkBook.WriteToFile(TempFile, AFormat, true); + ErrList.Text := MyWorkbook.ErrorMsg; + CheckEquals(1, ErrList.Count, 'Error count mismatch in test 3'); + finally + MyWorkbook.Free; + DeleteFile(TempFile); + end; + end; + + // Test 4: Too long cell label if MAX_CELL_LEN[TTestFormat(AFormat)] <> Cardinal(-1) then begin s := DupeString('A', MAX_CELL_LEN[TTestFormat(AFormat)] + 10); MyWorkbook := TsWorkbook.Create; @@ -127,7 +152,7 @@ begin TempFile:=NewTempFile; MyWorkBook.WriteToFile(TempFile, AFormat, true); ErrList.Text := MyWorkbook.ErrorMsg; - CheckEquals(1, ErrList.Count, 'Error count mismatch in test 3'); + CheckEquals(1, ErrList.Count, 'Error count mismatch in test 4'); finally MyWorkbook.Free; DeleteFile(TempFile); diff --git a/components/fpspreadsheet/tests/spreadtestgui.lpi b/components/fpspreadsheet/tests/spreadtestgui.lpi index f03ad7c7a..f32a86606 100644 --- a/components/fpspreadsheet/tests/spreadtestgui.lpi +++ b/components/fpspreadsheet/tests/spreadtestgui.lpi @@ -82,6 +82,7 @@ + diff --git a/components/fpspreadsheet/xlsbiff2.pas b/components/fpspreadsheet/xlsbiff2.pas index 9269483e5..77450ba59 100755 --- a/components/fpspreadsheet/xlsbiff2.pas +++ b/components/fpspreadsheet/xlsbiff2.pas @@ -77,6 +77,7 @@ type procedure ReadWindow2(AStream: TStream); override; procedure ReadXF(AStream: TStream); public + constructor Create(AWorkbook: TsWorkbook); override; { General reading methods } procedure ReadFromStream(AStream: TStream; AData: TsWorkbook); override; end; @@ -124,6 +125,7 @@ type procedure WriteWindow1(AStream: TStream); override; procedure WriteWindow2(AStream: TStream; ASheet: TsWorksheet); public + constructor Create(AWorkbook: TsWorkbook); override; { General writing methods } procedure WriteToStream(AStream: TStream); override; end; @@ -320,6 +322,12 @@ end; { TsSpreadBIFF2Reader } +constructor TsSpreadBIFF2Reader.Create(AWorkbook: TsWorkbook); +begin + inherited Create(AWorkbook); + FLimitations.MaxPaletteSize := 16; +end; + procedure TsSpreadBIFF2Reader.ApplyCellFormatting(ACell: PCell; XFIndex: Word); var xfData: TXFListData; @@ -925,6 +933,12 @@ end; { TsSpreadBIFF2Writer } +constructor TsSpreadBIFF2Writer.Create(AWorkbook: TsWorkbook); +begin + inherited Create(AWorkbook); + FLimitations.MaxPaletteSize := 16; +end; + { Creates the correct version of the number format list. It is for BIFF2 and BIFF3 file formats. } procedure TsSpreadBIFF2Writer.CreateNumFormatList; @@ -1443,7 +1457,7 @@ begin AStream.WriteWord(WordToLE(2)); { Font color index, only first 8 palette entries allowed! } - AStream.WriteWord(WordToLE(word(font.Color))); + AStream.WriteWord(WordToLE(word(FixColor(font.Color)))); end; procedure TsSpreadBiff2Writer.WriteFonts(AStream: TStream); diff --git a/components/fpspreadsheet/xlsbiff5.pas b/components/fpspreadsheet/xlsbiff5.pas index b49d4af38..d1a6b1f26 100755 --- a/components/fpspreadsheet/xlsbiff5.pas +++ b/components/fpspreadsheet/xlsbiff5.pas @@ -134,7 +134,6 @@ type procedure WriteXFFieldsForFormattingStyles(AStream: TStream); procedure WriteXFRecords(AStream: TStream); public - constructor Create(AWorkbook: TsWorkbook); override; { General writing methods } procedure WriteToFile(const AFileName: string; const AOverwriteExisting: Boolean = False); override; @@ -329,11 +328,6 @@ type { TsSpreadBIFF5Writer } -constructor TsSpreadBIFF5Writer.Create(AWorkbook: TsWorkbook); -begin - inherited Create(AWorkbook); -end; - {******************************************************************* * TsSpreadBIFF5Writer.WriteToFile () * @@ -634,7 +628,7 @@ begin AStream.WriteWord(WordToLE(optn)); { Colour index } - AStream.WriteWord(WordToLE(ord(AFont.Color))); + AStream.WriteWord(WordToLE(ord(FixColor(AFont.Color)))); { Font weight } if fssBold in AFont.Style then diff --git a/components/fpspreadsheet/xlsbiff8.pas b/components/fpspreadsheet/xlsbiff8.pas index 3d40e9c7c..e8342e698 100755 --- a/components/fpspreadsheet/xlsbiff8.pas +++ b/components/fpspreadsheet/xlsbiff8.pas @@ -665,7 +665,7 @@ begin AStream.WriteWord(WordToLE(optn)); { Colour index } - AStream.WriteWord(WordToLE(ord(AFont.Color))); + AStream.WriteWord(WordToLE(ord(FixColor(AFont.Color)))); { Font weight } if fssBold in AFont.Style then diff --git a/components/fpspreadsheet/xlscommon.pas b/components/fpspreadsheet/xlscommon.pas index 13703ca6f..6b8acb9dd 100644 --- a/components/fpspreadsheet/xlscommon.pas +++ b/components/fpspreadsheet/xlscommon.pas @@ -457,6 +457,7 @@ type procedure AddDefaultFormats; override; procedure CreateNumFormatList; override; function FindXFIndex(ACell: PCell): Integer; + function FixColor(AColor: TsColor): TsColor; override; procedure GetLastRowCallback(ACell: PCell; AStream: TStream); function GetLastRowIndex(AWorksheet: TsWorksheet): Integer; procedure GetLastColCallback(ACell: PCell; AStream: TStream); @@ -685,11 +686,6 @@ const INT_EXCEL_TOKEN_TATTR {fekOpSum} ); -resourcestring - rsTooManyPaletteColors = 'This workbook contains more colors (%d) than are ' + - 'supported by the file format (%d). The redundant colors are replaced by '+ - 'the best-matching palette colors.'; - type TBIFF58BlankRecord = packed record RecordID: Word; @@ -841,6 +837,10 @@ begin FXFList := TFPList.Create; // Initial base date in case it won't be read from file FDateMode := dm1900; + // Limitations of BIFF5 and BIFF8 file format + FLimitations.MaxColCount := 256; + FLimitations.MaxRowCount := 65536; + FLimitations.MaxPaletteSize := 64; end; destructor TsSpreadBIFFReader.Destroy; @@ -1126,7 +1126,7 @@ begin //BIFF2 BIFF3 BIFF4 BIFF5 BIFF8 //0022H 0022H 0022H 0022H 0022H //This record specifies the base date for displaying date values. All dates are stored as count of days past this base date. In - //BIFF2-BIFF4 this record is part of the Calculation Settings Block (➜4.3). In BIFF5-BIFF8 it is stored in the Workbook + //BIFF2-BIFF4 this record is part of the Calculation Settings Block (➜4.3). In BIFF5-BIFF8 it is stored in the Workbookk //Globals Substream. //Record DATEMODE, BIFF2-BIFF8: //Offset Size Contents @@ -1739,9 +1739,15 @@ end; constructor TsSpreadBIFFWriter.Create(AWorkbook: TsWorkbook); begin inherited Create(AWorkbook); + // Initial base date in case it won't be set otherwise. // Use 1900 to get a bit more range between 1900..1904. FDateMode := dm1900; + + // Limitations of BIFF5 and BIFF8 file formats + FLimitations.MaxColCount := 256; + FLimitations.MaxRowCount := 65536; + FLimitations.MaxPaletteSize := 64; end; destructor TsSpreadBIFFWriter.Destroy; @@ -1804,6 +1810,18 @@ begin Result := FFormattingStyles[idx].Row; end; +function TsSpreadBIFFWriter.FixColor(AColor: TsColor): TsColor; +var + rgb: TsColorValue; +begin + if AColor >= Limitations.MaxPaletteSize then begin +// if AColor >= 64 then begin + rgb := Workbook.GetPaletteColor(AColor); + Result := Workbook.FindClosestColor(rgb, FLimitations.MaxPaletteSize); + end else + Result := AColor; +end; + function TsSpreadBIFFWriter.FormulaElementKindToExcelTokenID( AElementKind: TFEKind; out ASecondaryID: Word): Word; begin @@ -2095,9 +2113,6 @@ begin { Take the colors from the palette of the Worksheet } n := Workbook.GetPaletteSize; - if n > 64 then - Workbook.AddErrorMsg(rsTooManyPaletteColors, [n, 64]); - { Skip the first 8 entries - they are hard-coded into Excel } for i:=8 to 63 do begin