From dd4e66216a352c0beedfd7d459250abb19a00a46 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Tue, 17 Feb 2015 23:32:00 +0000 Subject: [PATCH] fpspreadsheet: Add background fill styles for cells. Fully implemented for Biff5, Biff8 and OOXML; ODS writes an interpolated solid fill (like Open/LibreOffice); Biff2 supports only the 50% gray black&white fill. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3949 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../fpspreadsheet/examples/fpsctrls/main.lfm | 6 + .../fpspreadsheet/examples/fpsctrls/main.pas | 7 + components/fpspreadsheet/fpsactions.pas | 9 +- components/fpspreadsheet/fpsopendocument.pas | 48 +++- components/fpspreadsheet/fpspreadsheet.pas | 140 ++++++++++-- .../fpspreadsheet/fpspreadsheetctrls.pas | 22 +- .../fpspreadsheet/fpspreadsheetgrid.pas | 205 ++++++++++++++++-- components/fpspreadsheet/fpstypes.pas | 42 +++- components/fpspreadsheet/tests/copytests.pas | 10 +- .../fpspreadsheet/tests/formattests.pas | 135 ++++++++++++ .../fpspreadsheet/tests/spreadtestgui.lpi | 1 + components/fpspreadsheet/wikitable.pas | 2 +- components/fpspreadsheet/xlsbiff2.pas | 22 +- components/fpspreadsheet/xlsbiff5.pas | 42 ++-- components/fpspreadsheet/xlsbiff8.pas | 51 +++-- components/fpspreadsheet/xlscommon.pas | 27 +++ components/fpspreadsheet/xlsxooxml.pas | 92 ++++++-- 17 files changed, 730 insertions(+), 131 deletions(-) diff --git a/components/fpspreadsheet/examples/fpsctrls/main.lfm b/components/fpspreadsheet/examples/fpsctrls/main.lfm index 75d88dbdc..f338b223c 100644 --- a/components/fpspreadsheet/examples/fpsctrls/main.lfm +++ b/components/fpspreadsheet/examples/fpsctrls/main.lfm @@ -529,6 +529,12 @@ object MainForm: TMainForm Caption = 'ToolButton52' Style = tbsDivider end + object ToolButton4: TToolButton + Left = 427 + Top = 0 + Caption = 'ToolButton4' + OnClick = ToolButton4Click + end end object ToolBar3: TToolBar Left = 0 diff --git a/components/fpspreadsheet/examples/fpsctrls/main.pas b/components/fpspreadsheet/examples/fpsctrls/main.pas index b73fa2c68..fe4597315 100644 --- a/components/fpspreadsheet/examples/fpsctrls/main.pas +++ b/components/fpspreadsheet/examples/fpsctrls/main.pas @@ -262,6 +262,7 @@ type ToolButton38: TToolButton; ToolButton39: TToolButton; TbCommentAdd: TToolButton; + ToolButton4: TToolButton; ToolButton40: TToolButton; ToolButton41: TToolButton; ToolButton42: TToolButton; @@ -291,6 +292,7 @@ type procedure AcRowDeleteExecute(Sender: TObject); procedure AcViewInspectorExecute(Sender: TObject); procedure InspectorTabControlChange(Sender: TObject); + procedure ToolButton4Click(Sender: TObject); private { private declarations } procedure UpdateCaption; @@ -395,6 +397,11 @@ begin Inspector.Mode := TsInspectorMode(InspectorTabControl.TabIndex); end; +procedure TMainForm.ToolButton4Click(Sender: TObject); +begin + WorksheetGrid.Worksheet.WriteBackgroundColor(0, 0, scRed); +end; + procedure TMainForm.UpdateCaption; begin if WorkbookSource = nil then diff --git a/components/fpspreadsheet/fpsactions.pas b/components/fpspreadsheet/fpsactions.pas index bfc546553..f06966804 100644 --- a/components/fpspreadsheet/fpsactions.pas +++ b/components/fpspreadsheet/fpsactions.pas @@ -1469,8 +1469,13 @@ begin FBackgroundColor := scNotDefined; if (ACell <> nil) then begin fmt := Workbook.GetPointerToCellFormat(ACell^.FormatIndex); - if (uffBackgroundColor in fmt^.UsedFormattingFields) then - FBackgroundColor := fmt^.BackgroundColor; + if (uffBackground in fmt^.UsedFormattingFields) then + begin + if fmt^.Background.Style = fsSolidFill then + FBackgroundColor := fmt^.Background.FgColor + else + FBackgroundColor := fmt^.Background.BgColor; + end; end; end; diff --git a/components/fpspreadsheet/fpsopendocument.pas b/components/fpspreadsheet/fpsopendocument.pas index 9fa04d362..7f314be15 100755 --- a/components/fpspreadsheet/fpsopendocument.pas +++ b/components/fpspreadsheet/fpsopendocument.pas @@ -2364,10 +2364,15 @@ begin s := GetAttrValue(styleChildNode, 'fo:background-color'); if (s <> '') and (s <> 'transparent') then begin clr := HTMLColorStrToColor(s); - fmt.BackgroundColor := ifThen(clr = TsColorValue(-1), scNotDefined, - Workbook.AddColorToPalette(clr)); - if (fmt.BackgroundColor <> scNotDefined) then - Include(fmt.UsedFormattingFields, uffBackgroundColor); + // ODS does not support background fill patterns! + fmt.Background.FgColor := IfThen(clr = TsColorValue(-1), + scTransparent, Workbook.AddColorToPalette(clr)); + fmt.Background.BgColor := fmt.Background.FgColor; + if (fmt.Background.BgColor <> scTransparent) then + begin + fmt.Background.Style := fsSolidFill; + Include(fmt.UsedFormattingFields, uffBackground); + end; end; // Borders s := GetAttrValue(styleChildNode, 'fo:border'); @@ -3531,17 +3536,48 @@ end; Creates an XML string for inclusion of the background color into the written file from the backgroundcolor setting in the given format record. Is called from WriteStyles (via WriteStylesXMLAsString). + + NOTE: ODS does not support fill patterns. Fill patterns are converted to + solid fills by mixing pattern and background colors in the ratio defined + by the fill pattern. Result agrees with that what LO/OO show for an imported + xls file. -------------------------------------------------------------------------------} function TsSpreadOpenDocWriter.WriteBackgroundColorStyleXMLAsString( const AFormat: TsCellFormat): String; +type + TRgb = record r,g,b,a: byte; end; +const // fraction of pattern color in fill pattern + FRACTION: array[TsFillStyle] of Double = ( + 0.0, 1.0, 0.75, 0.50, 0.25, 0.125, 0.0625, // fsNoFill..fsGray6 + 0.5, 0.5, 0.5, 0.5, // fsStripeHor..fsStripeDiagDown + 0.25, 0.25, 0.25, 0.25, // fsThinStripeHor..fsThinStripeDiagDown + 0.5, 6.0/16, 0.75, 7.0/16); // fsHatchDiag..fsThinHatchHor +var + fc,bc: TsColorValue; + mix: TRgb; + fraction_fc, fraction_bc: Double; begin Result := ''; - if not (uffBackgroundColor in AFormat.UsedFormattingFields) then + if not (uffBackground in AFormat.UsedFormattingFields) then exit; + // Foreground and background colors + fc := Workbook.GetPaletteColor(AFormat.Background.FgColor); + if Aformat.Background.BgColor = scTransparent then + bc := Workbook.GetPaletteColor(scWhite) + else + bc := Workbook.GetPaletteColor(AFormat.Background.BgColor); + // Mixing fraction + fraction_fc := FRACTION[AFormat.Background.Style]; + fraction_bc := 1.0 - fraction_fc; + // Mixed color + mix.r := Min(round(fraction_fc*TRgb(fc).r + fraction_bc*TRgb(bc).r), 255); + mix.g := Min(round(fraction_fc*TRgb(fc).g + fraction_bc*TRgb(bc).g), 255); + mix.b := Min(round(fraction_fc*TRgb(fc).b + fraction_bc*TRgb(bc).b), 255); + Result := Format('fo:background-color="%s" ', [ - Workbook.GetPaletteColorAsHTMLStr(AFormat.BackgroundColor) + ColorToHTMLColorStr(TsColorValue(mix)) ]); end; diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas index 9fe79b503..47440349b 100755 --- a/components/fpspreadsheet/fpspreadsheet.pas +++ b/components/fpspreadsheet/fpspreadsheet.pas @@ -225,6 +225,7 @@ type out ACurrencySymbol: String): Boolean; function ReadUsedFormatting(ACell: PCell): TsUsedFormattingFields; + function ReadBackground(ACell: PCell): TsFillPattern; function ReadBackgroundColor(ACell: PCell): TsColor; function ReadCellBorders(ACell: PCell): TsCellBorders; function ReadCellBorderStyle(ACell: PCell; ABorder: TsCellBorder): TsCellBorderStyle; @@ -300,8 +301,10 @@ type procedure WriteNumber(ACell: PCell; ANumber: Double; ANumFormat: TsNumberFormat; ANumFormatString: String); overload; - function WriteRPNFormula(ARow, ACol: Cardinal; AFormula: TsRPNFormula): PCell; overload; - procedure WriteRPNFormula(ACell: PCell; AFormula: TsRPNFormula); overload; + function WriteRPNFormula(ARow, ACol: Cardinal; + AFormula: TsRPNFormula): PCell; overload; + procedure WriteRPNFormula(ACell: PCell; + AFormula: TsRPNFormula); overload; procedure WriteSharedFormula(ARow1, ACol1, ARow2, ACol2: Cardinal; const AFormula: String); overload; @@ -312,16 +315,25 @@ type procedure WriteUTF8Text(ACell: PCell; AText: ansistring); overload; { Writing of cell attributes } + function WriteBackground(ARow, ACol: Cardinal; AStyle: TsFillStyle; + APatternColor: TsColor = scTransparent; + ABackgroundColor: TsColor = scTransparent): PCell; overload; + procedure WriteBackground(ACell: PCell; AStyle: TsFillStyle; + APatternColor: TsColor = scTransparent; + ABackgroundColor: TsColor = scTransparent); overload; function WriteBackgroundColor(ARow, ACol: Cardinal; AColor: TsColor): PCell; overload; procedure WriteBackgroundColor(ACell: PCell; AColor: TsColor); overload; - function WriteBorderColor(ARow, ACol: Cardinal; ABorder: TsCellBorder; AColor: TsColor): PCell; overload; - procedure WriteBorderColor(ACell: PCell; ABorder: TsCellBorder; AColor: TsColor); overload; + function WriteBorderColor(ARow, ACol: Cardinal; ABorder: TsCellBorder; + AColor: TsColor): PCell; overload; + procedure WriteBorderColor(ACell: PCell; ABorder: TsCellBorder; + AColor: TsColor); overload; function WriteBorderLineStyle(ARow, ACol: Cardinal; ABorder: TsCellBorder; ALineStyle: TsLineStyle): PCell; overload; procedure WriteBorderLineStyle(ACell: PCell; ABorder: TsCellBorder; ALineStyle: TsLineStyle); overload; - function WriteBorders(ARow, ACol: Cardinal; ABorders: TsCellBorders): PCell; overload; + function WriteBorders(ARow, ACol: Cardinal; + ABorders: TsCellBorders): PCell; overload; procedure WriteBorders(ACell: PCell; ABorders: TsCellBorders); overload; function WriteBorderStyle(ARow, ACol: Cardinal; ABorder: TsCellBorder; AStyle: TsCellBorderStyle): PCell; overload; @@ -3033,6 +3045,26 @@ begin Result := fmt^.UsedFormattingFields; end; +{@@ ---------------------------------------------------------------------------- + Returns the background fill pattern and colors of a cell. + + @param ACell Pointer to the cell + @return TsFillPattern record (or EMPTY_FILL, if the cell does not have a + filled background +-------------------------------------------------------------------------------} +function TsWorksheet.ReadBackground(ACell: PCell): TsFillPattern; +var + fmt : PsCellFormat; +begin + Result := EMPTY_FILL; + if ACell <> nil then + begin + fmt := Workbook.GetPointerToCellFormat(ACell^.FormatIndex); + if (uffBackground in fmt^.UsedFormattingFields) then + Result := fmt^.Background; + end; +end; + {@@ ---------------------------------------------------------------------------- Returns the background color of a cell as index into the workbook's color palette. @@ -3047,10 +3079,13 @@ begin if ACell <> nil then begin fmt := Workbook.GetPointerToCellFormat(ACell^.FormatIndex); - if (uffBackgroundColor in fmt^.UsedFormattingFields) then - Result := fmt^.BackgroundColor - else - Result := scTransparent; + if (uffBackground in fmt^.UsedFormattingFields) then + begin + if (fmt^.Background.Style = fsSolidFill) then + Result := fmt^.Background.FgColor + else + Result := fmt^.Background.BgColor; + end; end; end; @@ -5458,7 +5493,62 @@ begin end; {@@ ---------------------------------------------------------------------------- - Sets the background color of a cell. + Defines a background pattern for a cell + + @param ARow Row index of the cell + @param ACol Column index of the cell + @param AFillStyle Fill style to be used - see TsFillStyle + @param APatternColor Palette index of the pattern color + @param ABackgroundColor Palette index of the background color + @return Pointer to cell + + @NOTE Is replaced by uniform fill if WriteBackgroundColor is called later. +-------------------------------------------------------------------------------} +function TsWorksheet.WriteBackground(ARow, ACol: Cardinal; AStyle: TsFillStyle; + APatternColor, ABackgroundColor: TsColor): PCell; +begin + Result := GetCell(ARow, ACol); + WriteBackground(Result, AStyle, APatternColor, ABackgroundColor); +end; + +{@@ ---------------------------------------------------------------------------- + Defines a background pattern for a cell + + @param ACell Pointer to the cell + @param AStyle Fill style ("pattern") to be used - see TsFillStyle + @param APatternColor Palette index of the pattern color + @param ABackgroundColor Palette index of the background color + + @NOTE Is replaced by uniform fill if WriteBackgroundColor is called later. +-------------------------------------------------------------------------------} +procedure TsWorksheet.WriteBackground(ACell: PCell; AStyle: TsFillStyle; + APatternColor: TsColor = scTransparent; ABackgroundColor: TsColor = scTransparent); +var + fmt: TsCellFormat; +begin + if ACell <> nil then begin + fmt := Workbook.GetCellFormat(ACell^.FormatIndex); + if (AStyle = fsNoFill) or + ((APatternColor = scTransparent) and (ABackgroundColor = scTransparent)) + then + Exclude(fmt.UsedFormattingFields, uffBackground) + else + begin + Include(fmt.UsedFormattingFields, uffBackground); + fmt.Background.Style := AStyle; + fmt.Background.FgColor := APatternColor; + if (AStyle = fsSolidFill) and (ABackgroundColor = scTransparent) then + fmt.Background.BgColor := APatternColor + else + fmt.Background.BgColor := ABackgroundColor; + end; + ACell^.FormatIndex := Workbook.AddCellFormat(fmt); + ChangedCell(ACell^.Row, ACell^.Col); + end; +end; + +{@@ ---------------------------------------------------------------------------- + Sets a uniform background color of a cell. @param ARow Row index of the cell @param ACol Column index of the cell @@ -5475,7 +5565,7 @@ begin end; {@@ ---------------------------------------------------------------------------- - Sets the background color of a cell. + Sets a uniform background color of a cell. @param ACell Pointer to cell @param AColor Index of the new background color into the workbook's @@ -5483,20 +5573,12 @@ end; erase an existing background color. -------------------------------------------------------------------------------} procedure TsWorksheet.WriteBackgroundColor(ACell: PCell; AColor: TsColor); -var - fmt: TsCellFormat; begin if ACell <> nil then begin - fmt := Workbook.GetCellFormat(ACell^.FormatIndex); if AColor = scTransparent then - Exclude(fmt.UsedFormattingFields, uffBackgroundColor) + WriteBackground(ACell, fsNoFill) else - begin - Include(fmt.UsedFormattingFields, uffBackgroundColor); - fmt.BackgroundColor := AColor; - end; - ACell^.FormatIndex := Workbook.AddCellFormat(fmt); - ChangedCell(ACell^.Row, ACell^.Col); + WriteBackground(ACell, fsSolidFill, AColor, AColor); end; end; @@ -8038,7 +8120,14 @@ end; -------------------------------------------------------------------------------} function TsWorkbook.GetColorName(AColorIndex: TsColor): string; begin - GetColorName(GetPaletteColor(AColorIndex), Result); + case AColorIndex of + scTransparent: + Result := 'transparent'; + scNotDefined: + Result := 'not defined'; + else + GetColorName(GetPaletteColor(AColorIndex), Result); + end; end; {@@ ---------------------------------------------------------------------------- @@ -8215,8 +8304,11 @@ begin begin cell := PCell(Node.Data); fmt := GetPointerToCellFormat(cell^.FormatIndex); - if (uffBackgroundColor in fmt^.UsedFormattingFields) then - if fmt^.BackgroundColor = AColorIndex then exit; + if (uffBackground in fmt^.UsedFormattingFields) then + begin + if fmt^.Background.BgColor = AColorIndex then exit; + if fmt^.Background.FgColor = AColorIndex then exit; + end; if (uffBorder in fmt^.UsedFormattingFields) then for b in TsCellBorders do if fmt^.BorderStyles[b].Color = AColorIndex then diff --git a/components/fpspreadsheet/fpspreadsheetctrls.pas b/components/fpspreadsheet/fpspreadsheetctrls.pas index 73e7e53a1..ea3dd4dba 100644 --- a/components/fpspreadsheet/fpspreadsheetctrls.pas +++ b/components/fpspreadsheet/fpspreadsheetctrls.pas @@ -903,8 +903,11 @@ var j: Integer; I: IsSpreadsheetControl; C: TComponent; + + cell: PCell; begin for j:=0 to FListeners.Count-1 do begin + if Worksheet <> nil then cell := Worksheet.FindCell(0,0); C := TComponent(FListeners[j]); if C.GetInterface(GUID_SpreadsheetControl, I) then I.ListenerNotification(AChangedItems, AData) @@ -2602,11 +2605,20 @@ begin GetEnumName(TypeInfo(TsLineStyle), ord(fmt.BorderStyles[cbEast].LineStyle)), Workbook.GetColorName(fmt.BorderStyles[cbEast].Color)])); - if (ACell = nil) or not (uffBackgroundColor in fmt.UsedformattingFields) - then AStrings.Add('BackgroundColor=') - else AStrings.Add(Format('BackgroundColor=%d (%s)', [ - fmt.BackgroundColor, - Workbook.GetColorName(fmt.BackgroundColor)])); + if (ACell = nil) or not (uffBackground in fmt.UsedformattingFields) then + begin + AStrings.Add('Style='); + AStrings.Add('PatternColor='); + AStrings.Add('BackgroundColor='); + end else + begin + AStrings.Add(Format('Style=%s', [ + GetEnumName(TypeInfo(TsFillStyle), ord(fmt.Background.Style))])); + AStrings.Add(Format('PatternColor=%d (%s)', [ + fmt.Background.FgColor, Workbook.GetColorName(fmt.Background.FgColor)])); + AStrings.Add(Format('BackgroundColor=%d (%s)', [ + fmt.Background.BgColor, Workbook.GetColorName(fmt.Background.BgColor)])); + end; if (ACell = nil) or not (uffNumberFormat in fmt.UsedFormattingFields) then begin diff --git a/components/fpspreadsheet/fpspreadsheetgrid.pas b/components/fpspreadsheet/fpspreadsheetgrid.pas index 150aea512..4a16b0f41 100644 --- a/components/fpspreadsheet/fpspreadsheetgrid.pas +++ b/components/fpspreadsheet/fpspreadsheetgrid.pas @@ -591,25 +591,163 @@ const var - {@@ Auxiliary bitmap containing the fill pattern used by biff2 cell backgrounds. } - FillPattern_BIFF2: TBitmap = nil; + {@@ Auxiliary bitmap containing the previously used non-trivial fill pattern } + FillPatternBitmap: TBitmap = nil; + FillPatternStyle: TsFillStyle; + FillPatternFgColor: TColor; + FillPatternBgColor: TColor; {@@ ---------------------------------------------------------------------------- - Helper procedure which creates the fill pattern used by biff2 cell backgrounds. + Helper procedure which creates bitmaps used for fill patterns in cell + backgrounds. + The parameters are buffered in FillPatternXXXX variables to avoid unnecessary + creation of the same bitmaps again and again. -------------------------------------------------------------------------------} -procedure Create_FillPattern_BIFF2(ABkColor: TColor); -begin - FreeAndNil(FillPattern_BIFF2); - FillPattern_BIFF2 := TBitmap.Create; - with FillPattern_BIFF2 do begin - SetSize(4, 4); - Canvas.Brush.Color := ABkColor; - Canvas.FillRect(0, 0, Width, Height); - Canvas.Pixels[0, 0] := clBlack; - Canvas.Pixels[2, 2] := clBlack; +procedure CreateFillPattern(var ABitmap: TBitmap; AStyle: TsFillStyle; + AFgColor, ABgColor: TColor); + + procedure SolidFill(AColor: TColor); + begin + ABitmap.Canvas.Brush.Color := AColor; + ABitmap.Canvas.FillRect(0, 0, ABitmap.Width, ABitmap.Height); end; + +var + x,y: Integer; +begin + if (FillPatternStyle = AStyle) and (FillPatternBgColor = ABgColor) and + (FillPatternFgColor = AFgColor) and (ABitmap <> nil) + then + exit; + + FreeAndNil(ABitmap); + ABitmap := TBitmap.Create; + with ABitmap do begin + if AStyle = fsGray6 then SetSize(8, 4) else SetSize(4, 4); + case AStyle of + fsNoFill: + SolidFill(ABgColor); + fsSolidFill: + SolidFill(AFgColor); + fsGray75: + begin + SolidFill(AFgColor); + Canvas.Pixels[0, 0] := ABgColor; + Canvas.Pixels[2, 1] := ABgColor; + Canvas.Pixels[0, 2] := ABgColor; + Canvas.Pixels[2, 3] := ABgColor; + end; + fsGray50: + begin + SolidFill(AFgColor); + for y := 0 to 3 do for + x := 0 to 3 do + if odd(x+y) then Canvas.Pixels[x,y] := ABgColor; + end; + fsGray25: + begin + SolidFill(ABgColor); + Canvas.Pixels[0, 0] := AFgColor; + Canvas.Pixels[2, 1] := AFgColor; + Canvas.Pixels[0, 2] := AFgColor; + Canvas.Pixels[2, 3] := AFgColor; + end; + fsGray12: + begin + SolidFill(ABgColor); + Canvas.Pixels[0, 0] := AFgColor; + Canvas.Pixels[2, 2] := AFgColor; + end; + fsGray6: + begin + SolidFill(ABgColor); + Canvas.Pixels[0, 0] := AFgColor; + Canvas.Pixels[4, 2] := AFgColor; + end; + fsStripeHor: + begin + SolidFill(ABgColor); + for y := 0 to 1 do + for x := 0 to 3 do + Canvas.Pixels[x,y] := AFgColor; + end; + fsStripeVert: + begin + SolidFill(ABgColor); + for y := 0 to 3 do + for x := 0 to 1 do + Canvas.Pixels[x,y] := AFgColor; + end; + fsStripeDiagUp: + begin + SolidFill(ABgColor); + for y := 0 to 3 do + for x := 0 to 1 do + Canvas.Pixels[(x+y) mod 4, 3-y] := AFgColor; + end; + fsStripeDiagDown: + begin + SolidFill(ABgColor); + for y := 0 to 3 do + for x := 0 to 1 do + Canvas.Pixels[(x+y) mod 4, y] := AFgColor; + end; + fsThinStripeHor: + begin + SolidFill(ABgColor); + for x := 0 to 3 do Canvas.Pixels[x, 0] := AFgColor; + end; + fsThinStripeVert: + begin + SolidFill(ABgColor); + for y := 0 to 3 do Canvas.Pixels[0, y] := AFgColor; + end; + fsThinStripeDiagUp: + begin + SolidFill(ABgColor); + for x := 0 to 3 do Canvas.Pixels[3-x, x] := AFgColor; + end; + fsThinStripeDiagDown, fsThinHatchDiag: + begin + SolidFill(ABgColor); + for x := 0 to 3 do Canvas.Pixels[x, x] := AFgColor; + if AStyle = fsThinHatchDiag then begin + Canvas.Pixels[0, 2] := AFgColor; + Canvas.Pixels[2, 0] := AFgColor; + end; + end; + fsHatchDiag: + begin + SolidFill(ABgColor); + for x := 0 to 1 do + for y := 0 to 1 do begin + Canvas.Pixels[x,y] := AFgColor; + Canvas.Pixels[x+2, y+2] := AFgColor; + end; + end; + fsThickHatchDiag: + begin + SolidFill(AFgColor); + for x := 2 to 3 do Canvas.Pixels[x, 0] := ABgColor; + for x := 0 to 1 do Canvas.Pixels[x, 2] := ABgColor; + end; + fsThinHatchHor: + begin + SolidFill(ABgColor); + for x := 0 to 3 do begin + Canvas.Pixels[x, 0] := AFgColor; + Canvas.Pixels[0, x] := AFgColor; + end; + end; + end; // case + end; + + FillPatternStyle := AStyle; + FillPatternBgColor := ABgColor; + FillPatternFgColor := AFgColor; end; + {@@ ---------------------------------------------------------------------------- Helper procedure which draws a densely dotted horizontal line. In Excel this is called a "hair line". @@ -1174,12 +1312,14 @@ var fnt: TsFont; style: TFontStyles; isSelected: Boolean; + fgcolor, bgcolor: TColor; begin GetSelectedState(AState, isSelected); Canvas.Font.Assign(Font); Canvas.Brush.Bitmap := nil; Canvas.Brush.Color := Color; ts := Canvas.TextStyle; + if ShowHeaders then begin // Formatting of row and column headers @@ -1196,37 +1336,53 @@ begin if ShowHeaders and ((ACol = 0) or (ARow = 0)) then Canvas.Brush.Color := FixedColor end; + if (Worksheet <> nil) and (ARow >= FHeaderCount) and (ACol >= FHeaderCount) then begin r := ARow - FHeaderCount; c := ACol - FHeaderCount; - //lCell := FDrawingCell; + lCell := Worksheet.FindCell(r, c); if lCell <> nil then begin fmt := Workbook.GetPointerToCellFormat(lCell^.FormatIndex); + // Background color - if (uffBackgroundColor in fmt^.UsedFormattingFields) then + if (uffBackground in fmt^.UsedFormattingFields) then begin if Workbook.FileFormat = sfExcel2 then begin - if (FillPattern_BIFF2 = nil) and (ComponentState = []) then - Create_FillPattern_BIFF2(Color); + CreateFillPattern(FillPatternBitmap, fsGray50, clBlack, Color); Canvas.Brush.Style := bsImage; - Canvas.Brush.Bitmap := FillPattern_BIFF2; + Canvas.Brush.Bitmap := FillPatternBitmap; end else begin - Canvas.Brush.Style := bsSolid; - if fmt^.BackgroundColor < Workbook.GetPaletteSize then - Canvas.Brush.Color := Workbook.GetPaletteColor(fmt^.BackgroundColor) - else - Canvas.Brush.Color := Color; + case fmt^.Background.Style of + fsNoFill: + Canvas.Brush.Style := bsClear; + fsSolidFill: + begin + Canvas.Brush.Style := bsSolid; + Canvas.Brush.Color := Workbook.GetPaletteColor(fmt^.Background.FgColor); + end; + else + if fmt^.Background.BgColor = scTransparent + then bgcolor := Color + else bgcolor := Workbook.GetPaletteColor(fmt^.Background.BgColor); + if fmt^.Background.FgColor = scTransparent + then fgcolor := Color + else fgcolor := Workbook.GetPaletteColor(fmt^.Background.FgColor); + CreateFillPattern(FillPatternBitmap, fmt^.Background.Style, fgColor, bgColor); + Canvas.Brush.Style := bsImage; + Canvas.Brush.Bitmap := FillPatternBitmap; + end; end; end else begin Canvas.Brush.Style := bsSolid; Canvas.Brush.Color := Color; end; + // Font if (uffFont in fmt^.UsedFormattingFields) then begin @@ -4347,11 +4503,12 @@ end; initialization fpsutils.ScreenPixelsPerInch := Screen.PixelsPerInch; + FillPatternStyle := fsNoFill; RegisterPropertyToSkip(TsCustomWorksheetGrid, 'ColWidths', 'taken from worksheet', ''); RegisterPropertyToSkip(TsCustomWorksheetGrid, 'RowHeights', 'taken from worksheet', ''); finalization - FreeAndNil(FillPattern_BIFF2); + FreeAndNil(FillPatternBitmap); end. diff --git a/components/fpspreadsheet/fpstypes.pas b/components/fpspreadsheet/fpstypes.pas index 6f0be9878..08c06cc99 100644 --- a/components/fpspreadsheet/fpstypes.pas +++ b/components/fpspreadsheet/fpstypes.pas @@ -147,9 +147,9 @@ type {@@ List of possible formatting fields } TsUsedFormattingField = (uffTextRotation, uffFont, uffBold, uffBorder, - uffBackgroundColor, uffNumberFormat, uffWordWrap, - uffHorAlign, uffVertAlign + uffBackground, uffNumberFormat, uffWordWrap, uffHorAlign, uffVertAlign ); + { NOTE: "uffBackgroundColor" of older versions replaced by "uffBackground" } {@@ Describes which formatting fields are active } TsUsedFormattingFields = set of TsUsedFormattingField; @@ -379,6 +379,28 @@ const (LineStyle: lsThin; Color: scBlack) ); +type + {@@ Style of fill style for cell backgrounds } + TsFillStyle = (fsNoFill, fsSolidFill, + fsGray75, fsGray50, fsGray25, fsGray12, fsGray6, + fsStripeHor, fsStripeVert, fsStripeDiagUp, fsStripeDiagDown, + fsThinStripeHor, fsThinStripeVert, fsThinStripeDiagUp, fsThinStripeDiagDown, + fsHatchDiag, fsThinHatchDiag, fsThickHatchDiag, fsThinHatchHor); + + {@@ Fill pattern record } + TsFillPattern = record + Style: TsFillStyle; + FgColor: TsColor; // pattern color + BgColor: TsColor; // background color + end; + +const + EMPTY_FILL: TsFillPattern = ( + Style: fsNoFill; + FgColor: scTransparent; + BgColor: scTransparent; + ); + type {@@ Identifier for a compare operation } TsCompareOperation = (coNotUsed, @@ -445,8 +467,7 @@ type VertAlignment: TsVertAlignment; Border: TsCellBorders; BorderStyles: TsCelLBorderStyles; - BackgroundColor: TsColor; - RGBBackgroundColor: TFPColor; // only valid if BackgroundColor=scRGBCOLOR + Background: TsFillPattern; NumberFormat: TsNumberFormat; NumberFormatStr: String; end; @@ -486,7 +507,7 @@ begin AValue.NumberFormatStr := ''; FillChar(AValue, SizeOf(AValue), 0); AValue.BorderStyles := DEFAULT_BORDERSTYLES; - AValue.BackgroundColor := TsColor(-1); + AValue.Background := EMPTY_FILL; end; @@ -523,8 +544,7 @@ begin P^.VertAlignment := AItem.VertAlignment; P^.Border := AItem.Border; P^.BorderStyles := AItem.BorderStyles; - P^.BackgroundColor := AItem.BackgroundColor; - P^.RGBBackgroundColor := AItem.RGBBackgroundColor; + P^.Background := AItem.Background; P^.NumberFormat := AItem.NumberFormat; P^.NumberFormatStr := AItem.NumberFormatStr; Result := inherited Add(P); @@ -632,10 +652,10 @@ begin if not equ then continue; end; - if (uffBackgroundColor in AItem.UsedFormattingFields) then begin - if (P^.BackgroundColor <> AItem.BackgroundColor) then continue; - if (AItem.BackgroundColor = scRGBColor) then - if (P^.RGBBackgroundColor <> AItem.RGBBackgroundColor) then continue; + if (uffBackground in AItem.UsedFormattingFields) then begin + if (P^.Background.Style <> AItem.Background.Style) then continue; + if (P^.Background.BgColor <> AItem.Background.BgColor) then continue; + if (P^.Background.FgColor <> AItem.Background.FgColor) then continue; end; if (uffNumberFormat in AItem.UsedFormattingFields) then begin diff --git a/components/fpspreadsheet/tests/copytests.pas b/components/fpspreadsheet/tests/copytests.pas index 155b823eb..c162e6f70 100644 --- a/components/fpspreadsheet/tests/copytests.pas +++ b/components/fpspreadsheet/tests/copytests.pas @@ -87,7 +87,7 @@ begin Result.ContentType := cctNumber; Result.Numbervalue := ANumber; if (ABkColor <> scTransparent) then begin - Result.UsedFormattingFields := Result.usedFormattingFields + [uffBackgroundColor]; + Result.UsedFormattingFields := Result.UsedFormattingFields + [uffBackground]; Result.BackgroundColor := ABkColor; end; end; @@ -98,7 +98,7 @@ begin Result.ContentType := cctUTF8String; Result.UTF8StringValue := AString; if (ABkColor <> scTransparent) then begin - Result.UsedFormattingFields := Result.usedFormattingFields + [uffBackgroundColor]; + Result.UsedFormattingFields := Result.usedFormattingFields + [uffBackground]; Result.BackgroundColor := ABkColor; end; end; @@ -111,7 +111,7 @@ begin Result.NumberValue := ANumberResult; Result.ContentType := cctNumber; if (ABkColor <> scTransparent) then begin - Result.UsedFormattingFields := Result.usedFormattingFields + [uffBackgroundColor]; + Result.UsedFormattingFields := Result.usedFormattingFields + [uffBackground]; Result.BackgroundColor := ABkColor; end; end; @@ -339,7 +339,7 @@ begin SourceCells[i+(col-2)].UsedFormattingFields = MyWorksheet.ReadUsedFormatting(cell), 'Used formatting fields mismatch, cell ' + CellNotation(myWorksheet, row, col) ); - if (uffBackgroundColor in SourceCells[i].UsedFormattingFields) then + if (uffBackground in SourceCells[i].UsedFormattingFields) then CheckEquals( SourceCells[i+(col-2)].BackgroundColor, MyWorksheet.ReadBackgroundColor(cell), @@ -361,7 +361,7 @@ begin SourceCells[i].UsedFormattingFields = MyWorksheet.ReadUsedFormatting(cell), 'Used formatting fields mismatch, cell ' + CellNotation(MyWorksheet, row, col) ); - if (uffBackgroundColor in SourceCells[i].UsedFormattingFields) then + if (uffBackground in SourceCells[i].UsedFormattingFields) then CheckEquals( SourceCells[i].BackgroundColor, MyWorksheet.ReadBackgroundColor(cell), diff --git a/components/fpspreadsheet/tests/formattests.pas b/components/fpspreadsheet/tests/formattests.pas index 2ba0db740..0a8723e62 100644 --- a/components/fpspreadsheet/tests/formattests.pas +++ b/components/fpspreadsheet/tests/formattests.pas @@ -52,6 +52,8 @@ type // Test alignments procedure TestWriteRead_Alignment(AFormat: TsSpreadsheetFormat); + // Test background + procedure TestWriteRead_Background(AFormat: TsSpreadsheetFormat); // Test border procedure TestWriteRead_Border(AFormat: TsSpreadsheetFormat); // Test border styles @@ -88,12 +90,14 @@ type procedure TestWriteRead_BIFF2_NumberFormats; procedure TestWriteRead_BIFF2_ManyXFRecords; // These features are not supported by Excel2 --> no test cases required! + // - Background // - BorderStyle // - TextRotation // - Wordwrap { BIFF5 Tests } procedure TestWriteRead_BIFF5_Alignment; + procedure TestWriteRead_BIFF5_Background; procedure TestWriteRead_BIFF5_Border; procedure TestWriteRead_BIFF5_BorderStyles; procedure TestWriteRead_BIFF5_ColWidths; @@ -106,6 +110,7 @@ type { BIFF8 Tests } procedure TestWriteRead_BIFF8_Alignment; + procedure TestWriteRead_BIFF8_Background; procedure TestWriteRead_BIFF8_Border; procedure TestWriteRead_BIFF8_BorderStyles; procedure TestWriteRead_BIFF8_ColWidths; @@ -118,6 +123,7 @@ type { ODS Tests } procedure TestWriteRead_ODS_Alignment; + // no background patterns in ods procedure TestWriteRead_ODS_Border; procedure TestWriteRead_ODS_BorderStyles; procedure TestWriteRead_ODS_ColWidths; @@ -130,6 +136,7 @@ type { OOXML Tests } procedure TestWriteRead_OOXML_Alignment; + procedure TestWriteRead_OOXML_Background; procedure TestWriteRead_OOXML_Border; procedure TestWriteRead_OOXML_BorderStyles; procedure TestWriteRead_OOXML_ColWidths; @@ -156,6 +163,7 @@ const FmtDateTimesSheet = 'DateTimesFormat'; ColWidthSheet = 'ColWidths'; RowHeightSheet = 'RowHeights'; + BackgroundSheet = 'Background'; BordersSheet = 'CellBorders'; AlignmentSheet = 'TextAlignments'; TextRotationSheet = 'TextRotation'; @@ -689,6 +697,133 @@ begin end; +{ This test writes in column A the names of the Background.Styles, in column B + the background fill with a specific pattern and background color, in column C + the same, but with transparent background. } +procedure TSpreadWriteReadFormatTests.TestWriteRead_Background(AFormat: TsSpreadsheetFormat); +const + PATTERN_COLOR = scRed; + BK_COLOR = scYellow; +var + MyWorksheet: TsWorksheet; + MyWorkbook: TsWorkbook; + MyCell: PCell; + col, row: Integer; + style: TsFillStyle; + TempFile: String; + actualstyle: TsFillStyle; + actualcolor: TsColor; + patt: TsFillPattern; +begin + // Write out all test values + MyWorkbook := TsWorkbook.Create; + try + MyWorkbook.UsePalette(@PALETTE_BIFF8, Length(PALETTE_BIFF8)); + MyWorkSheet:= MyWorkBook.AddWorksheet(BackgroundSheet); + for style in TsFillStyle do begin + row := ord(style); + MyWorksheet.WriteUTF8Text(row, 0, GetEnumName(TypeInfo(TsFillStyle), ord(style))); + MyWorksheet.WriteBackground(row, 1, style, PATTERN_COLOR, BK_COLOR); + MyWorksheet.WriteBackground(row, 2, style, PATTERN_COLOR, scTransparent); + end; + TempFile:= NewTempFile; + MyWorkBook.WriteToFile(TempFile, AFormat, true); + finally + MyWorkbook.Free; + end; + + // Open the spreadsheet + MyWorkbook := TsWorkbook.Create; + try + MyWorkbook.ReadFromFile(TempFile, AFormat); + if AFormat = sfExcel2 then + MyWorksheet := MyWorkbook.GetFirstWorksheet + else + MyWorksheet := GetWorksheetByName(MyWorkBook, BackgroundSheet); + if MyWorksheet=nil then + fail('Error in test code. Failed to get named worksheet'); + + for style in TsFillStyle do begin + row := ord(style); + + // Column B has BK_COLOR as backgroundcolor of the patterns + col := 1; + MyCell := MyWorksheet.FindCell(row, col); + if MyCell = nil then + fail('Error in test code. Failed to get cell ' + CellNotation(MyWorksheet, row, col)); + patt := MyWorksheet.ReadBackground(MyCell); + CheckEquals( + GetEnumName(TypeInfo(TsFillStyle), ord(style)), + GetEnumName(TypeInfo(TsFillStyle), ord(patt.Style)), + 'Test saved fill style mismatch, cell ' + CellNotation(MyWorksheet, row, col)); + if style <> fsNoFill then + begin + if PATTERN_COLOR <> patt.FgColor then + CheckEquals( + MyWorkbook.GetColorName(PATTERN_COLOR), + MyWorkbook.GetColorName(patt.FgColor), + 'Test saved fill pattern color mismatch, cell ' + CellNotation(MyWorksheet, row, col)); + if BK_COLOR <> patt.BgColor then + CheckEquals( + MyWorkbook.GetColorName(BK_COLOR), + MyWorkbook.GetColorName(patt.BgColor), + 'Test saved fill background color mismatch, cell ' + CellNotation(MyWorksheet, row, col)); + end; + + // Column C has a transparent pattern background. + col := 2; + MyCell := Myworksheet.FindCell(row, col); + if MyCell = nil then + fail('Error in test code. Failed to get cell ' + CellNotation(MyWorksheet, row, col)); + patt := MyWorksheet.ReadBackground(MyCell); + CheckEquals( + GetEnumName(TypeInfo(TsFillStyle), ord(style)), + GetEnumName(TypeInfo(TsFillStyle), ord(patt.Style)), + 'Test saved fill style mismatch, cell ' + CellNotation(MyWorksheet, row, col)); + if style <> fsNoFill then + begin + if PATTERN_COLOR <> patt.FgColor then + CheckEquals( + MyWorkbook.GetColorName(PATTERN_COLOR), + MyWorkbook.GetColorName(patt.FgColor), + 'Test saved fill pattern color mismatch, cell ' + CellNotation(MyWorksheet, row, col)); + // SolidFill is a special case: here the background color is always equal + // to the pattern color - the cell layout does not know this... + if style = fsSolidFill then + CheckEquals( + MyWorkbook.GetColorName(PATTERN_COLOR), + MyWorkbook.GetColorName(patt.BgColor), + 'Test saved fill pattern color mismatch, cell ' + CellNotation(MyWorksheet, row, col)) + else + CheckEquals( + MyWorkbook.GetColorName(scTransparent), + MyWorkbook.GetColorName(patt.BgColor), + 'Test saved fill background color mismatch, cell ' + CellNotation(MyWorksheet, row, col)); + end; + end; + + finally + MyWorkbook.Free; + DeleteFile(TempFile); + end; +end; + +procedure TSpreadWriteReadFormatTests.TestWriteRead_BIFF5_Background; +begin + TestWriteRead_Background(sfExcel5); +end; + +procedure TSpreadWriteReadFormatTests.TestWriteRead_BIFF8_Background; +begin + TestWriteRead_Background(sfExcel8); +end; + +procedure TSpreadWriteReadFormatTests.TestWriteRead_OOXML_Background; +begin + TestWriteRead_Background(sfOOXML); +end; + + { --- Border on/off tests --- } procedure TSpreadWriteReadFormatTests.TestWriteRead_Border(AFormat: TsSpreadsheetFormat); diff --git a/components/fpspreadsheet/tests/spreadtestgui.lpi b/components/fpspreadsheet/tests/spreadtestgui.lpi index 2fbb499ff..1ba40eedf 100644 --- a/components/fpspreadsheet/tests/spreadtestgui.lpi +++ b/components/fpspreadsheet/tests/spreadtestgui.lpi @@ -131,6 +131,7 @@ + diff --git a/components/fpspreadsheet/wikitable.pas b/components/fpspreadsheet/wikitable.pas index 1dabd32d1..386e0788e 100644 --- a/components/fpspreadsheet/wikitable.pas +++ b/components/fpspreadsheet/wikitable.pas @@ -492,7 +492,7 @@ begin lCurStr := '' + lCurStr + ''; // Background color - if uffBackgroundColor in lCurUsedFormatting then + if uffBackground in lCurUsedFormatting then begin lCurColor := FWorksheet.ReadBackgroundColor(lCell); lStyleStr := Format('background-color:%s;color:%s;', [ diff --git a/components/fpspreadsheet/xlsbiff2.pas b/components/fpspreadsheet/xlsbiff2.pas index c3c14f590..f31e80182 100755 --- a/components/fpspreadsheet/xlsbiff2.pas +++ b/components/fpspreadsheet/xlsbiff2.pas @@ -1015,10 +1015,11 @@ begin // Background color not supported, only shaded background if rec.HorAlign_Border_BkGr and $80 <> 0 then begin - fmt.BackgroundColor := 1; // encodes "shaded background = true" - Include(fmt.UsedFormattingFields, uffBackgroundColor); - end else - fmt.BackgroundColor := 0; // encodes "shaded background = false" + fmt.Background.Style := fsGray50; + fmt.Background.FgColor := scBlack; + fmt.Background.BgColor := scTransparent; + Include(fmt.UsedFormattingFields, uffBackground); + end; // Add the decoded data to the format list FCellFormatList.Add(fmt); @@ -1090,7 +1091,7 @@ begin if cbEast in fmt^.Border then Attrib3 := Attrib3 or $10; if cbSouth in fmt^.Border then Attrib3 := Attrib3 or $40; end; - if (uffBackgroundColor in fmt^.UsedFormattingFields) and (fmt^.Backgroundcolor <> scWhite) then + if (uffBackground in fmt^.UsedFormattingFields) then Attrib3 := Attrib3 or $80; end; @@ -1161,7 +1162,7 @@ begin if cbSouth in fmt^.Border then rec.Align_Border_BkGr := rec.Align_Border_BkGr or $40; end; - if uffBackgroundColor in fmt^.UsedFormattingFields then + if uffBackground in fmt^.UsedFormattingFields then rec.Align_Border_BkGr := rec.Align_Border_BkGr or $80; end; AStream.WriteBuffer(rec, SizeOf(rec)); @@ -1399,7 +1400,6 @@ var rec: TBIFF2_XFRecord; b: Byte; j: Integer; - clr: TsColorvalue; begin Unused(XFType_Prot); @@ -1460,12 +1460,8 @@ begin if cbNorth in AFormatRecord^.Border then b := b or $20; if cbSouth in AFormatRecord^.Border then b := b or $40; end; - if (uffBackgroundColor in AFormatRecord^.UsedFormattingFields) then - begin - clr := Workbook.GetPaletteColor(AFormatRecord^.BackgroundColor); - if clr <> $FFFFFF then - b := b or $80; - end; + if (uffBackground in AFormatRecord^.UsedFormattingFields) then + b := b or $80; end; rec.HorAlign_Border_BkGr:= b; diff --git a/components/fpspreadsheet/xlsbiff5.pas b/components/fpspreadsheet/xlsbiff5.pas index 38c16d12f..a785bc907 100755 --- a/components/fpspreadsheet/xlsbiff5.pas +++ b/components/fpspreadsheet/xlsbiff5.pas @@ -543,7 +543,6 @@ begin SetLength(s, Len); AStream.ReadBuffer(s[1], len); if (FIncompleteCell <> nil) and (s <> '') then begin -// FIncompleteCell^.UTF8StringValue := AnsiToUTF8(s); FIncompletecell^.UTF8StringValue := ConvertEncoding(s, FCodePage, encodingUTF8); FIncompleteCell^.ContentType := cctUTF8String; if FIsVirtualMode then @@ -591,6 +590,7 @@ var b: Byte; dw: DWord; fill: Word; + fs: TsFillStyle; begin InitFormatRecord(fmt); fmt.ID := FCellFormatList.Count; @@ -696,15 +696,26 @@ begin fmt.BorderStyles[cbNorth].Color := (rec.Border_BkGr2 and MASK_XF_BORDER_TOP_COLOR) shr 9; fmt.BorderStyles[cbSouth].Color := (rec.Border_BkGr1 and MASK_XF_BORDER_BOTTOM_COLOR) shr 25; - // Background fill style + // Background fill := (rec.Border_BkGr1 and MASK_XF_BKGR_FILLPATTERN) shr 16; - - // Background color - if fill = 0 then - fmt.BackgroundColor := scTransparent - else begin - fmt.BackgroundColor := rec.Border_BkGr1 and MASK_XF_BKGR_PATTERN_COLOR; - Include(fmt.UsedFormattingFields, uffBackgroundColor); + for fs in TsFillStyle do + begin + if fs = fsNoFill then + Continue; + if fill = MASK_XF_FILL_PATT[fs] then + begin + // Fill style + fmt.Background.Style := fs; + // Pattern color + fmt.Background.FgColor := rec.Border_BkGr1 and MASK_XF_BKGR_PATTERN_COLOR; + if fmt.Background.FgColor = SYS_DEFAULT_FOREGROUND_COLOR then + fmt.Background.FgColor := scBlack; + fmt.Background.BgColor := (rec.Border_BkGr1 and MASK_XF_BKGR_BACKGROUND_COLOR) shr 7; + if fmt.Background.BgColor = SYS_DEFAULT_BACKGROUND_COLOR then + fmt.Background.BgColor := scTransparent; + Include(fmt.UsedFormattingFields, uffBackground); + break; + end; end; // Add the XF to the list @@ -1488,11 +1499,16 @@ begin dw2 := 0; if (AFormatRecord <> nil) then begin - if (uffBackgroundColor in AFormatRecord^.UsedFormattingFields) then + // Background fill pattern + if (uffBackground in AFormatRecord^.UsedFormattingFields) then begin - // Background color - dw1 := dw1 or (FixColor(AFormatRecord^.BackgroundColor) and $0000007F); - dw1 := dw1 or (MASK_XF_FILL_PATT_SOLID shl 16); + if (AFormatRecord^.Background.FgColor = scTransparent) + then dw1 := dw1 or (SYS_DEFAULT_FOREGROUND_COLOR and $0000007F) + else dw1 := dw1 or (FixColor(AFormatRecord^.Background.FgColor) and $0000007F); + if AFormatRecord^.Background.BgColor = scTransparent + then dw1 := dw1 or (SYS_DEFAULT_BACKGROUND_COLOR shl 7) + else dw1 := dw1 or (FixColor(AFormatRecord^.Background.BgColor) shl 7); + dw1 := dw1 or (MASK_XF_FILL_PATT[AFormatRecord^.Background.Style] shl 16); end; // Border lines if (uffBorder in AFormatRecord^.UsedFormattingFields) then diff --git a/components/fpspreadsheet/xlsbiff8.pas b/components/fpspreadsheet/xlsbiff8.pas index 0f432c8e3..61b067845 100755 --- a/components/fpspreadsheet/xlsbiff8.pas +++ b/components/fpspreadsheet/xlsbiff8.pas @@ -1162,6 +1162,7 @@ var b: Byte; dw: DWord; fill: Integer; + fs: TsFillStyle; nfidx: Integer; nfdata: TsNumFormatData; i: Integer; @@ -1282,16 +1283,28 @@ begin fmt.BorderStyles[cbDiagUp].Color := (rec.Border_BkGr2 and MASK_XF_BORDER_DIAGONAL_COLOR) shr 14; fmt.BorderStyles[cbDiagDown].Color := fmt.BorderStyles[cbDiagUp].Color; - // Background fill pattern + // Background fill pattern and color fill := (rec.Border_BkGr2 and MASK_XF_BACKGROUND_PATTERN) shr 26; - - // Background color - rec.BkGr3 := DWordLEToN(rec.BkGr3); - if fill <> 0 then begin - fmt.BackgroundColor := rec.BkGr3 and $007F; - Include(fmt.UsedFormattingFields, uffBackgroundColor); - end else - fmt.BackgroundColor := scTransparent; // this means "no fill" + if fill <> MASK_XF_FILL_PATT_EMPTY then + begin + for fs in TsFillStyle do + if fill = MASK_XF_FILL_PATT[fs] then + begin + rec.BkGr3 := DWordLEToN(rec.BkGr3); + // Pattern color + fmt.Background.FgColor := rec.BkGr3 and $007F; + if fmt.Background.FgColor = SYS_DEFAULT_FOREGROUND_COLOR then + fmt.Background.FgColor := scBlack; + // Background color + fmt.Background.BgColor := (rec.BkGr3 and $3F80) shr 7; + if fmt.Background.BgColor = SYS_DEFAULT_BACKGROUND_COLOR then + fmt.Background.BgColor := scTransparent; + // Fill style + fmt.Background.Style := fs; + Include(fmt.UsedFormattingFields, uffBackground); + break; + end; + end; // Add the XF to the list FCellFormatList.Add(fmt); @@ -2386,6 +2399,7 @@ var j: Integer; b: Byte; dw1, dw2: DWord; + w3: Word; begin { BIFF record header } rec.RecordID := WordToLE(INT_EXCEL_ID_XF); @@ -2471,7 +2485,7 @@ begin dw1 := 0; dw2 := 0; - rec.BkGr3 := 0; + w3 := 0; if (AFormatRecord <> nil) and (uffBorder in AFormatRecord^.UsedFormattingFields) then begin // Left and right line colors @@ -2503,15 +2517,24 @@ begin // In BIFF8 both diagonals have the same line style - we use the color of the up-diagonal. end; - if (AFormatRecord <> nil) and (uffBackgroundColor in AFormatRecord^.UsedFormattingFields) then + { Background fill } + if (AFormatRecord <> nil) and (uffBackground in AFormatRecord^.UsedFormattingFields) then begin - dw2 := dw2 or DWORD(MASK_XF_FILL_PATT_SOLID shl 26); - rec.BkGr3 := FixColor(AFormatRecord^.BackgroundColor); + // Fill pattern style + dw2 := dw2 or DWORD(MASK_XF_FILL_PATT[AFormatRecord^.Background.Style] shl 26); + // Pattern color + if AFormatRecord^.Background.FgColor = scTransparent + then w3 := w3 or SYS_DEFAULT_FOREGROUND_COLOR + else w3 := w3 or FixColor(AFormatRecord^.Background.FgColor); + // Background color + if AFormatRecord^.Background.BgColor = scTransparent + then w3 := w3 or SYS_DEFAULT_BACKGROUND_COLOR shl 7 + else w3 := w3 or (FixColor(AFormatRecord^.Background.BgColor) shl 7); end; rec.Border_BkGr1 := DWordToLE(dw1); rec.Border_BkGr2 := DWordToLE(dw2); - rec.BkGr3 := WordToLE(rec.BkGr3); + rec.BkGr3 := WordToLE(w3); { Write out } AStream.WriteBuffer(rec, SizeOf(rec)); diff --git a/components/fpspreadsheet/xlscommon.pas b/components/fpspreadsheet/xlscommon.pas index d6609621b..dce0cc3ff 100644 --- a/components/fpspreadsheet/xlscommon.pas +++ b/components/fpspreadsheet/xlscommon.pas @@ -163,6 +163,28 @@ const MASK_XF_FILL_PATT_EMPTY = $00; MASK_XF_FILL_PATT_SOLID = $01; + MASK_XF_FILL_PATT: array[TsFillStyle] of Byte = ( + $00, // fsNoFill + $01, // fsSolidFill + $03, // fsGray75 + $02, // fsGray50 + $04, // fsGray25 + $11, // fsGray12 + $12, // fsGray6, + $05, // fsStripeHor + $06, // fsStripeVert + $08, // fsStripeDiagUp + $07, // fsStripeDiagDown + $0B, // fsThinStripeHor + $0C, // fsThinStripeVert + $0E, // fsThinStripeDiagUp + $0D, // fsThinStripeDiagDown + $09, // fsHatchDiag + $10, // fsThinHatchDiag + $0A, // fsThickHatchDiag + $0F // fsThinHatchHor + ); + { Cell Addresses constants, valid for BIFF2-BIFF5 } MASK_EXCEL_ROW = $3FFF; MASK_EXCEL_RELATIVE_COL = $4000; @@ -175,6 +197,11 @@ const MASK_FORMULA_RECALCULATE_ON_OPEN = $0002; MASK_FORMULA_SHARED_FORMULA = $0008; + { System colors, for BIFF5-BIFF8 } + SYS_DEFAULT_FOREGROUND_COLOR = $0040; + SYS_DEFAULT_BACKGROUND_COLOR = $0041; + + { Error codes } ERR_INTERSECTION_EMPTY = $00; // #NULL! ERR_DIVIDE_BY_ZERO = $07; // #DIV/0! diff --git a/components/fpspreadsheet/xlsxooxml.pas b/components/fpspreadsheet/xlsxooxml.pas index d09fa5e89..7fb9f8931 100755 --- a/components/fpspreadsheet/xlsxooxml.pas +++ b/components/fpspreadsheet/xlsxooxml.pas @@ -328,6 +328,31 @@ type BorderStyles: TsCellBorderStyles; end; +const + PATTERN_TYPES: array [TsFillStyle] of string = ( + 'none', // fsNoFill + 'solid', // fsSolidFill + 'darkGray', // fsGray75 + 'mediumGray', // fsGray50 + 'lightGray', // fsGray25 + 'gray125', // fsGray12 + 'gray0625', // fsGray6, + 'darkHorizontal', // fsStripeHor + 'darkVertical', // fsStripeVert + 'darkUp', // fsStripeDiagUp + 'darkDown', // fsStripeDiagDown + 'lightHorizontal', // fsThinStripeHor + 'lightVertical', // fsThinStripeVert + 'lightUp', // fsThinStripeDiagUp + 'lightDown', // fsThinStripeDiagDown + 'darkTrellis', // fsHatchDiag + 'lightTrellis', // fsHatchThinDiag + 'darkTellis', // fsHatchTickDiag + 'lightGrid' // fsHatchThinHor + ); + + + { TsOOXMLNumFormatList } @@ -718,6 +743,7 @@ var childNode: TDOMNode; nodeName: String; fmt: TsCellFormat; + fs: TsFillStyle; s1, s2: String; i, numFmtIndex, fillIndex, borderIndex: Integer; numFmtData: TsNumFormatData; @@ -770,8 +796,15 @@ begin fillIndex := StrToInt(s1); fillData := FFillList[fillIndex]; if (fillData <> nil) and (fillData.PatternType <> 'none') then begin - Include(fmt.UsedFormattingFields, uffBackgroundColor); - fmt.BackgroundColor := fillData.FgColor; + fmt.Background.FgColor := fillData.FgColor; + fmt.Background.BgColor := fillData.BgColor; + for fs in TsFillStyle do + if SameText(fillData.PatternType, PATTERN_TYPES[fs]) then + begin + fmt.Background.Style := fs; + Include(fmt.UsedFormattingFields, uffBackground); + break; + end; end; end; @@ -859,6 +892,15 @@ var begin Assert(ANode <> nil); + s := GetAttrValue(ANode, 'auto'); + if s = '1' then begin + if ANode.NodeName = 'fgColor' then + Result := scBlack + else + Result := scTransparent; + exit; + end; + s := GetAttrValue(ANode, 'rgb'); if s <> '' then begin Result := FWorkbook.AddColorToPalette(HTMLColorStrToColor('#' + s)); @@ -1640,13 +1682,28 @@ var i: Integer; fmt: PsCellFormat; begin - if (AFormat = nil) or not (uffBackgroundColor in AFormat^.UsedFormattingFields) + if (AFormat = nil) or not (uffBackground in AFormat^.UsedFormattingFields) then begin Result := 0; exit; end; // Index 0 is "no fill" which already has been handled. + for i:=1 to High(FFillList) do begin + fmt := FFillList[i]; + if (fmt <> nil) and (uffBackground in fmt^.UsedFormattingFields) then + begin + if (AFormat^.Background.Style = fmt^.Background.Style) and + (AFormat^.Background.BgColor = fmt^.Background.BgColor) and + (AFormat^.Background.FgColor = fmt^.Background.FgColor) + then begin + Result := i; + exit; + end; + end; + end; + + { // Index 1 is also pre-defined (gray 25%) for i:=2 to High(FFillList) do begin fmt := FFillList[i]; @@ -1657,8 +1714,9 @@ begin exit; end; end; + } - // Not found --> return -1 + // Not found --> return -1 Result := -1; end; @@ -1893,7 +1951,7 @@ end; procedure TsSpreadOOXMLWriter.WriteFillList(AStream: TStream); var i: Integer; - rgb: TsColorValue; + pt, bc, fc: string; begin AppendToStream(AStream, Format( '', [Length(FFillList)])); @@ -1912,15 +1970,23 @@ begin // user-defined fills for i:=2 to High(FFillList) do begin - rgb := Workbook.GetPaletteColor(FFillList[i]^.BackgroundColor); + pt := PATTERN_TYPES[FFillList[i]^.Background.Style]; + if FFillList[i]^.Background.FgColor = scTransparent then + fc := 'auto="1"' + else + fc := Format('rgb="%s"', [Copy(Workbook.GetPaletteColorAsHTMLStr(FFillList[i]^.Background.FgColor), 2, 255)]); + if FFillList[i].Background.BgColor = scTransparent then + bc := 'auto="1"' + else + bc := Format('rgb="%s"', [Copy(Workbook.GetPaletteColorAsHTMLStr(FFillList[i]^.Background.BgColor), 2, 255)]); AppendToStream(AStream, - '', - ''); + ''); AppendToStream(AStream, Format( - '', [Copy(ColorToHTMLColorStr(rgb), 2, 255)]), - ''); - AppendToStream(AStream, - '', + '', [pt]) + Format( + '', [fc]) + Format( + '', [bc]) + +// '' + + '' + ''); end; @@ -2302,7 +2368,7 @@ begin sAlign := sAlign + 'wrapText="1" '; { Fill } - if (uffBackgroundColor in fmt.UsedFormattingFields) then + if (uffBackground in fmt.UsedFormattingFields) then begin fillID := FindFillInList(fmt); if fillID = -1 then fillID := 0;