pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

fpspreadsheet: Some refinements with color handling:

Browse Source 
- Add some more colors to the default palette, remove the duplicate base colors
- Introduce type TsColorvalue for the rgb color values
- At init, automatically convert big-endian color values to little-endian
- Add TsWorkbook.SetColorValue to replace a palette color
- Add testing of random palette to colortests
- Add color test for BIFF2 (font only, because background color cannot be changed by design)

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@2962 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-04-24 21:27:57 +00:00
parent 4d5521d38c
commit c174566e55
9 changed files with 358 additions and 239 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
components/fpspreadsheet/examples/excel8demo/excel8write.lpr
View File

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

178
components/fpspreadsheet/examples/fpsgrid/fpsgrid.lpi
View File

@ -116,8 +116,8 @@
<EditorIndex Value="0"/>
<WindowIndex Value="0"/>
<TopLine Value="1"/>
<CursorPos X="1" Y="11"/>
<UsageCount Value="119"/>
<CursorPos X="3" Y="2"/>
<UsageCount Value="120"/>
<Loaded Value="True"/>
</Unit0>
<Unit1>
@ -131,7 +131,7 @@
<WindowIndex Value="0"/>
<TopLine Value="47"/>
<CursorPos X="51" Y="49"/>
<UsageCount Value="119"/>
<UsageCount Value="120"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
</Unit1>
@ -140,22 +140,23 @@
<UnitName Value="fpspreadsheet"/>
<EditorIndex Value="5"/>
<WindowIndex Value="0"/>
<TopLine Value="1916"/>
<CursorPos X="1" Y="1940"/>
<UsageCount Value="58"/>
<TopLine Value="2720"/>
<CursorPos X="49" Y="2742"/>
<UsageCount Value="59"/>
<Bookmarks Count="1">
<Item0 X="1" Y="1292" ID="1"/>
<Item0 X="1" Y="1293" ID="1"/>
</Bookmarks>
<Loaded Value="True"/>
</Unit2>
<Unit3>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<UnitName Value="fpspreadsheetgrid"/>
<IsVisibleTab Value="True"/>
<EditorIndex Value="4"/>
<WindowIndex Value="0"/>
<TopLine Value="12"/>
<CursorPos X="15" Y="33"/>
<UsageCount Value="59"/>
<TopLine Value="257"/>
<CursorPos X="36" Y="273"/>
<UsageCount Value="60"/>
<Loaded Value="True"/>
</Unit3>
<Unit4>
@ -220,7 +221,7 @@
<WindowIndex Value="0"/>
<TopLine Value="1"/>
<CursorPos X="1" Y="1"/>
<UsageCount Value="14"/>
<UsageCount Value="15"/>
<Loaded Value="True"/>
</Unit11>
<Unit12>
@ -238,7 +239,7 @@
<WindowIndex Value="0"/>
<TopLine Value="35"/>
<CursorPos X="1" Y="62"/>
<UsageCount Value="34"/>
<UsageCount Value="35"/>
<Loaded Value="True"/>
</Unit13>
<Unit14>
@ -255,7 +256,7 @@
<WindowIndex Value="0"/>
<TopLine Value="34"/>
<CursorPos X="1" Y="64"/>
<UsageCount Value="26"/>
<UsageCount Value="27"/>
<Loaded Value="True"/>
</Unit15>
<Unit16>
@ -264,7 +265,7 @@
<WindowIndex Value="0"/>
<TopLine Value="248"/>
<CursorPos X="22" Y="263"/>
<UsageCount Value="18"/>
<UsageCount Value="19"/>
<Loaded Value="True"/>
</Unit16>
<Unit17>
@ -272,9 +273,9 @@
<UnitName Value="xlsbiff8"/>
<EditorIndex Value="10"/>
<WindowIndex Value="0"/>
<TopLine Value="2065"/>
<CursorPos X="1" Y="2100"/>
<UsageCount Value="33"/>
<TopLine Value="185"/>
<CursorPos X="1" Y="203"/>
<UsageCount Value="34"/>
<Loaded Value="True"/>
</Unit17>
<Unit18>
@ -297,28 +298,29 @@
<UnitName Value="xlscommon"/>
<EditorIndex Value="9"/>
<WindowIndex Value="0"/>
<TopLine Value="494"/>
<CursorPos X="1" Y="501"/>
<UsageCount Value="29"/>
<TopLine Value="493"/>
<CursorPos X="16" Y="514"/>
<UsageCount Value="30"/>
<Loaded Value="True"/>
</Unit20>
<Unit21>
<Filename Value="..\..\xlsbiff5.pas"/>
<UnitName Value="xlsbiff5"/>
<EditorIndex Value="11"/>
<WindowIndex Value="0"/>
<TopLine Value="1113"/>
<CursorPos X="1" Y="1134"/>
<UsageCount Value="16"/>
<TopLine Value="124"/>
<CursorPos X="38" Y="143"/>
<UsageCount Value="17"/>
<Loaded Value="True"/>
</Unit21>
<Unit22>
<Filename Value="..\..\xlsbiff2.pas"/>
<UnitName Value="xlsbiff2"/>
<IsVisibleTab Value="True"/>
<EditorIndex Value="11"/>
<EditorIndex Value="12"/>
<WindowIndex Value="0"/>
<TopLine Value="944"/>
<CursorPos X="37" Y="959"/>
<UsageCount Value="17"/>
<TopLine Value="82"/>
<CursorPos X="38" Y="101"/>
<UsageCount Value="18"/>
<Loaded Value="True"/>
</Unit22>
<Unit23>
@ -351,130 +353,130 @@
<WindowIndex Value="0"/>
<TopLine Value="141"/>
<CursorPos X="3" Y="143"/>
<UsageCount Value="16"/>
<UsageCount Value="17"/>
<Loaded Value="True"/>
</Unit26>
</Units>
<JumpHistory Count="30" HistoryIndex="29">
<Position1>
<Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="965" Column="1" TopLine="957"/>
<Filename Value="..\..\xlsbiff8.pas"/>
<Caret Line="2500" Column="1" TopLine="2472"/>
</Position1>
<Position2>
<Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="964" Column="48" TopLine="957"/>
<Filename Value="..\..\xlsbiff8.pas"/>
<Caret Line="2504" Column="1" TopLine="2473"/>
</Position2>
<Position3>
<Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="972" Column="32" TopLine="957"/>
<Filename Value="..\..\xlsbiff8.pas"/>
<Caret Line="2505" Column="1" TopLine="2474"/>
</Position3>
<Position4>
<Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="968" Column="1" TopLine="957"/>
<Filename Value="..\..\xlsbiff8.pas"/>
<Caret Line="2508" Column="5" TopLine="2477"/>
</Position4>
<Position5>
<Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="971" Column="1" TopLine="957"/>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="263" Column="21" TopLine="244"/>
</Position5>
<Position6>
<Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="974" Column="1" TopLine="957"/>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="265" Column="1" TopLine="220"/>
</Position6>
<Position7>
<Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="792" Column="1" TopLine="771"/>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="271" Column="1" TopLine="252"/>
</Position7>
<Position8>
<Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="794" Column="1" TopLine="771"/>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="272" Column="1" TopLine="252"/>
</Position8>
<Position9>
<Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="796" Column="1" TopLine="774"/>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="273" Column="1" TopLine="252"/>
</Position9>
<Position10>
<Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="797" Column="26" TopLine="783"/>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="274" Column="1" TopLine="252"/>
</Position10>
<Position11>
<Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="806" Column="1" TopLine="783"/>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="265" Column="1" TopLine="246"/>
</Position11>
<Position12>
<Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="814" Column="1" TopLine="783"/>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="271" Column="1" TopLine="246"/>
</Position12>
<Position13>
<Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="968" Column="1" TopLine="947"/>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="272" Column="1" TopLine="246"/>
</Position13>
<Position14>
<Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="965" Column="1" TopLine="947"/>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="273" Column="1" TopLine="246"/>
</Position14>
<Position15>
<Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="1008" Column="1" TopLine="987"/>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="274" Column="1" TopLine="246"/>
</Position15>
<Position16>
<Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="1009" Column="1" TopLine="987"/>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="265" Column="1" TopLine="246"/>
</Position16>
<Position17>
<Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="1010" Column="1" TopLine="987"/>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="271" Column="1" TopLine="246"/>
</Position17>
<Position18>
<Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="1011" Column="1" TopLine="987"/>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="272" Column="1" TopLine="246"/>
</Position18>
<Position19>
<Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="1012" Column="1" TopLine="987"/>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="273" Column="1" TopLine="246"/>
</Position19>
<Position20>
<Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="1013" Column="1" TopLine="987"/>
<Filename Value="..\..\xlsbiff8.pas"/>
<Caret Line="2482" Column="52" TopLine="2482"/>
</Position20>
<Position21>
<Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="1014" Column="1" TopLine="987"/>
<Filename Value="..\..\xlsbiff8.pas"/>
<Caret Line="1" Column="1" TopLine="1"/>
</Position21>
<Position22>
<Filename Value="..\..\xlsbiff8.pas"/>
<Caret Line="104" Column="15" TopLine="86"/>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="273" Column="35" TopLine="212"/>
</Position22>
<Position23>
<Filename Value="..\..\xlsbiff8.pas"/>
<Caret Line="1712" Column="38" TopLine="1676"/>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="189" Column="35" TopLine="189"/>
</Position23>
<Position24>
<Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="1005" Column="16" TopLine="996"/>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="1" Column="1" TopLine="1"/>
</Position24>
<Position25>
<Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="817" Column="3" TopLine="811"/>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="421" Column="17" TopLine="391"/>
</Position25>
<Position26>
<Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="815" Column="18" TopLine="794"/>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="2154" Column="6" TopLine="2154"/>
</Position26>
<Position27>
<Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="139" Column="10" TopLine="102"/>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="1" Column="1" TopLine="1"/>
</Position27>
<Position28>
<Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="824" Column="31" TopLine="803"/>
<Filename Value="..\..\xlsbiff5.pas"/>
<Caret Line="1581" Column="39" TopLine="1543"/>
</Position28>
<Position29>
<Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="1088" Column="17" TopLine="1055"/>
<Caret Line="1076" Column="29" TopLine="1066"/>
</Position29>
<Position30>
<Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="1082" Column="16" TopLine="1061"/>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="618" Column="27" TopLine="580"/>
</Position30>
</JumpHistory>
</ProjectOptions>

244
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -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.

120
components/fpspreadsheet/tests/colortests.pas
View File

@ -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

16
components/fpspreadsheet/tests/manualtests.pas
View File

@ -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.

7
components/fpspreadsheet/xlsbiff2.pas
View File

@ -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.

9
components/fpspreadsheet/xlsbiff5.pas
View File

@ -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.

17
components/fpspreadsheet/xlsbiff8.pas
View File

@ -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.

4
components/fpspreadsheet/xlscommon.pas
View File

@ -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