diff --git a/components/fpspreadsheet/examples/excel8demo/excel8write.lpr b/components/fpspreadsheet/examples/excel8demo/excel8write.lpr
index 6751c9856..dea9d9660 100644
--- a/components/fpspreadsheet/examples/excel8demo/excel8write.lpr
+++ b/components/fpspreadsheet/examples/excel8demo/excel8write.lpr
@@ -37,7 +37,7 @@ begin
// Create the spreadsheet
MyWorkbook := TsWorkbook.Create;
MyWorkbook.SetDefaultFont('Calibri', 9);
- MyWorkbook.UsePalette(@PALETTE_BIFF8, 64, true);
+ MyWorkbook.UsePalette(@PALETTE_BIFF8, Length(PALETTE_BIFF8));
MyWorksheet := MyWorkbook.AddWorksheet(Str_Worksheet1);
diff --git a/components/fpspreadsheet/examples/fpsgrid/fpsgrid.lpi b/components/fpspreadsheet/examples/fpsgrid/fpsgrid.lpi
index d5019c1ec..f5566ac64 100644
--- a/components/fpspreadsheet/examples/fpsgrid/fpsgrid.lpi
+++ b/components/fpspreadsheet/examples/fpsgrid/fpsgrid.lpi
@@ -116,8 +116,8 @@
-
-
+
+
@@ -131,7 +131,7 @@
-
+
@@ -140,22 +140,23 @@
-
-
-
+
+
+
-
+
+
-
-
-
+
+
+
@@ -220,7 +221,7 @@
-
+
@@ -238,7 +239,7 @@
-
+
@@ -255,7 +256,7 @@
-
+
@@ -264,7 +265,7 @@
-
+
@@ -272,9 +273,9 @@
-
-
-
+
+
+
@@ -297,28 +298,29 @@
-
-
-
+
+
+
+
-
-
-
+
+
+
+
-
-
+
-
-
-
+
+
+
@@ -351,130 +353,130 @@
-
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
+
-
-
+
+
diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas
index 90ed043c7..4db506adc 100755
--- a/components/fpspreadsheet/fpspreadsheet.pas
+++ b/components/fpspreadsheet/fpspreadsheet.pas
@@ -181,8 +181,9 @@ type
{@@
Colors in fpspreadsheet are given as indices into a palette.
- Use the workbook's GetPaletteColor to determine the color rgb value (with
- "r" being the low-value byte, in agreement with TColor).
+ Use the workbook's GetPaletteColor to determine the color rgb value as
+ little-endian (with "r" being the low-value byte, in agreement with TColor).
+ The data type for rgb values is TsColorValue.
}
TsColor = Word;
@@ -200,73 +201,32 @@ const
scYellow = $05;
scMagenta = $06;
scCyan = $07;
- scEGABlack = $08;
- scEGAWhite = $09;
- scEGARed = $0A;
- scEGAGreen = $0B;
- scEGABlue = $0C;
- scEGAYellow = $0D;
- scEGAMagenta = $0E;
- scEGACyan = $0F;
- scDarkRed = $10;
- scDarkGreen = $11;
- scDarkBlue = $12;
- scOLIVE = $13;
- scPURPLE = $14;
- scTEAL = $15;
- scSilver = $16;
- scGrey = $17;
- scOrange = $18;
+ scDarkRed = $08;
+ scDarkGreen = $09;
+ scDarkBlue = $0A; scNavy = $0A;
+ scOlive = $0B;
+ scPurple = $0C;
+ scTeal = $0D;
+ scSilver = $0E;
+ scGrey = $0F; scGray = $0F; // redefine to allow different kinds of writing
+ scGrey10pct = $10; scGray10pct = $10;
+ scGrey20pct = $11; scGray20pct = $11;
+ scOrange = $12;
+ scDarkbrown = $13;
+ scBrown = $14;
+ scBeige = $15;
+ scWheat = $16;
+
+ // not sure - but I think the mechanism with scRGBColor is not working...
+ // Will be removed sooner or later...
scRGBColor = $FFFF;
- {
- //
- scGrey10pct,// E6E6E6H
- scGrey20pct,// CCCCCCH
- scOrange, // ffa500H
- scDarkBrown,// a0522dH
- scBrown, // cd853fH
- scBeige, // f5f5dcH
- scWheat, // f5deb3H
- }
-
-
- {@@ Colors in FPSpreadsheet as given by a palette to be compatible with Excel.
- However, please note that they are physically written to XLS file as
- ABGR (where A is 0) }
- (*
- TsColor = ( // R G B color value:
- 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
- //
- scGrey10pct,// E6E6E6H
- scGrey20pct,// CCCCCCH
- scOrange, // ffa500H
- scDarkBrown,// a0522dH
- scBrown, // cd853fH
- scBeige, // f5f5dcH
- scWheat, // f5deb3H
- //
- scRGBCOLOR // Defined via TFPColor
- );
- *)
type
+ {@@ Data type for rgb color values }
+ TsColorValue = DWord;
+
{@@ Palette of color values }
- TsPalette = array[0..0] of DWord;
+ TsPalette = array[0..0] of TsColorValue;
PsPalette = ^TsPalette;
{@@ Font style (redefined to avoid usage of "Graphics" }
@@ -413,7 +373,7 @@ type
FFormat: TsSpreadsheetFormat;
FFontList: TFPList;
FBuiltinFontCount: Integer;
- FPalette: array of DWord;
+ FPalette: array of TsColorValue;
{ Internal methods }
procedure RemoveWorksheetsCallback(data, arg: pointer);
public
@@ -453,9 +413,12 @@ type
procedure SetDefaultFont(const AFontName: String; ASize: Single);
{ Color handling }
function FPSColorToHexString(AColor: TsColor; ARGBColor: TFPColor): String;
- function GetPaletteColor(AColorIndex: TsColor): DWord;
+ function GetColorName(AColorIndex: TsColor): string;
+ function GetPaletteColor(AColorIndex: TsColor): TsColorValue;
+ procedure SetPaletteColor(AColorIndex: TsColor; AColorValue: TsColorValue);
function GetPaletteSize: Integer;
- procedure UsePalette(APalette: PsPalette; APaletteCount: Word; AFlipBytes: Boolean);
+ procedure UsePalette(APalette: PsPalette; APaletteCount: Word;
+ ABigEndian: Boolean = false);
{@@ This property is only used for formats which don't support unicode
and support a single encoding for the whole document, like Excel 2 to 5 }
property Encoding: TsEncoding read FEncoding write FEncoding;
@@ -600,6 +563,8 @@ function GetFileFormatName(AFormat: TsSpreadsheetFormat): String;
function SciFloat(AValue: Double; ADecimals: Word): String;
function TimeIntervalToString(AValue: TDateTime): String;
+procedure MakeLEPalette(APalette: PsPalette; APaletteSize: Integer);
+
implementation
uses
@@ -613,12 +578,13 @@ resourcestring
lpUnknownSpreadsheetFormat = 'unknown format';
lpInvalidFontIndex = 'Invalid font index';
-const
+var
{@@
- Colors in RGB (red at left). Needs to be inverted to get TColor.
+ Colors in RGB in "big-endian" notation (red at left). The values are inverted
+ at initialization to be little-endian at run-time!
The indices into this palette are named as scXXXX color constants.
}
- DEFAULT_PALETTE: array[$0..$18] of DWord = (
+ DEFAULT_PALETTE: array[$00..$16] of TsColorValue = (
$000000, // $00: black
$FFFFFF, // $01: white
$FF0000, // $02: red
@@ -627,23 +593,47 @@ const
$FFFF00, // $05: yellow
$FF00FF, // $06: magenta
$00FFFF, // $07: cyan
- $000000, // $08: EGA black
- $FFFFFF, // $09: EGA white
- $FF0000, // $0A: EGA red
- $00FF00, // $0B: EGA green
- $0000FF, // $0C: EGA blue
- $FFFF00, // $0D: EGA yellow
- $FF00FF, // $0E: EGA magenta
- $00FFFF, // $0F: EGA cyan
- $800000, // $10: EGA dark red
- $008000, // $11: EGA dark green
- $000080, // $12: EGA dark blue
- $808000, // $13: EGA olive
- $800080, // $14: EGA purple
- $008080, // $15: EGA teal
- $C0C0C0, // $16: EGA silver
- $808080, // $17: EGA gray
- $FFA500 // $18: orange
+ $800000, // $08: dark red
+ $008000, // $09: dark green
+ $000080, // $0A: dark blue
+ $808000, // $0B: olive
+ $800080, // $0C: purple
+ $008080, // $0D: teal
+ $C0C0C0, // $0E: silver
+ $808080, // $0F: gray
+ $E6E6E6, // $10: gray 10%
+ $CCCCCC, // $11: gray 20%
+ $FFA500, // $12: orange
+ $A0522D, // $13: dark brown
+ $CD853F, // $14: brown
+ $F5F5DC, // $15: beige
+ $F5DEB3 // $16: wheat
+ );
+
+ DEFAULT_COLORNAMES: array[$00..$16] of string = (
+ 'black', // 0
+ 'white', // 1
+ 'red', // 2
+ 'green', // 3
+ 'blue', // 4
+ 'yellow', // 5
+ 'magenta', // 6
+ 'cyan', // 7
+ 'dark red', // 8
+ 'dark green', // 9
+ 'dark blue', // $0A
+ 'olive', // $0B
+ 'purple', // $0C
+ 'teal', // $0D
+ 'silver', // $0E
+ 'gray', // $0F
+ 'gray 10%', // $10
+ 'gray 20%', // $11
+ 'orange', // $12
+ 'dark brown', // $13
+ 'brown', // $14
+ 'beige', // $15
+ 'wheat' // $16
);
{@@
@@ -729,6 +719,25 @@ begin
if AValue < 0.0 then Result := '-' + Result;
end;
+{@@
+ If a palette is coded as big-endian (e.g. by copying the rgb values from
+ the OpenOffice doc) the palette values can be converted by means of this
+ procedure to little-endian which is required internally by TsWorkbook.
+}
+procedure MakeLEPalette(APalette: PsPalette; APaletteSize: Integer);
+var
+ i: Integer;
+begin
+ for i := 0 to APaletteSize-1 do
+ {$IFDEF RNGCHECK}
+ {$R-}
+ {$ENDIF}
+ APalette^[i] := LongRGBToExcelPhysical(APalette^[i])
+ {$IFDEF RNGCHECK}
+ {$R+}
+ {$ENDIF}
+end;
+
{ TsWorksheet }
@@ -2071,7 +2080,7 @@ function TsWorkbook.FPSColorToHexString(AColor: TsColor;
type
TRgba = packed record Red, Green, Blue, A: Byte end;
var
- color: DWord;
+ colorvalue: TsColorValue;
r,g,b: Byte;
begin
if AColor = scRGBColor then begin
@@ -2079,25 +2088,47 @@ begin
g := ARGBColor.Green div $100;
b := ARGBColor.Blue div $100;
end else begin
- color := GetPaletteColor(AColor);
- r := TRgba(color).Red;
- g := TRgba(color).Green;
- b := TRgba(color).Blue;
+ colorvalue := GetPaletteColor(AColor);
+ r := TRgba(colorvalue).Red;
+ g := TRgba(colorvalue).Green;
+ b := TRgba(colorvalue).Blue;
end;
Result := Format('%x%x%x', [r, g, b]);
end;
+{@@
+ Returns the name of the color pointed to by the given color index.
+ If the name is not known the hex string is returned as RRGGBB.
+}
+function TsWorkbook.GetColorName(AColorIndex: TsColor): string;
+var
+ i: Integer;
+ c: TsColorValue;
+begin
+ // Get color rgb value
+ c := GetPaletteColor(AColorIndex);
+ // Find color value in default palette
+ for i:=0 to High(DEFAULT_PALETTE) do
+ if DEFAULT_PALETTE[i] = c then begin
+ // if found: get the color name from the default color names array
+ Result := DEFAULT_COLORNAMES[i];
+ exit;
+ end;
+
+ // if not found: construct a string from rgb byte values.
+ Result := FPSColorToHexString(AColorIndex, colBlack);
+end;
{@@
Reads the rgb color for the given index from the current palette. Can be
type-cast to TColor for usage in GUI applications.
}
-function TsWorkbook.GetPaletteColor(AColorIndex: TsColor): DWord;
+function TsWorkbook.GetPaletteColor(AColorIndex: TsColor): TsColorValue;
begin
if (AColorIndex >= 0) and (AColorIndex < GetPaletteSize) then begin
if ((FPalette = nil) or (Length(FPalette) = 0)) then
- Result := LongRGBToExcelPhysical(DEFAULT_PALETTE[AColorIndex])
+ Result := DEFAULT_PALETTE[AColorIndex]
else
Result := FPalette[AColorIndex];
end else
@@ -2105,7 +2136,20 @@ begin
end;
{@@
- Returns the size of color palette
+ Replaces a color value of the current palette by a new value. The color must
+ be given as ABGR (little-endian), with A=0}
+procedure TsWorkbook.SetPaletteColor(AColorIndex: TsColor; AColorValue: TsColorValue);
+begin
+ if (AColorIndex >= 0) and (AColorIndex < GetPaletteSize) then begin
+ if ((FPalette = nil) or (Length(FPalette) = 0)) then
+ DEFAULT_PALETTE[AColorIndex] := AColorValue
+ else
+ FPalette[AColorIndex] := AColorValue;
+ end;
+end;
+
+{@@
+ Returns the count of palette colors
}
function TsWorkbook.GetPaletteSize: Integer;
begin
@@ -2121,7 +2165,7 @@ end;
file is used.
}
procedure TsWorkbook.UsePalette(APalette: PsPalette; APaletteCount: Word;
- AFlipBytes: Boolean);
+ ABigEndian: Boolean);
var
i: Integer;
begin
@@ -2129,7 +2173,7 @@ begin
{$DEFINE RNGCHECK}
{$ENDIF}
SetLength(FPalette, APaletteCount);
- if AFlipBytes then
+ if ABigEndian then
for i:=0 to APaletteCount-1 do
{$IFDEF RNGCHECK}
{$R-}
@@ -2704,8 +2748,10 @@ begin
end;
-finalization
+initialization
+ MakeLEPalette(@DEFAULT_PALETTE, Length(DEFAULT_PALETTE));
+finalization
SetLength(GsSpreadFormats, 0);
end.
diff --git a/components/fpspreadsheet/tests/colortests.pas b/components/fpspreadsheet/tests/colortests.pas
index ff5a79650..d225058f2 100644
--- a/components/fpspreadsheet/tests/colortests.pas
+++ b/components/fpspreadsheet/tests/colortests.pas
@@ -11,7 +11,7 @@ uses
// Not using Lazarus package as the user may be working with multiple versions
// Instead, add .. to unit search path
Classes, SysUtils, fpcunit, testregistry,
- fpspreadsheet, xlsbiff5, xlsbiff8 {and a project requirement for lclbase for utf8 handling},
+ fpspreadsheet, xlsbiff2, xlsbiff5, xlsbiff8 {and a project requirement for lclbase for utf8 handling},
testsutility;
type
@@ -23,18 +23,25 @@ type
// Set up expected values:
procedure SetUp; override;
procedure TearDown; override;
- procedure TestWriteReadBackgroundColors(WhichPalette: Integer);
- procedure TestWriteReadFontColors(WhichPalette: Integer);
+ procedure TestWriteReadBackgroundColors(AFormat: TsSpreadsheetFormat; WhichPalette: Integer);
+ procedure TestWriteReadFontColors(AFormat: TsSpreadsheetFormat; WhichPalette: Integer);
published
// Writes out colors & reads back.
+
+ { BIFF2 file format tests }
+ procedure TestWriteReadBIFF2_Font_InternalPal; // internal palette for BIFF2 file format
+
+ { BIFF8 file format tests }
// Background colors...
- procedure TestWriteRead_Background_Internal; // internal palette
- procedure TestWriteRead_Background_Biff5; // official biff5 palette
- procedure TestWriteRead_Background_Biff8; // official biff8 palette
+ procedure TestWriteReadBIFF8_Background_InternalPal; // internal palette
+ procedure TestWriteReadBIFF8_Background_Biff5Pal; // official biff5 palette
+ procedure TestWriteReadBIFF8_Background_Biff8Pal; // official biff8 palette
+ procedure TestWriteReadBIFF8_Background_RandomPal; // palette 64, top 56 entries random
// Font colors...
- procedure TestWriteRead_Font_Internal; // internal palette
- procedure TestWriteRead_Font_Biff5; // official biff5 palette
- procedure TestWriteRead_Font_Biff8; // official biff8 palette
+ procedure TestWriteReadBIFF8_Font_InternalPal; // internal palette for BIFF8 file format
+ procedure TestWriteReadBIFF8_Font_Biff5Pal; // official biff5 palette in BIFF8 file format
+ procedure TestWriteReadBIFF8_Font_Biff8Pal; // official biff8 palette in BIFF8 file format
+ procedure TestWriteReadBIFF8_Font_RandomPal; // palette 64, top 56 entries random
end;
implementation
@@ -54,7 +61,8 @@ begin
inherited TearDown;
end;
-procedure TSpreadWriteReadColorTests.TestWriteReadBackgroundColors(WhichPalette: Integer);
+procedure TSpreadWriteReadColorTests.TestWriteReadBackgroundColors(AFormat: TsSpreadsheetFormat;
+ WhichPalette: Integer);
// WhichPalette = 5: BIFF5 palette
// 8: BIFF8 palette
// else internal palette
@@ -70,6 +78,8 @@ var
color: TsColor;
expectedRGB: DWord;
currentRGB: DWord;
+ pal: Array of TsColorValue;
+ i: Integer;
begin
TempFile:=GetTempFileName;
{// Not needed: use workbook.writetofile with overwrite=true
@@ -81,8 +91,14 @@ begin
// Define palette
case whichPalette of
- 5: MyWorkbook.UsePalette(@PALETTE_BIFF5, High(PALETTE_BIFF5)+1, true);
- 8: MyWorkbook.UsePalette(@PALETTE_BIFF8, High(PALETTE_BIFF8)+1, true);
+ 5: MyWorkbook.UsePalette(@PALETTE_BIFF5, Length(PALETTE_BIFF5));
+ 8: MyWorkbook.UsePalette(@PALETTE_BIFF8, Length(PALETTE_BIFF8));
+ 999: begin // Random palette
+ SetLength(pal, 64);
+ for i:=0 to 7 do pal[i] := PALETTE_BIFF8[i];
+ for i:=8 to 63 do pal[i] := Random(256) + Random(256) shr 8 + random(256) shr 16;
+ MyWorkbook.UsePalette(@pal[0], 64);
+ end;
// else use default palette
end;
@@ -101,13 +117,16 @@ begin
'Test unsaved background color, cell ' + CellNotation(MyWorksheet,0,0));
inc(row);
end;
- MyWorkBook.WriteToFile(TempFile,sfExcel8,true);
+ MyWorkBook.WriteToFile(TempFile, AFormat, true);
MyWorkbook.Free;
- // Open the spreadsheet, as biff8
+ // Open the spreadsheet
MyWorkbook := TsWorkbook.Create;
- MyWorkbook.ReadFromFile(TempFile, sfExcel8);
- MyWorksheet := GetWorksheetByName(MyWorkBook, ColorsSheet);
+ MyWorkbook.ReadFromFile(TempFile, AFormat);
+ if AFormat = sfExcel2 then
+ MyWorksheet := MyWorkbook.GetFirstWorksheet
+ else
+ MyWorksheet := GetWorksheetByName(MyWorkBook, ColorsSheet);
if MyWorksheet=nil then
fail('Error in test code. Failed to get named worksheet');
for row := 0 to MyWorksheet.GetLastRowNumber do begin
@@ -125,7 +144,8 @@ begin
DeleteFile(TempFile);
end;
-procedure TSpreadWriteReadColorTests.TestWriteReadFontColors(WhichPalette: Integer);
+procedure TSpreadWriteReadColorTests.TestWriteReadFontColors(AFormat: TsSpreadsheetFormat;
+ WhichPalette: Integer);
// WhichPalette = 5: BIFF5 palette
// 8: BIFF8 palette
// else internal palette
@@ -140,6 +160,8 @@ var
TempFile: string; //write xls/xml to this file and read back from it
color, colorInFile: TsColor;
expectedRGB, currentRGB: DWord;
+ pal: Array of TsColorValue;
+ i: Integer;
begin
TempFile:=GetTempFileName;
{// Not needed: use workbook.writetofile with overwrite=true
@@ -151,9 +173,15 @@ begin
// Define palette
case whichPalette of
- 5: MyWorkbook.UsePalette(@PALETTE_BIFF5, High(PALETTE_BIFF5)+1, true);
- 8: MyWorkbook.UsePalette(@PALETTE_BIFF8, High(PALETTE_BIFF8)+1, true);
- // else use default palette
+ 5: MyWorkbook.UsePalette(@PALETTE_BIFF5, High(PALETTE_BIFF5)+1, true);
+ 8: MyWorkbook.UsePalette(@PALETTE_BIFF8, High(PALETTE_BIFF8)+1, true);
+ 999: begin
+ SetLength(pal, 64);
+ for i:=0 to 7 do pal[i] := PALETTE_BIFF8[i];
+ for i:=8 to 63 do pal[i] := Random(256) + Random(256) shr 8 + random(256) shr 16;
+ MyWorkbook.UsePalette(@pal[0], 64);
+ end;
+ // else use default palette
end;
// Write out all colors
@@ -172,13 +200,16 @@ begin
'Test unsaved font color, cell ' + CellNotation(MyWorksheet,0,0));
inc(row);
end;
- MyWorkBook.WriteToFile(TempFile,sfExcel8,true);
+ MyWorkBook.WriteToFile(TempFile, AFormat, true);
MyWorkbook.Free;
// Open the spreadsheet, as biff8
MyWorkbook := TsWorkbook.Create;
- MyWorkbook.ReadFromFile(TempFile, sfExcel8);
- MyWorksheet := GetWorksheetByName(MyWorkBook, ColorsSheet);
+ MyWorkbook.ReadFromFile(TempFile, AFormat);
+ if AFormat = sfExcel2 then
+ MyWorksheet := MyWorkbook.GetFirstWorksheet
+ else
+ MyWorksheet := GetWorksheetByName(MyWorkBook, ColorsSheet);
if MyWorksheet=nil then
fail('Error in test code. Failed to get named worksheet');
for row := 0 to MyWorksheet.GetLastRowNumber do begin
@@ -197,34 +228,53 @@ begin
DeleteFile(TempFile);
end;
-procedure TSpreadWriteReadColorTests.TestWriteRead_Background_Internal;
+{ Tests for BIFF2 file format }
+{ BIFF2 supports only a fixed palette, and no background color --> test only
+ internal palette for font color }
+procedure TSpreadWriteReadColorTests.TestWriteReadBIFF2_Font_InternalPal;
begin
- TestWriteReadBackgroundColors(0);
+ TestWriteReadFontColors(sfExcel2, 0);
end;
-procedure TSpreadWriteReadColorTests.TestWriteRead_Background_Biff5;
+{ Tests for BIFF8 file format }
+procedure TSpreadWriteReadColorTests.TestWriteReadBIFF8_Background_InternalPal;
begin
- TestWriteReadBackgroundColors(5);
+ TestWriteReadBackgroundColors(sfExcel8, 0);
end;
-procedure TSpreadWriteReadColorTests.TestWriteRead_Background_Biff8;
+procedure TSpreadWriteReadColorTests.TestWriteReadBIFF8_Background_Biff5Pal;
begin
- TestWriteReadBackgroundColors(8);
+ TestWriteReadBackgroundColors(sfExcel8, 5);
end;
-procedure TSpreadWriteReadColorTests.TestWriteRead_Font_Internal;
+procedure TSpreadWriteReadColorTests.TestWriteReadBIFF8_Background_Biff8Pal;
begin
- TestWriteReadFontColors(0);
+ TestWriteReadBackgroundColors(sfExcel8, 8);
end;
-procedure TSpreadWriteReadColorTests.TestWriteRead_Font_Biff5;
+procedure TSpreadWriteReadColorTests.TestWriteReadBIFF8_Background_RandomPal;
begin
- TestWriteReadFontColors(5);
+ TestWriteReadBackgroundColors(sfExcel8, 999);
end;
-procedure TSpreadWriteReadColorTests.TestWriteRead_Font_Biff8;
+procedure TSpreadWriteReadColorTests.TestWriteReadBIFF8_Font_InternalPal;
begin
- TestWriteReadFontColors(8);
+ TestWriteReadFontColors(sfExcel8, 0);
+end;
+
+procedure TSpreadWriteReadColorTests.TestWriteReadBIFF8_Font_Biff5Pal;
+begin
+ TestWriteReadFontColors(sfExcel8, 5);
+end;
+
+procedure TSpreadWriteReadColorTests.TestWriteReadBIFF8_Font_Biff8Pal;
+begin
+ TestWriteReadFontColors(sfExcel8, 8);
+end;
+
+procedure TSpreadWriteReadColorTests.TestWriteReadBIFF8_Font_RandomPal;
+begin
+ TestWriteReadFontColors(sfExcel8, 999);
end;
initialization
diff --git a/components/fpspreadsheet/tests/manualtests.pas b/components/fpspreadsheet/tests/manualtests.pas
index 41c54abac..d79adec15 100644
--- a/components/fpspreadsheet/tests/manualtests.pas
+++ b/components/fpspreadsheet/tests/manualtests.pas
@@ -25,6 +25,7 @@ uses
xlsbiff8 {and a project requirement for lclbase for utf8 handling},
testsutility;
+{
var
// Norm to test against - list of dates/times that should occur in spreadsheet
SollColors: array[0..16] of tsColor; //"Soll" is a German word in Dutch accountancy jargon meaning "normative value to check against". There ;)
@@ -32,6 +33,7 @@ var
// Initializes Soll*/normative variables.
// Useful in test setup procedures to make sure the norm is correct.
procedure InitSollColors;
+ }
type
{ TSpreadManualSetup }
@@ -75,7 +77,7 @@ const
var
Workbook: TsWorkbook = nil;
-
+ (*
// Initialize array with variables that represent the values
// we expect to be in the test spreadsheet files.
//
@@ -139,6 +141,7 @@ begin
SollColorNames[22]:='scWheat';
}
end;
+ *)
{ TSpreadManualSetup }
@@ -158,7 +161,7 @@ end;
{ TSpreadManualTests }
procedure TSpreadManualTests.SetUp;
begin
- InitSollColors;
+// InitSollColors;
end;
procedure TSpreadManualTests.TearDown;
@@ -190,14 +193,13 @@ begin
Worksheet := Workbook.AddWorksheet(COLORSHEETNAME);
WorkSheet.WriteUTF8Text(0,1,'TSpreadManualTests.TestBiff8CellBackgroundColor');
RowOffset:=1;
- for i:=Low(SollColors) to High(SollColors) do
- begin
+ for i:=0 to Workbook.GetPaletteSize-1 do begin
WorkSheet.WriteUTF8Text(i+RowOffset,0,'BACKGROUND COLOR TEST');
Cell := Worksheet.GetCell(i+RowOffset, 0);
- Cell^.BackgroundColor := SollColors[i];
+ Cell^.BackgroundColor := TsColor(i);
if not (uffBackgroundColor in Cell^.UsedFormattingFields) then
include (Cell^.UsedFormattingFields,uffBackgroundColor);
- WorkSheet.WriteUTF8Text(i+RowOffset,1,'Cell to the left should be tsColor value '+SollColorNames[i]+'. Please check.');
+ WorkSheet.WriteUTF8Text(i+RowOffset,1,'Cell to the left should be '+Workbook.GetColorName(i)+'. Please check.');
end;
end;
@@ -211,7 +213,7 @@ initialization
// Register one time setup/teardown and associated test class to actually run the tests
RegisterTestDecorator(TSpreadManualSetup,TSpreadManualTests);
// Initialize the norm variables in case other units want to use it:
- InitSollColors;
+// InitSollColors;
end.
diff --git a/components/fpspreadsheet/xlsbiff2.pas b/components/fpspreadsheet/xlsbiff2.pas
index c817d79fb..27b442860 100755
--- a/components/fpspreadsheet/xlsbiff2.pas
+++ b/components/fpspreadsheet/xlsbiff2.pas
@@ -97,8 +97,9 @@ type
procedure WriteToStream(AStream: TStream); override;
end;
-const
- PALETTE_BIFF2: array[$0..$07] of DWord = (
+var
+ // the palette of the default BIFF2 colors as "big-endian color" values
+ PALETTE_BIFF2: array[$0..$07] of TsColorValue = (
$000000, // $00: black
$FFFFFF, // $01: white
$FF0000, // $02: red
@@ -1092,11 +1093,13 @@ end;
* Initialization section
*
* Registers this reader / writer on fpSpreadsheet
+* Converts the palette to litte-endian
*
*******************************************************************}
initialization
RegisterSpreadFormat(TsSpreadBIFF2Reader, TsSpreadBIFF2Writer, sfExcel2);
+ MakeLEPalette(@PALETTE_BIFF2, Length(PALETTE_BIFF2));
end.
diff --git a/components/fpspreadsheet/xlsbiff5.pas b/components/fpspreadsheet/xlsbiff5.pas
index 6169f2e8e..aaf09718f 100755
--- a/components/fpspreadsheet/xlsbiff5.pas
+++ b/components/fpspreadsheet/xlsbiff5.pas
@@ -139,8 +139,9 @@ type
procedure WriteToStream(AStream: TStream); override;
end;
-const
- PALETTE_BIFF5: array[$00..$3F] of DWord = (
+var
+ // the palette of the default BIFF5 colors as "big-endian color" values
+ PALETTE_BIFF5: array[$00..$3F] of TsColorValue = (
$000000, // $00: black
$FFFFFF, // $01: white
$FF0000, // $02: red
@@ -1506,6 +1507,9 @@ begin
Inc(FCurrentWorksheet);
end;
+ if not FPaletteFound then
+ FWorkbook.UsePalette(@PALETTE_BIFF5, Length(PALETTE_BIFF5));
+
{ Finalizations }
FWorksheetNames.Free;
@@ -1575,6 +1579,7 @@ end;
initialization
RegisterSpreadFormat(TsSpreadBIFF5Reader, TsSpreadBIFF5Writer, sfExcel5);
+ MakeLEPalette(@PALETTE_BIFF5, Length(PALETTE_BIFF5));
end.
diff --git a/components/fpspreadsheet/xlsbiff8.pas b/components/fpspreadsheet/xlsbiff8.pas
index be4cb5566..6bd4c68f4 100755
--- a/components/fpspreadsheet/xlsbiff8.pas
+++ b/components/fpspreadsheet/xlsbiff8.pas
@@ -198,8 +198,9 @@ type
procedure WriteToStream(AStream: TStream); override;
end;
-const
- PALETTE_BIFF8: array[$00..$3F] of DWord = (
+var
+ // the palette of the default BIFF8 colors as "big-endian color" values
+ PALETTE_BIFF8: array[$00..$3F] of TsColorValue = (
$000000, // $00: black // 8 built-in default colors
$FFFFFF, // $01: white
$FF0000, // $02: red
@@ -940,7 +941,8 @@ begin
AStream.WriteWord(WordToLE(optn));
{ Colour index }
- AStream.WriteWord(WordToLE(8 + ord(AFont.Color))); //WordToLE($7FFF));
+ //AStream.WriteWord(WordToLE(8 + ord(AFont.Color))); //WordToLE($7FFF));
+ AStream.WriteWord(WordToLE(ord(AFont.Color)));
{ Font weight }
if fssBold in AFont.Style then
@@ -2216,9 +2218,13 @@ begin
Inc(FCurrentWorksheet);
end;
+ if not FPaletteFound then
+ FWorkbook.UsePalette(@PALETTE_BIFF8, Length(PALETTE_BIFF8));
+
{ Finalizations }
FWorksheetNames.Free;
+
end;
procedure TsSpreadBIFF8Reader.ReadBlank(AStream: TStream);
@@ -2565,7 +2571,8 @@ begin
{ Colour index }
lColor := WordLEToN(AStream.ReadWord);
- font.Color := TsColor(lColor - 8); // Palette colors have an offset 8
+ //font.Color := TsColor(lColor - 8); // Palette colors have an offset 8
+ font.Color := tsColor(lColor);
{ Font weight }
lWeight := WordLEToN(AStream.ReadWord);
@@ -2620,12 +2627,14 @@ end;
* Initialization section
*
* Registers this reader / writer on fpSpreadsheet
+* Converts the palette to litte-endian
*
*******************************************************************}
initialization
RegisterSpreadFormat(TsSpreadBIFF8Reader, TsSpreadBIFF8Writer, sfExcel8);
+ MakeLEPalette(@PALETTE_BIFF8, Length(PALETTE_BIFF8));
end.
diff --git a/components/fpspreadsheet/xlscommon.pas b/components/fpspreadsheet/xlscommon.pas
index a40f3ab56..cba8fa161 100644
--- a/components/fpspreadsheet/xlscommon.pas
+++ b/components/fpspreadsheet/xlscommon.pas
@@ -285,6 +285,7 @@ type
protected
FCodepage: string; // in a format prepared for lconvencoding.ConvertEncoding
FDateMode: TDateMode;
+ FPaletteFound: Boolean;
// converts an Excel color index to a color value.
// function ExcelPaletteToFPSColor(AIndex: Word): TsColor;
// Here we can add reading of records which didn't change across BIFF2-8 versions
@@ -501,7 +502,7 @@ end;
procedure TsSpreadBIFFReader.ReadPalette(AStream: TStream);
var
i, n: Word;
- pal: Array of DWord;
+ pal: Array of TsColorValue;
begin
n := WordLEToN(AStream.ReadWord) + 8;
SetLength(pal, n);
@@ -510,6 +511,7 @@ begin
for i:=8 to n-1 do
pal[i] := DWordLEToN(AStream.ReadDWord);
Workbook.UsePalette(@pal[0], n, false);
+ FPaletteFound := true;
end;
// Read the part of the ROW record that is common to all BIFF versions