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

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

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

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
+    if  (uffBackground in fmt^.UsedFormattingFields) then
-      FBackgroundColor := fmt^.BackgroundColor;
+    begin
+      if fmt^.Background.Style = fsSolidFill then
+        FBackgroundColor := fmt^.Background.FgColor
+      else
+        FBackgroundColor := fmt^.Background.BgColor;
+    end;
   end;
 end;
 

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,
+              // ODS does not support background fill patterns!
-                Workbook.AddColorToPalette(clr));
+              fmt.Background.FgColor := IfThen(clr = TsColorValue(-1),
-              if (fmt.BackgroundColor <> scNotDefined) then
+                scTransparent, Workbook.AddColorToPalette(clr));
-                Include(fmt.UsedFormattingFields, uffBackgroundColor);
+              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;
 

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;
+    function WriteRPNFormula(ARow, ACol: Cardinal;
-    procedure WriteRPNFormula(ACell: PCell; AFormula: TsRPNFormula); overload;
+      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;
+    function WriteBorderColor(ARow, ACol: Cardinal; ABorder: TsCellBorder;
-    procedure WriteBorderColor(ACell: PCell; ABorder: TsCellBorder; AColor: TsColor); overload;
+      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
+    if (uffBackground in fmt^.UsedFormattingFields) then
-      Result := fmt^.BackgroundColor
+    begin
-    else
+      if (fmt^.Background.Style = fsSolidFill) then
-      Result := scTransparent;
+        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
+      WriteBackground(ACell, fsSolidFill, AColor, AColor);
-      Include(fmt.UsedFormattingFields, uffBackgroundColor);
-      fmt.BackgroundColor := AColor;
-    end;
-    ACell^.FormatIndex := Workbook.AddCellFormat(fmt);
-    ChangedCell(ACell^.Row, ACell^.Col);
   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 (uffBackground in fmt^.UsedFormattingFields) then
-        if fmt^.BackgroundColor = AColorIndex then exit;
+      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

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)
+  if (ACell = nil) or not (uffBackground in fmt.UsedformattingFields) then
-    then AStrings.Add('BackgroundColor=')
+  begin
-    else AStrings.Add(Format('BackgroundColor=%d (%s)', [
+    AStrings.Add('Style=');
-           fmt.BackgroundColor,
+    AStrings.Add('PatternColor=');
-           Workbook.GetColorName(fmt.BackgroundColor)]));
+    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

components/fpspreadsheet/fpspreadsheetgrid.pas

@@ -591,25 +591,163 @@ const
 
 
 var
-  {@@ Auxiliary bitmap containing the fill pattern used by biff2 cell backgrounds. }
+  {@@ Auxiliary bitmap containing the previously used non-trivial fill pattern }
-  FillPattern_BIFF2: TBitmap = nil;
+  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);
+procedure CreateFillPattern(var ABitmap: TBitmap; AStyle: TsFillStyle;
-begin
+  AFgColor, ABgColor: TColor);
-  FreeAndNil(FillPattern_BIFF2);
+
-  FillPattern_BIFF2 := TBitmap.Create;
+  procedure SolidFill(AColor: TColor);
-  with FillPattern_BIFF2 do begin
+  begin
-    SetSize(4, 4);
+    ABitmap.Canvas.Brush.Color := AColor;
-    Canvas.Brush.Color := ABkColor;
+    ABitmap.Canvas.FillRect(0, 0, ABitmap.Width, ABitmap.Height);
-    Canvas.FillRect(0, 0, Width, Height);
-    Canvas.Pixels[0, 0] := clBlack;
-    Canvas.Pixels[2, 2] := clBlack;
   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
+          CreateFillPattern(FillPatternBitmap, fsGray50, clBlack, Color);
-            Create_FillPattern_BIFF2(Color);
           Canvas.Brush.Style := bsImage;
-          Canvas.Brush.Bitmap := FillPattern_BIFF2;
+          Canvas.Brush.Bitmap := FillPatternBitmap;
         end else
         begin
-          Canvas.Brush.Style := bsSolid;
+          case fmt^.Background.Style of
-          if fmt^.BackgroundColor < Workbook.GetPaletteSize then
+            fsNoFill:
-            Canvas.Brush.Color := Workbook.GetPaletteColor(fmt^.BackgroundColor)
+              Canvas.Brush.Style := bsClear;
-          else
+            fsSolidFill:
-            Canvas.Brush.Color := Color;
+              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.

components/fpspreadsheet/fpstypes.pas

@@ -147,9 +147,9 @@ type
 
   {@@ List of possible formatting fields }
   TsUsedFormattingField = (uffTextRotation, uffFont, uffBold, uffBorder,
-    uffBackgroundColor, uffNumberFormat, uffWordWrap,
+    uffBackground, uffNumberFormat, uffWordWrap, uffHorAlign, uffVertAlign
-    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;
+    Background: TsFillPattern;
-    RGBBackgroundColor: TFPColor; // only valid if BackgroundColor=scRGBCOLOR
     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^.Background := AItem.Background;
-    P^.RGBBackgroundColor := AItem.RGBBackgroundColor;
     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 (uffBackground in AItem.UsedFormattingFields) then begin
-      if (P^.BackgroundColor <> AItem.BackgroundColor) then continue;
+      if (P^.Background.Style <> AItem.Background.Style) then continue;
-      if (AItem.BackgroundColor = scRGBColor) then
+      if (P^.Background.BgColor <> AItem.Background.BgColor) then continue;
-        if (P^.RGBBackgroundColor <> AItem.RGBBackgroundColor) then continue;
+      if (P^.Background.FgColor <> AItem.Background.FgColor) then continue;
     end;
 
     if (uffNumberFormat in AItem.UsedFormattingFields) then begin

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),

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);

components/fpspreadsheet/tests/spreadtestgui.lpi

@@ -131,6 +131,7 @@
       <Unit20>
         <Filename Value="copytests.pas"/>
         <IsPartOfProject Value="True"/>
+        <UnitName Value="copytests"/>
       </Unit20>
       <Unit21>
         <Filename Value="commenttests.pas"/>

components/fpspreadsheet/wikitable.pas

@@ -492,7 +492,7 @@ begin
         lCurStr := '<b>' + lCurStr + '</b>';
 
       // Background color
-      if uffBackgroundColor in lCurUsedFormatting then
+      if uffBackground in lCurUsedFormatting then
       begin
         lCurColor := FWorksheet.ReadBackgroundColor(lCell);
         lStyleStr := Format('background-color:%s;color:%s;', [

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"
+    fmt.Background.Style := fsGray50;
-    Include(fmt.UsedFormattingFields, uffBackgroundColor);
+    fmt.Background.FgColor := scBlack;
-  end else
+    fmt.Background.BgColor := scTransparent;
-    fmt.BackgroundColor := 0;   // encodes "shaded background = false"
+    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
+    if (uffBackground in AFormatRecord^.UsedFormattingFields) then
-    begin
+      b := b or $80;
-      clr := Workbook.GetPaletteColor(AFormatRecord^.BackgroundColor);
-      if clr <> $FFFFFF then
-        b := b or $80;
-    end;
   end;
   rec.HorAlign_Border_BkGr:= 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;
-
+  for fs in TsFillStyle do
-  // Background color
+  begin
-  if fill = 0 then
+    if fs = fsNoFill then
-    fmt.BackgroundColor := scTransparent
+      Continue;
-  else begin
+    if fill = MASK_XF_FILL_PATT[fs] then
-    fmt.BackgroundColor := rec.Border_BkGr1 and MASK_XF_BKGR_PATTERN_COLOR;
+    begin
-    Include(fmt.UsedFormattingFields, uffBackgroundColor);
+      // 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
+      if (AFormatRecord^.Background.FgColor = scTransparent)
-      dw1 := dw1 or (FixColor(AFormatRecord^.BackgroundColor) and $0000007F);
+        then dw1 := dw1 or (SYS_DEFAULT_FOREGROUND_COLOR and $0000007F)
-      dw1 := dw1 or (MASK_XF_FILL_PATT_SOLID shl 16);
+        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

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;
-
+  if fill <> MASK_XF_FILL_PATT_EMPTY then
-  // Background color
+  begin
-  rec.BkGr3 := DWordLEToN(rec.BkGr3);
+    for fs in TsFillStyle do
-  if fill <> 0 then begin
+      if fill = MASK_XF_FILL_PATT[fs] then
-    fmt.BackgroundColor := rec.BkGr3 and $007F;
+      begin
-    Include(fmt.UsedFormattingFields, uffBackgroundColor);
+        rec.BkGr3 := DWordLEToN(rec.BkGr3);
-  end else
+        // Pattern color
-    fmt.BackgroundColor := scTransparent;  // this means "no fill"
+        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);
+    // Fill pattern style
-    rec.BkGr3 := FixColor(AFormatRecord^.BackgroundColor);
+    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));

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!

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.Background.FgColor := fillData.FgColor;
-          fmt.BackgroundColor := 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(
     '<fills count="%d">', [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,
-      '<fill>',
+      '<fill>');
-        '<patternFill patternType="solid">');
     AppendToStream(AStream, Format(
-          '<fgColor rgb="%s" />', [Copy(ColorToHTMLColorStr(rgb), 2, 255)]),
+        '<patternFill patternType="%s">', [pt]) + Format(
-          '<bgColor indexed="64" />');
+          '<fgColor %s />', [fc]) + Format(
-    AppendToStream(AStream,
+          '<bgColor %s />', [bc]) +
-        '</patternFill>',
+//          '<bgColor indexed="64" />' +
+        '</patternFill>' +
       '</fill>');
   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;