FPSpreadsheet: Adds support to 16 possible background colors to biff 8

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1648 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/fpspreadsheet/examples/excel8demo/excel8write_format.pas

@@ -108,6 +108,7 @@ begin
   MyWorksheet.WriteUTF8Text(5, 9, '[N,W,E,S]');// J6
   MyCell := MyWorksheet.GetCell(5, 9);
   MyCell^.Border := [cbNorth, cbWest, cbEast, cbSouth];
+  MyCell^.BackgroundColor := scGreen;
   MyCell^.UsedFormattingFields := [uffBorder, uffBold, uffBackgroundColor];
 
   // Save the spreadsheet to a file

components/fpspreadsheet/fpspreadsheet.pas

@@ -121,9 +121,26 @@ type
 
   TsCellBorders = set of TsCellBorder;
 
-  {.@@ Colors in FPSpreadsheet as given by a list of possible default values }
+  {@@ Colors in FPSpreadsheet as given by a pallete to be compatible with Excel }
 
-  TsColor = (scLtGrey);
+  TsColor = (
+    scBlack,    // 000000H
+    scWhite,    // FFFFFFH
+    scRed,      // FF0000H
+    scGREEN,    // 00FF00H
+    scBLUE,     // 0000FFH
+    scYELLOW,   // FFFF00H
+    scMAGENTA,  // FF00FFH
+    scCYAN,     // 00FFFFH
+    scDarkRed,  // 800000H
+    scDarkGreen,// 008000H
+    scDarkBlue, // 000080H
+    scOLIVE,    // 808000H
+    scPURPLE,   // 800080H
+    scTEAL,     // 008080H
+    scSilver,   // C0C0C0H
+    scGrey      // 808080H
+  );
 
   {@@ Cell structure for TsWorksheet
 

components/fpspreadsheet/xlsbiff8.pas

@@ -129,7 +129,7 @@ type
     procedure WriteWindow2(AStream: TStream; ASheetSelected: Boolean);
     procedure WriteXF(AStream: TStream; AFontIndex: Word;
       AXF_TYPE_PROT, ATextRotation: Byte; ABorders: TsCellBorders;
-      AddBackground: Boolean = False);
+      AddBackground: Boolean = False; ABackgroundColor: TsColor = scSilver);
   end;
 
 implementation
@@ -243,24 +243,6 @@ const
 
   MASK_XF_VERT_ALIGN                  = $70;
 
-  { Color Indexes }
-  BUILT_IN_COLOR_PALLETE_BLACK     = $08; // 000000H
-  BUILT_IN_COLOR_PALLETE_WHITE     = $09; // FFFFFFH
-  BUILT_IN_COLOR_PALLETE_RED       = $0A; // FF0000H
-  BUILT_IN_COLOR_PALLETE_GREEN     = $0B; // 00FF00H
-  BUILT_IN_COLOR_PALLETE_BLUE      = $0C; // 0000FFH
-  BUILT_IN_COLOR_PALLETE_YELLOW    = $0D; // FFFF00H
-  BUILT_IN_COLOR_PALLETE_MAGENTA   = $0E; // FF00FFH
-  BUILT_IN_COLOR_PALLETE_CYAN      = $0F; // 00FFFFH
-  BUILT_IN_COLOR_PALLETE_DARK_RED  = $10; // 800000H
-  BUILT_IN_COLOR_PALLETE_DARK_GREEN= $11; // 008000H
-  BUILT_IN_COLOR_PALLETE_DARK_BLUE = $12; // 000080H
-  BUILT_IN_COLOR_PALLETE_OLIVE     = $13; // 808000H
-  BUILT_IN_COLOR_PALLETE_PURPLE    = $14; // 800080H
-  BUILT_IN_COLOR_PALLETE_TEAL      = $15; // 008080H
-  BUILT_IN_COLOR_PALLETE_SILVER    = $16; // C0C0C0H
-  BUILT_IN_COLOR_PALLETE_GREY      = $17; // 808080H
-
 {
   Exported functions
 }
@@ -316,6 +298,7 @@ var
   lTextRotation: Byte;
   lBorders: TsCellBorders;
   lAddBackground: Boolean;
+  lBackgroundColor: TsColor;
 begin
   // The first 4 styles were already added
   for i := 4 to Length(FFormattingStyles) - 1 do
@@ -325,6 +308,7 @@ begin
     lTextRotation := XF_ROTATION_HORIZONTAL;
     lBorders := [];
     lAddBackground := False;
+    lBackgroundColor := FFormattingStyles[i].BackgroundColor;
 
     // Now apply the modifications
     if uffBorder in FFormattingStyles[i].UsedFormattingFields then
@@ -346,7 +330,7 @@ begin
       lAddBackground := True;
 
     // And finally write the style
-    WriteXF(AStream, lFontIndex, 0, lTextRotation, lBorders, lAddBackground);
+    WriteXF(AStream, lFontIndex, 0, lTextRotation, lBorders, lAddBackground, lBackgroundColor);
   end;
 end;
 
@@ -1056,7 +1040,7 @@ end;
 *******************************************************************}
 procedure TsSpreadBIFF8Writer.WriteXF(AStream: TStream; AFontIndex: Word;
  AXF_TYPE_PROT, ATextRotation: Byte; ABorders: TsCellBorders;
- AddBackground: Boolean = False);
+ AddBackground: Boolean = False; ABackgroundColor: TsColor = scSilver);
 var
   XFOptions: Word;
   XFAlignment, XFOrientationAttrib: Byte;
@@ -1120,7 +1104,7 @@ begin
   if AddBackground then XFBorderDWord2 := XFBorderDWord2 or $4000000;
   AStream.WriteDWord(DWordToLE(XFBorderDWord2));
   // Background Pattern Color, always zeroed
-  if AddBackground then AStream.WriteWord(WordToLE(BUILT_IN_COLOR_PALLETE_SILVER))
+  if AddBackground then AStream.WriteWord(WordToLE(FPSColorToEXCELPallete(ABackgroundColor)))
   else AStream.WriteWord(0);
 end;
 

components/fpspreadsheet/xlsbiffcommon.pas

@@ -11,6 +11,26 @@ uses
   fpspreadsheet,
   fpsutils;
 
+{ Excel Constants which don't change across versions }
+const
+  { Built In Color Pallete Indexes }
+  BUILT_IN_COLOR_PALLETE_BLACK     = $08; // 000000H
+  BUILT_IN_COLOR_PALLETE_WHITE     = $09; // FFFFFFH
+  BUILT_IN_COLOR_PALLETE_RED       = $0A; // FF0000H
+  BUILT_IN_COLOR_PALLETE_GREEN     = $0B; // 00FF00H
+  BUILT_IN_COLOR_PALLETE_BLUE      = $0C; // 0000FFH
+  BUILT_IN_COLOR_PALLETE_YELLOW    = $0D; // FFFF00H
+  BUILT_IN_COLOR_PALLETE_MAGENTA   = $0E; // FF00FFH
+  BUILT_IN_COLOR_PALLETE_CYAN      = $0F; // 00FFFFH
+  BUILT_IN_COLOR_PALLETE_DARK_RED  = $10; // 800000H
+  BUILT_IN_COLOR_PALLETE_DARK_GREEN= $11; // 008000H
+  BUILT_IN_COLOR_PALLETE_DARK_BLUE = $12; // 000080H
+  BUILT_IN_COLOR_PALLETE_OLIVE     = $13; // 808000H
+  BUILT_IN_COLOR_PALLETE_PURPLE    = $14; // 800080H
+  BUILT_IN_COLOR_PALLETE_TEAL      = $15; // 008080H
+  BUILT_IN_COLOR_PALLETE_SILVER    = $16; // C0C0C0H
+  BUILT_IN_COLOR_PALLETE_GREY      = $17; // 808080H
+
 type
 
   { TsSpreadBIFFReader }
@@ -29,6 +49,7 @@ type
     }
     FFormattingStyles: array of TCell;
     NextXFIndex: Integer; // Indicates which should be the next XF Index when filling the styles list
+    function FPSColorToEXCELPallete(AColor: TsColor): Word;
     function FindFormattingInList(AFormat: PCell): Integer;
     procedure AddDefaultFormats(); virtual;
     procedure ListAllFormattingStylesCallback(ACell: PCell; AStream: TStream);
@@ -37,6 +58,28 @@ type
 
 implementation
 
+function TsSpreadBIFFWriter.FPSColorToEXCELPallete(AColor: TsColor): Word;
+begin
+  case AColor of
+    scBlack: Result := BUILT_IN_COLOR_PALLETE_BLACK;
+    scWhite: Result := BUILT_IN_COLOR_PALLETE_WHITE;
+    scRed: Result := BUILT_IN_COLOR_PALLETE_RED;
+    scGREEN: Result := BUILT_IN_COLOR_PALLETE_GREEN;
+    scBLUE: Result := BUILT_IN_COLOR_PALLETE_BLUE;
+    scYELLOW: Result := BUILT_IN_COLOR_PALLETE_YELLOW;
+    scMAGENTA: Result := BUILT_IN_COLOR_PALLETE_MAGENTA;
+    scCYAN: Result := BUILT_IN_COLOR_PALLETE_CYAN;
+    scDarkRed: Result := BUILT_IN_COLOR_PALLETE_DARK_RED;
+    scDarkGreen: Result := BUILT_IN_COLOR_PALLETE_DARK_GREEN;
+    scDarkBlue: Result := BUILT_IN_COLOR_PALLETE_DARK_BLUE;
+    scOLIVE: Result := BUILT_IN_COLOR_PALLETE_OLIVE;
+    scPURPLE: Result := BUILT_IN_COLOR_PALLETE_PURPLE;
+    scTEAL: Result := BUILT_IN_COLOR_PALLETE_TEAL;
+    scSilver: Result := BUILT_IN_COLOR_PALLETE_SILVER;
+    scGrey: Result := BUILT_IN_COLOR_PALLETE_GREY;
+  end;
+end;
+
 {
   Checks if the style of a cell is in the list FFormattingStyles and returns the index
   or -1 if it isn't