diff --git a/components/fpspreadsheet/examples/excel8demo/excel8write.lpi b/components/fpspreadsheet/examples/excel8demo/excel8write.lpi
index 7584cc24f..7689329c4 100644
--- a/components/fpspreadsheet/examples/excel8demo/excel8write.lpi
+++ b/components/fpspreadsheet/examples/excel8demo/excel8write.lpi
@@ -55,6 +55,11 @@
+
+
+
+
+
diff --git a/components/fpspreadsheet/examples/excel8demo/excel8write.lpr b/components/fpspreadsheet/examples/excel8demo/excel8write.lpr
index 65ccfee30..6751c9856 100644
--- a/components/fpspreadsheet/examples/excel8demo/excel8write.lpr
+++ b/components/fpspreadsheet/examples/excel8demo/excel8write.lpr
@@ -37,6 +37,7 @@ begin
// Create the spreadsheet
MyWorkbook := TsWorkbook.Create;
MyWorkbook.SetDefaultFont('Calibri', 9);
+ MyWorkbook.UsePalette(@PALETTE_BIFF8, 64, true);
MyWorksheet := MyWorkbook.AddWorksheet(Str_Worksheet1);
@@ -54,6 +55,9 @@ begin
lCell^.BackgroundColor := scPurple;
lCell^.UsedFormattingFields := [uffBackgroundColor];
// or: MyWorksheet.WriteBackgroundColor(5, 3, scPurple);
+ MyWorksheet.WriteFontColor(5, 3, scWhite);
+ MyWorksheet.WriteFontSize(5, 3, 12);
+ // or: MyWorksheet.WriteFont(5, 3, 'Arial', 12, [], scWhite);
// E6 empty cell, only background color
MyWorksheet.WriteBackgroundColor(5, 4, scYellow);
@@ -62,7 +66,8 @@ begin
MyWorksheet.WriteBorders(5, 5, [cbNorth, cbEast, cbSouth, cbWest]);
// Word-wrapped long text in D7
- MyWorksheet.WriteUTF8Text(6, 3, 'This is a very, very, very, very long text.');
+ MyWorksheet.WriteUTF8Text(6, 3, 'This is a very, very, very, very long wrapped text.');
+ MyWorksheet.WriteUsedFormatting(6, 3, [uffWordwrap]);
// Cell with changed font in D8
MyWorksheet.WriteUTF8Text(7, 3, 'This is 16pt red bold & italic Times New Roman.');
@@ -71,7 +76,7 @@ begin
// Cell with changed font and background in D9
MyWorksheet.WriteUTF8Text(8, 3, 'Colors...');
MyWorksheet.WriteFont(8, 3, 'Courier New', 12, [fssUnderline], scBlue);
- // MyWorksheet.WriteBackgroundColor(8, 3, scYellow);
+ MyWorksheet.WriteBackgroundColor(8, 3, scYellow);
{ Uncomment this to test large XLS files
for i := 2 to 20 do
diff --git a/components/fpspreadsheet/examples/fpsgrid/fpsgrid.lpi b/components/fpspreadsheet/examples/fpsgrid/fpsgrid.lpi
index 8a87e8e29..d5019c1ec 100644
--- a/components/fpspreadsheet/examples/fpsgrid/fpsgrid.lpi
+++ b/components/fpspreadsheet/examples/fpsgrid/fpsgrid.lpi
@@ -15,8 +15,79 @@
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
@@ -37,7 +108,7 @@
-
+
@@ -46,7 +117,7 @@
-
+
@@ -58,9 +129,9 @@
-
-
-
+
+
+
@@ -69,19 +140,22 @@
-
-
-
+
+
+
+
+
+
-
+
-
-
-
+
+
+
@@ -90,7 +164,7 @@
-
+
@@ -98,7 +172,7 @@
-
+
@@ -106,7 +180,7 @@
-
+
@@ -114,14 +188,14 @@
-
+
-
+
@@ -129,7 +203,7 @@
-
+
@@ -137,32 +211,34 @@
-
+
+
-
-
-
+
+
+
+
-
-
-
+
+
+
-
+
-
-
-
+
+
+
@@ -170,37 +246,35 @@
-
+
-
+
-
-
-
+
+
+
+
-
-
-
+
+
+
+
-
-
+
-
-
-
-
-
-
+
+
+
@@ -209,40 +283,43 @@
-
+
-
+
-
+
-
-
-
+
+
+
-
+
-
+
+
+
-
-
-
+
+
+
+
@@ -250,129 +327,154 @@
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
+
-
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
@@ -388,6 +490,9 @@
+
+
+
@@ -399,12 +504,15 @@
-
+
-
+
+
+
+
-
+
@@ -414,6 +522,12 @@
+
+
+
+
+
+
diff --git a/components/fpspreadsheet/fpsopendocument.pas b/components/fpspreadsheet/fpsopendocument.pas
index 2faf48e03..d644a1ac4 100755
--- a/components/fpspreadsheet/fpsopendocument.pas
+++ b/components/fpspreadsheet/fpsopendocument.pas
@@ -85,7 +85,7 @@ type
procedure WriteMeta;
procedure WriteSettings;
procedure WriteStyles;
- procedure WriteContent(AData: TsWorkbook);
+ procedure WriteContent;
procedure WriteWorksheet(CurSheet: TsWorksheet);
// Routines to write parts of those files
function WriteStylesXMLAsString: string;
@@ -101,12 +101,12 @@ type
procedure WriteDateTime(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: TDateTime; ACell: PCell); override;
public
- constructor Create; override;
+ constructor Create(AWorkbook: TsWorkbook); override;
{ General writing methods }
procedure WriteStringToFile(AString, AFileName: string);
- procedure WriteToFile(const AFileName: string; AData: TsWorkbook;
+ procedure WriteToFile(const AFileName: string;
const AOverwriteExisting: Boolean = False); override;
- procedure WriteToStream(AStream: TStream; AData: TsWorkbook); override;
+ procedure WriteToStream(AStream: TStream); override;
end;
implementation
@@ -544,14 +544,14 @@ begin
'';
end;
-procedure TsSpreadOpenDocWriter.WriteContent(AData: TsWorkbook);
+procedure TsSpreadOpenDocWriter.WriteContent;
var
i: Integer;
lStylesCode: string;
begin
- ListAllFormattingStyles(AData);
+ ListAllFormattingStyles;
- lStylesCode := WriteStylesXMLAsString();
+ lStylesCode := WriteStylesXMLAsString;
FContent :=
XML_HEADER + LineEnding +
@@ -602,10 +602,8 @@ begin
' ' + LineEnding;
// Write all worksheets
- for i := 0 to AData.GetWorksheetCount - 1 do
- begin
- WriteWorksheet(Adata.GetWorksheetByIndex(i));
- end;
+ for i := 0 to Workbook.GetWorksheetCount - 1 do
+ WriteWorksheet(Workbook.GetWorksheetByIndex(i));
FContent := FContent +
' ' + LineEnding +
@@ -701,7 +699,7 @@ begin
if (uffBackgroundColor in FFormattingStyles[i].UsedFormattingFields) then
begin
Result := Result + 'fo:background-color="#'
- + FPSColorToHexString(FFormattingStyles[i].BackgroundColor, FFormattingStyles[i].RGBBackgroundColor) +'" ';
+ + Workbook.FPSColorToHexString(FFormattingStyles[i].BackgroundColor, FFormattingStyles[i].RGBBackgroundColor) +'" ';
end;
if (uffWordWrap in FFormattingStyles[i].UsedFormattingFields) then
@@ -718,9 +716,9 @@ begin
end;
end;
-constructor TsSpreadOpenDocWriter.Create;
+constructor TsSpreadOpenDocWriter.Create(AWorkbook: TsWorkbook);
begin
- inherited Create;
+ inherited Create(AWorkbook);
FPointSeparatorSettings := SysUtils.DefaultFormatSettings;
FPointSeparatorSettings.DecimalSeparator:='.';
@@ -744,7 +742,7 @@ end;
Writes an OOXML document to the disc.
}
procedure TsSpreadOpenDocWriter.WriteToFile(const AFileName: string;
- AData: TsWorkbook; const AOverwriteExisting: Boolean);
+ const AOverwriteExisting: Boolean);
var
FZip: TZipper;
begin
@@ -755,7 +753,7 @@ begin
WriteMeta();
WriteSettings();
WriteStyles();
- WriteContent(AData);
+ WriteContent;
{ Write the data to streams }
@@ -792,7 +790,7 @@ begin
end;
-procedure TsSpreadOpenDocWriter.WriteToStream(AStream: TStream; AData: TsWorkbook);
+procedure TsSpreadOpenDocWriter.WriteToStream(AStream: TStream);
begin
// Not supported at the moment
raise Exception.Create('TsSpreadOpenDocWriter.WriteToStream not supported');
diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas
index 98b4c2315..90ed043c7 100755
--- a/components/fpspreadsheet/fpspreadsheet.pas
+++ b/components/fpspreadsheet/fpspreadsheet.pas
@@ -179,12 +179,63 @@ type
TsHorAlignment = (haDefault, haLeft, haCenter, haRight);
TsVertAlignment = (vaDefault, vaTop, vaCenter, vaBottom);
+ {@@
+ 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).
+ }
+ TsColor = Word;
+
+{@@
+ These are some constants for color indices into the default palette.
+ Note, however, that if a different palette is used there may be more colors,
+ and the names of the color constants may no longer be correct.
+}
+const
+ scBlack = $00;
+ scWhite = $01;
+ scRed = $02;
+ scGreen = $03;
+ scBlue = $04;
+ 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;
+ 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
+ scBlack, // 000000H
scWhite, // FFFFFFH
scRed, // FF0000H
scGREEN, // 00FF00H
@@ -211,14 +262,18 @@ type
//
scRGBCOLOR // Defined via TFPColor
);
+ *)
+
+type
+ {@@ Palette of color values }
+ TsPalette = array[0..0] of DWord;
+ PsPalette = ^TsPalette;
{@@ Font style (redefined to avoid usage of "Graphics" }
-
TsFontStyle = (fssBold, fssItalic, fssStrikeOut, fssUnderline);
TsFontStyles = set of TsFontStyle;
{@@ Font }
-
TsFont = class
FontName: String;
Size: Single; // in "points"
@@ -269,7 +324,7 @@ type
PRow = ^TRow;
TCol = record
- Col: Byte;
+ Col: Cardinal;
Width: Single; // in "characters". Excel uses the with of char "0" in 1st font
end;
@@ -324,6 +379,8 @@ type
function WriteFont(ARow, ACol: Cardinal; const AFontName: String;
AFontSize: Single; AFontStyle: TsFontStyles; AFontColor: TsColor): Integer; overload;
procedure WriteFont(ARow, ACol: Cardinal; AFontIndex: Integer); overload;
+ function WriteFontColor(ARow, ACol: Cardinal; AFontColor: TsColor): Integer;
+ function WriteFontSize(ARow, ACol: Cardinal; ASize: Integer): Integer;
procedure WriteTextRotation(ARow, ACol: Cardinal; ARotation: TsTextRotation);
procedure WriteUsedFormatting(ARow, ACol: Cardinal; AUsedFormatting: TsUsedFormattingFields);
procedure WriteBackgroundColor(ARow, ACol: Cardinal; AColor: TsColor);
@@ -356,6 +413,7 @@ type
FFormat: TsSpreadsheetFormat;
FFontList: TFPList;
FBuiltinFontCount: Integer;
+ FPalette: array of DWord;
{ Internal methods }
procedure RemoveWorksheetsCallback(data, arg: pointer);
public
@@ -393,6 +451,11 @@ type
procedure InitFonts;
procedure RemoveAllFonts;
procedure SetDefaultFont(const AFontName: String; ASize: Single);
+ { Color handling }
+ function FPSColorToHexString(AColor: TsColor; ARGBColor: TFPColor): String;
+ function GetPaletteColor(AColorIndex: TsColor): DWord;
+ function GetPaletteSize: Integer;
+ procedure UsePalette(APalette: PsPalette; APaletteCount: Word; AFlipBytes: Boolean);
{@@ 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;
@@ -415,12 +478,12 @@ type
procedure ReadLabel(AStream: TStream); virtual; abstract;
procedure ReadNumber(AStream: TStream); virtual; abstract;
public
- constructor Create; virtual; // To allow descendents to override it
+ constructor Create(AWorkbook: TsWorkbook); virtual; // To allow descendents to override it
{ General writing methods }
procedure ReadFromFile(AFileName: string; AData: TsWorkbook); virtual;
procedure ReadFromStream(AStream: TStream; AData: TsWorkbook); virtual;
procedure ReadFromStrings(AStrings: TStrings; AData: TsWorkbook); virtual;
- property Wordbook: TsWorkbook read FWorkbook;
+ property Workbook: TsWorkbook read FWorkbook;
end;
{@@ TsSpreadWriter class reference type }
@@ -433,14 +496,14 @@ type
TsCustomSpreadWriter = class
private
+ FWorkbook: TsWorkbook;
protected
{ Helper routines }
procedure AddDefaultFormats(); virtual;
function ExpandFormula(AFormula: TsFormula): TsExpandedFormula;
function FindFormattingInList(AFormat: PCell): Integer;
- function FPSColorToHexString(AColor: TsColor; ARGBColor: TFPColor): string;
procedure ListAllFormattingStylesCallback(ACell: PCell; AStream: TStream);
- procedure ListAllFormattingStyles(AData: TsWorkbook);
+ procedure ListAllFormattingStyles;
{ Helpers for writing }
procedure WriteCellCallback(ACell: PCell; AStream: TStream);
procedure WriteCellsToStream(AStream: TStream; ACells: TAVLTree);
@@ -458,13 +521,13 @@ type
}
FFormattingStyles: array of TCell;
NextXFIndex: Integer; // Indicates which should be the next XF (Style) Index when filling the styles list
- constructor Create; virtual; // To allow descendents to override it
+ constructor Create(AWorkbook: TsWorkbook); virtual; // To allow descendents to override it
{ General writing methods }
procedure IterateThroughCells(AStream: TStream; ACells: TAVLTree; ACallback: TCellsCallback);
- procedure WriteToFile(const AFileName: string; AData: TsWorkbook;
- const AOverwriteExisting: Boolean = False); virtual;
- procedure WriteToStream(AStream: TStream; AData: TsWorkbook); virtual;
- procedure WriteToStrings(AStrings: TStrings; AData: TsWorkbook); virtual;
+ procedure WriteToFile(const AFileName: string; const AOverwriteExisting: Boolean = False); virtual;
+ procedure WriteToStream(AStream: TStream); virtual;
+ procedure WriteToStrings(AStrings: TStrings); virtual;
+ property Workbook: TsWorkbook read FWorkbook;
end;
{@@ List of registered formats }
@@ -537,7 +600,6 @@ function GetFileFormatName(AFormat: TsSpreadsheetFormat): String;
function SciFloat(AValue: Double; ADecimals: Word): String;
function TimeIntervalToString(AValue: TDateTime): String;
-
implementation
uses
@@ -551,6 +613,38 @@ resourcestring
lpUnknownSpreadsheetFormat = 'unknown format';
lpInvalidFontIndex = 'Invalid font index';
+const
+ {@@
+ Colors in RGB (red at left). Needs to be inverted to get TColor.
+ The indices into this palette are named as scXXXX color constants.
+ }
+ DEFAULT_PALETTE: array[$0..$18] of DWord = (
+ $000000, // $00: black
+ $FFFFFF, // $01: white
+ $FF0000, // $02: red
+ $00FF00, // $03: green
+ $0000FF, // $04: blue
+ $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
+ );
{@@
Registers a new reader/writer pair for a format
@@ -1288,6 +1382,26 @@ begin
raise Exception.Create(lpInvalidFontIndex);
end;
+function TsWorksheet.WriteFontColor(ARow, ACol: Cardinal; AFontColor: TsColor): Integer;
+var
+ lCell: PCell;
+ fnt: TsFont;
+begin
+ lCell := GetCell(ARow, ACol);
+ fnt := Workbook.GetFont(lCell^.FontIndex);
+ Result := WriteFont(ARow, ACol, fnt.FontName, fnt.Size, fnt.Style, AFontColor);
+end;
+
+function TsWorksheet.WriteFontSize(ARow, ACol: Cardinal; ASize: Integer): Integer;
+var
+ lCell: PCell;
+ fnt: TsFont;
+begin
+ lCell := GetCell(ARow, ACol);
+ fnt := Workbook.GetFont(lCell^.FontIndex);
+ Result := WriteFont(ARow, ACol, fnt.FontName, ASize, fnt.Style, fnt.Color);
+end;
+
{@@
Adds text rotation to the formatting of a cell
@@ -1521,8 +1635,7 @@ begin
for i := 0 to Length(GsSpreadFormats) - 1 do
if GsSpreadFormats[i].Format = AFormat then
begin
- Result := GsSpreadFormats[i].ReaderClass.Create;
- Result.FWorkbook := self;
+ Result := GsSpreadFormats[i].ReaderClass.Create(self);
Break;
end;
@@ -1542,7 +1655,7 @@ begin
for i := 0 to Length(GsSpreadFormats) - 1 do
if GsSpreadFormats[i].Format = AFormat then
begin
- Result := GsSpreadFormats[i].WriterClass.Create;
+ Result := GsSpreadFormats[i].WriterClass.Create(self);
Break;
end;
@@ -1657,9 +1770,8 @@ var
AWriter: TsCustomSpreadWriter;
begin
AWriter := CreateSpreadWriter(AFormat);
-
try
- AWriter.WriteToFile(AFileName, Self, AOverwriteExisting);
+ AWriter.WriteToFile(AFileName, AOverwriteExisting);
finally
AWriter.Free;
end;
@@ -1690,7 +1802,7 @@ begin
AWriter := CreateSpreadWriter(AFormat);
try
- AWriter.WriteToStream(AStream, Self);
+ AWriter.WriteToStream(AStream);
finally
AWriter.Free;
end;
@@ -1948,11 +2060,101 @@ begin
Result := FFontList.Count;
end;
+{@@
+ Converts a fpspreadsheet color into into a string RRGGBB.
+ Note that colors are written to xls files as ABGR (where A is 0).
+ if the color is scRGBColor the color value is taken from the argument
+ ARGBColor, otherwise from the palette entry for the color index.
+}
+function TsWorkbook.FPSColorToHexString(AColor: TsColor;
+ ARGBColor: TFPColor): string;
+type
+ TRgba = packed record Red, Green, Blue, A: Byte end;
+var
+ color: DWord;
+ r,g,b: Byte;
+begin
+ if AColor = scRGBColor then begin
+ r := ARGBColor.Red div $100;
+ 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;
+ end;
+ Result := Format('%x%x%x', [r, g, b]);
+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;
+begin
+ if (AColorIndex >= 0) and (AColorIndex < GetPaletteSize) then begin
+ if ((FPalette = nil) or (Length(FPalette) = 0)) then
+ Result := LongRGBToExcelPhysical(DEFAULT_PALETTE[AColorIndex])
+ else
+ Result := FPalette[AColorIndex];
+ end else
+ Result := $000000; // "black" as default
+end;
+
+{@@
+ Returns the size of color palette
+}
+function TsWorkbook.GetPaletteSize: Integer;
+begin
+ if (FPalette = nil) or (Length(FPalette) = 0) then
+ Result := High(DEFAULT_PALETTE) + 1
+ else
+ Result := Length(FPalette);
+end;
+
+{@@
+ Instructs the Workbook to take colors from the palette pointed to by the parameter
+ This palette is only used for writing. When reading the palette found in the
+ file is used.
+}
+procedure TsWorkbook.UsePalette(APalette: PsPalette; APaletteCount: Word;
+ AFlipBytes: Boolean);
+var
+ i: Integer;
+begin
+ {$IFOPT R+}
+ {$DEFINE RNGCHECK}
+ {$ENDIF}
+ SetLength(FPalette, APaletteCount);
+ if AFlipBytes then
+ for i:=0 to APaletteCount-1 do
+ {$IFDEF RNGCHECK}
+ {$R-}
+ {$ENDIF}
+ FPalette[i] := LongRGBToExcelPhysical(APalette^[i])
+ {$IFDEF RNGCHECK}
+ {$R+}
+ {$ENDIF}
+ else
+ for i:=0 to APaletteCount-1 do
+ {$IFDEF RNGCHECK}
+ {$R-}
+ {$ENDIF}
+ FPalette[i] := APalette^[i];
+ {$IFDEF RNGCHECK}
+ {$R+}
+ {$ENDIF}
+end;
+
{ TsCustomSpreadReader }
-constructor TsCustomSpreadReader.Create;
+constructor TsCustomSpreadReader.Create(AWorkbook: TsWorkbook);
begin
inherited Create;
+ FWorkbook := AWorkbook;
end;
{@@
@@ -2006,9 +2208,10 @@ end;
{ TsCustomSpreadWriter }
-constructor TsCustomSpreadWriter.Create;
+constructor TsCustomSpreadWriter.Create(AWorkbook: TsWorkbook);
begin
inherited Create;
+ FWorkbook := AWorkbook;
end;
{@@
@@ -2082,7 +2285,7 @@ begin
Inc(NextXFIndex);
end;
-procedure TsCustomSpreadWriter.ListAllFormattingStyles(AData: TsWorkbook);
+procedure TsCustomSpreadWriter.ListAllFormattingStyles;
var
i: Integer;
begin
@@ -2090,9 +2293,9 @@ begin
AddDefaultFormats();
- for i := 0 to AData.GetWorksheetCount - 1 do
+ for i := 0 to Workbook.GetWorksheetCount - 1 do
begin
- IterateThroughCells(nil, AData.GetWorksheetByIndex(i).Cells, ListAllFormattingStylesCallback);
+ IterateThroughCells(nil, Workbook.GetWorksheetByIndex(i).Cells, ListAllFormattingStylesCallback);
end;
end;
@@ -2139,11 +2342,12 @@ begin
Inc(StrPos);
end;
end;
-
+ (*
function TsCustomSpreadWriter.FPSColorToHexString(AColor: TsColor; ARGBColor: TFPColor): string;
{ We use RGB bytes here, but please note that these are physically written
to XLS file as ABGR (where A is 0) }
begin
+
case AColor of
scBlack: Result := '000000';
scWhite: Result := 'FFFFFF';
@@ -2173,7 +2377,7 @@ begin
scRGBCOLOR: Result := Format('%x%x%x', [ARGBColor.Red div $100, ARGBColor.Green div $100, ARGBColor.Blue div $100]);
end;
end;
-
+ *)
{@@
Helper function for the spreadsheet writers.
@@ -2228,15 +2432,15 @@ end;
Default file writting method.
Opens the file and calls WriteToStream
+ The workbook written is the one specified in the constructor of the writer.
@param AFileName The output file name.
If the file already exists it will be replaced.
- @param AData The Workbook to be saved.
@see TsWorkbook
}
procedure TsCustomSpreadWriter.WriteToFile(const AFileName: string;
- AData: TsWorkbook; const AOverwriteExisting: Boolean = False);
+ const AOverwriteExisting: Boolean = False);
var
OutputFile: TFileStream;
lMode: Word;
@@ -2246,7 +2450,7 @@ begin
OutputFile := TFileStream.Create(AFileName, lMode);
try
- WriteToStream(OutputFile, AData);
+ WriteToStream(OutputFile);
finally
OutputFile.Free;
end;
@@ -2255,21 +2459,20 @@ end;
{@@
This routine should be overriden in descendent classes.
}
-procedure TsCustomSpreadWriter.WriteToStream(AStream: TStream; AData: TsWorkbook);
+procedure TsCustomSpreadWriter.WriteToStream(AStream: TStream);
var
lStringList: TStringList;
begin
lStringList := TStringList.Create;
try
- WriteToStrings(lStringList, AData);
+ WriteToStrings(lStringList);
lStringList.SaveToStream(AStream);
finally
lStringList.Free;
end;
end;
-procedure TsCustomSpreadWriter.WriteToStrings(AStrings: TStrings;
- AData: TsWorkbook);
+procedure TsCustomSpreadWriter.WriteToStrings(AStrings: TStrings);
begin
raise Exception.Create(lpUnsupportedWriteFormat);
end;
diff --git a/components/fpspreadsheet/fpspreadsheetgrid.pas b/components/fpspreadsheet/fpspreadsheetgrid.pas
index 40968a76e..4c679fbbc 100644
--- a/components/fpspreadsheet/fpspreadsheetgrid.pas
+++ b/components/fpspreadsheet/fpspreadsheetgrid.pas
@@ -149,8 +149,6 @@ type
property OnContextPopup;
end;
-function FPSColorToColor(FPSColor: TsColor; ADefault: TColor): TColor;
-
procedure Register;
implementation
@@ -174,37 +172,6 @@ begin
end;
end;
-function FPSColorToColor(FPSColor: TsColor; ADefault: TColor): TColor;
-begin
- case FPSColor of
- scBlack : Result := clBlack;
- scWhite : Result := clWhite;
- scRed : Result := clRed;
- scGreen : Result := clLime;
- scBlue : Result := clBlue;
- scYellow : Result := clYellow;
- scMagenta : Result := clFuchsia;
- scCyan : Result := clAqua;
- scDarkRed : Result := clMaroon;
- scDarkGreen: Result := clGreen;
- scDarkBlue : Result := clNavy;
- scOlive : Result := clOlive;
- scPurple : Result := clPurple;
- scTeal : Result := clTeal;
- scSilver : Result := clSilver;
- scGrey : Result := clGray;
- //
- scGrey10pct: Result := TColor($00E6E6E6);
- scGrey20pct: Result := TColor($00CCCCCC);
- scOrange : Result := TColor($0000A5FF); // FFA500
- scDarkBrown: Result := TColor($002D52A0); // A0522D
- scBrown : Result := TColor($003F85CD); // CD853F
- scBeige : Result := TColor($00DCF5F5); // F5F5DC
- scWheat : Result := TColor($00B3DEF5); // F5DEB3
- else Result := ADefault;
- end;
-end;
-
procedure Register;
begin
RegisterComponents('Additional',[TsWorksheetGrid]);
@@ -302,7 +269,10 @@ begin
Canvas.Brush.Bitmap := FillPattern_BIFF2;
end else begin
Canvas.Brush.Style := bsSolid;
- Canvas.Brush.Color := FPSColorToColor(lCell^.BackgroundColor, Color);
+ if lCell^.BackgroundColor < FWorkbook.GetPaletteSize then
+ Canvas.Brush.Color := FWorkbook.GetPaletteColor(lCell^.BackgroundColor)
+ else
+ Canvas.Brush.Color := Color;
end;
end else begin
Canvas.Brush.Style := bsSolid;
@@ -313,7 +283,7 @@ begin
fnt := FWorkbook.GetFont(lCell^.FontIndex);
if fnt <> nil then begin
Canvas.Font.Name := fnt.FontName;
- Canvas.Font.Color := FPSColorToColor(fnt.Color, clBlack);
+ Canvas.Font.Color := FWorkbook.GetPaletteColor(fnt.Color);
style := [];
if fssBold in fnt.Style then Include(style, fsBold);
if fssItalic in fnt.Style then Include(style, fsItalic);
diff --git a/components/fpspreadsheet/fpsutils.pas b/components/fpspreadsheet/fpsutils.pas
index feb3317a8..7cec8c7ad 100644
--- a/components/fpspreadsheet/fpsutils.pas
+++ b/components/fpspreadsheet/fpsutils.pas
@@ -34,6 +34,8 @@ function WordLEtoN(AValue: Word): Word;
function DWordLEtoN(AValue: Cardinal): Cardinal;
function WideStringLEToN(const AValue: WideString): WideString;
+function LongRGBToExcelPhysical(const RGB: DWord): DWord;
+
// Other routines
function ParseIntervalString(const AStr: string;
var AFirstCellRow, AFirstCellCol, ACount: Integer;
@@ -155,6 +157,24 @@ begin
{$ENDIF}
end;
+{ Converts RGB part of a LongRGB logical structure to its physical representation
+ IOW: RGBA (where A is 0 and omitted in the function call) => ABGR
+ Needed for conversion of palette colors. }
+function LongRGBToExcelPhysical(const RGB: DWord): DWord;
+begin
+ {$IFDEF FPC}
+ {$IFDEF ENDIAN_LITTLE}
+ result := RGB shl 8; //tags $00 at end for the A byte
+ result := SwapEndian(result); //flip byte order
+ {$ELSE}
+ //Big endian
+ result := RGB; //leave value as is //todo: verify if this turns out ok
+ {$ENDIF}
+ {$ELSE}
+ // messed up result
+ {$ENDIF}
+end;
+
{@@
Parses strings like A5:A10 into an selection interval information
}
diff --git a/components/fpspreadsheet/tests/colortests.pas b/components/fpspreadsheet/tests/colortests.pas
new file mode 100644
index 000000000..ff5a79650
--- /dev/null
+++ b/components/fpspreadsheet/tests/colortests.pas
@@ -0,0 +1,234 @@
+unit colortests;
+
+{$mode objfpc}{$H+}
+
+interface
+{ Color tests
+This unit tests writing out to and reading back from files.
+}
+
+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},
+ testsutility;
+
+type
+ { TSpreadWriteReadColorTests }
+ //Write to xls/xml file and read back
+ TSpreadWriteReadColorTests = class(TTestCase)
+ private
+ protected
+ // Set up expected values:
+ procedure SetUp; override;
+ procedure TearDown; override;
+ procedure TestWriteReadBackgroundColors(WhichPalette: Integer);
+ procedure TestWriteReadFontColors(WhichPalette: Integer);
+ published
+ // Writes out colors & reads back.
+ // Background colors...
+ procedure TestWriteRead_Background_Internal; // internal palette
+ procedure TestWriteRead_Background_Biff5; // official biff5 palette
+ procedure TestWriteRead_Background_Biff8; // official biff8 palette
+ // Font colors...
+ procedure TestWriteRead_Font_Internal; // internal palette
+ procedure TestWriteRead_Font_Biff5; // official biff5 palette
+ procedure TestWriteRead_Font_Biff8; // official biff8 palette
+ end;
+
+implementation
+
+const
+ ColorsSheet = 'Colors';
+
+{ TSpreadWriteReadColorTests }
+
+procedure TSpreadWriteReadColorTests.SetUp;
+begin
+ inherited SetUp;
+end;
+
+procedure TSpreadWriteReadColorTests.TearDown;
+begin
+ inherited TearDown;
+end;
+
+procedure TSpreadWriteReadColorTests.TestWriteReadBackgroundColors(WhichPalette: Integer);
+// WhichPalette = 5: BIFF5 palette
+// 8: BIFF8 palette
+// else internal palette
+// see also "manualtests".
+const
+ CELLTEXT = 'Color test';
+var
+ MyWorksheet: TsWorksheet;
+ MyWorkbook: TsWorkbook;
+ row, col: Integer;
+ MyCell: PCell;
+ TempFile: string; //write xls/xml to this file and read back from it
+ color: TsColor;
+ expectedRGB: DWord;
+ currentRGB: DWord;
+begin
+ TempFile:=GetTempFileName;
+ {// Not needed: use workbook.writetofile with overwrite=true
+ if fileexists(TempFile) then
+ DeleteFile(TempFile);
+ }
+ MyWorkbook := TsWorkbook.Create;
+ MyWorkSheet:= MyWorkBook.AddWorksheet(ColorsSheet);
+
+ // 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
+ end;
+
+ // Write out all colors
+ row := 0;
+ col := 0;
+ for color := 0 to MyWorkbook.GetPaletteSize-1 do begin
+ MyWorksheet.WriteUTF8Text(row, col, CELLTEXT);
+ MyWorksheet.WriteBackgroundColor(row, col, color);
+ MyCell := MyWorksheet.FindCell(row, col);
+ if MyCell = nil then
+ fail('Error in test code. Failed to get cell.');
+ currentRGB := MyWorkbook.GetPaletteColor(MyCell^.BackgroundColor);
+ expectedRGB := MyWorkbook.GetPaletteColor(color);
+ CheckEquals(currentRGB, expectedRGB,
+ 'Test unsaved background color, cell ' + CellNotation(MyWorksheet,0,0));
+ inc(row);
+ end;
+ MyWorkBook.WriteToFile(TempFile,sfExcel8,true);
+ MyWorkbook.Free;
+
+ // Open the spreadsheet, as biff8
+ MyWorkbook := TsWorkbook.Create;
+ MyWorkbook.ReadFromFile(TempFile, sfExcel8);
+ 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
+ MyCell := MyWorksheet.FindCell(row, col);
+ if MyCell = nil then
+ fail('Error in test code. Failed to get cell.');
+ color := TsColor(row);
+ currentRGB := MyWorkbook.GetPaletteColor(MyCell^.BackgroundColor);
+ expectedRGB := MyWorkbook.GetPaletteColor(color);
+ CheckEquals(currentRGB, expectedRGB,
+ 'Test saved background color, cell '+CellNotation(MyWorksheet,Row,Col));
+ end;
+ MyWorkbook.Free;
+
+ DeleteFile(TempFile);
+end;
+
+procedure TSpreadWriteReadColorTests.TestWriteReadFontColors(WhichPalette: Integer);
+// WhichPalette = 5: BIFF5 palette
+// 8: BIFF8 palette
+// else internal palette
+// see also "manualtests".
+const
+ CELLTEXT = 'Color test';
+var
+ MyWorksheet: TsWorksheet;
+ MyWorkbook: TsWorkbook;
+ row, col: Integer;
+ MyCell: PCell;
+ TempFile: string; //write xls/xml to this file and read back from it
+ color, colorInFile: TsColor;
+ expectedRGB, currentRGB: DWord;
+begin
+ TempFile:=GetTempFileName;
+ {// Not needed: use workbook.writetofile with overwrite=true
+ if fileexists(TempFile) then
+ DeleteFile(TempFile);
+ }
+ MyWorkbook := TsWorkbook.Create;
+ MyWorkSheet:= MyWorkBook.AddWorksheet(ColorsSheet);
+
+ // 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
+ end;
+
+ // Write out all colors
+ row := 0;
+ col := 0;
+ for color := 0 to MyWorkbook.GetPaletteSize-1 do begin
+ MyWorksheet.WriteUTF8Text(row, col, CELLTEXT);
+ MyWorksheet.WriteFontColor(row, col, color);
+ MyCell := MyWorksheet.FindCell(row, col);
+ if MyCell = nil then
+ fail('Error in test code. Failed to get cell.');
+ colorInFile := MyWorkbook.GetFont(MyCell^.FontIndex).Color;
+ currentRGB := MyWorkbook.GetPaletteColor(colorInFile);
+ expectedRGB := MyWorkbook.GetPaletteColor(color);
+ CheckEquals(currentRGB, expectedRGB,
+ 'Test unsaved font color, cell ' + CellNotation(MyWorksheet,0,0));
+ inc(row);
+ end;
+ MyWorkBook.WriteToFile(TempFile,sfExcel8,true);
+ MyWorkbook.Free;
+
+ // Open the spreadsheet, as biff8
+ MyWorkbook := TsWorkbook.Create;
+ MyWorkbook.ReadFromFile(TempFile, sfExcel8);
+ 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
+ MyCell := MyWorksheet.FindCell(row, col);
+ if MyCell = nil then
+ fail('Error in test code. Failed to get cell.');
+ color := TsColor(row);
+ colorInFile := MyWorkbook.GetFont(MyCell^.FontIndex).Color;
+ currentRGB := MyWorkbook.GetPaletteColor(colorInFile);
+ expectedRGB := MyWorkbook.GetPaletteColor(color);
+ CheckEquals(currentRGB, expectedRGB,
+ 'Test saved font color, cell '+CellNotation(MyWorksheet,Row,Col));
+ end;
+ MyWorkbook.Free;
+
+ DeleteFile(TempFile);
+end;
+
+procedure TSpreadWriteReadColorTests.TestWriteRead_Background_Internal;
+begin
+ TestWriteReadBackgroundColors(0);
+end;
+
+procedure TSpreadWriteReadColorTests.TestWriteRead_Background_Biff5;
+begin
+ TestWriteReadBackgroundColors(5);
+end;
+
+procedure TSpreadWriteReadColorTests.TestWriteRead_Background_Biff8;
+begin
+ TestWriteReadBackgroundColors(8);
+end;
+
+procedure TSpreadWriteReadColorTests.TestWriteRead_Font_Internal;
+begin
+ TestWriteReadFontColors(0);
+end;
+
+procedure TSpreadWriteReadColorTests.TestWriteRead_Font_Biff5;
+begin
+ TestWriteReadFontColors(5);
+end;
+
+procedure TSpreadWriteReadColorTests.TestWriteRead_Font_Biff8;
+begin
+ TestWriteReadFontColors(8);
+end;
+
+initialization
+ RegisterTest(TSpreadWriteReadColorTests);
+
+end.
+
diff --git a/components/fpspreadsheet/tests/fonttests.pas b/components/fpspreadsheet/tests/fonttests.pas
new file mode 100644
index 000000000..d5e2c4573
--- /dev/null
+++ b/components/fpspreadsheet/tests/fonttests.pas
@@ -0,0 +1,190 @@
+unit fonttests;
+
+{$mode objfpc}{$H+}
+
+interface
+{ Font tests
+This unit tests writing out to and reading back from files.
+}
+
+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, xlsbiff8 {and a project requirement for lclbase for utf8 handling},
+ testsutility;
+
+var
+ // Norm to test against - list of font sizes that should occur in spreadsheet
+ SollSizes: array[0..12] of single; //"Soll" is a German word in Dutch accountancy jargon meaning "normative value to check against". There ;)
+ SollStyles: array[0..15] of TsFontStyles;
+
+ // Initializes Soll*/normative variables.
+ // Useful in test setup procedures to make sure the norm is correct.
+ procedure InitSollSizes;
+ procedure InitSollStyles;
+
+type
+ { TSpreadWriteReadFontTests }
+ //Write to xls/xml file and read back
+ TSpreadWriteReadFontTests = class(TTestCase)
+ private
+ protected
+ // Set up expected values:
+ procedure SetUp; override;
+ procedure TearDown; override;
+ procedure TestWriteReadFont(AFontName: String);
+ published
+ procedure TestWriteReadFont_Arial;
+ procedure TestWriteReadFont_TimesNewRoman;
+ procedure TestWriteReadFont_CourierNew;
+ end;
+
+implementation
+
+uses
+ TypInfo;
+
+const
+ FontSheet = 'Font';
+
+// When adding tests, add values to this array
+// and increase array size in variable declaration
+procedure InitSollSizes;
+begin
+ // Set up norm - MUST match spreadsheet cells exactly
+ SollSizes[0]:=8.0;
+ SollSizes[1]:=9.0;
+ SollSizes[2]:=10.0;
+ SollSizes[3]:=11.0;
+ SollSizes[4]:=12.0;
+ SollSizes[5]:=13.0;
+ SollSizes[6]:=14.0;
+ SollSizes[7]:=16.0;
+ SollSizes[8]:=18.0;
+ SollSizes[9]:=20.0;
+ SollSizes[10]:=24.0;
+ SollSizes[11]:=32.0;
+ SollSizes[12]:=48.0;
+end;
+
+procedure InitSollStyles;
+begin
+ SollStyles[0] := [];
+ SollStyles[1] := [fssBold];
+ SolLStyles[2] := [fssItalic];
+ SollStyles[3] := [fssBold, fssItalic];
+ SollStyles[4] := [fssUnderline];
+ SollStyles[5] := [fssUnderline, fssBold];
+ SollStyles[6] := [fssUnderline, fssItalic];
+ SollStyles[7] := [fssUnderline, fssBold, fssItalic];
+ SollStyles[8] := [fssStrikeout];
+ SollStyles[9] := [fssStrikeout, fssBold];
+ SolLStyles[10] := [fssStrikeout, fssItalic];
+ SollStyles[11] := [fssStrikeout, fssBold, fssItalic];
+ SollStyles[12] := [fssStrikeout, fssUnderline];
+ SollStyles[13] := [fssStrikeout, fssUnderline, fssBold];
+ SollStyles[14] := [fssStrikeout, fssUnderline, fssItalic];
+ SollStyles[15] := [fssStrikeout, fssUnderline, fssBold, fssItalic];
+end;
+
+{ TSpreadWriteReadFontTests }
+
+procedure TSpreadWriteReadFontTests.SetUp;
+begin
+ inherited SetUp;
+ InitSollSizes;
+ InitSollStyles;
+end;
+
+procedure TSpreadWriteReadFontTests.TearDown;
+begin
+ inherited TearDown;
+end;
+
+procedure TSpreadWriteReadFontTests.TestWriteReadFont(AFontName: String);
+var
+ MyWorksheet: TsWorksheet;
+ MyWorkbook: TsWorkbook;
+ row, col: Integer;
+ MyCell: PCell;
+ TempFile: string; //write xls/xml to this file and read back from it
+ cellText: String;
+ font: TsFont;
+ currValue: String;
+ expectedValue: String;
+begin
+ TempFile:=GetTempFileName;
+ {// Not needed: use workbook.writetofile with overwrite=true
+ if fileexists(TempFile) then
+ DeleteFile(TempFile);
+ }
+ MyWorkbook := TsWorkbook.Create;
+ MyWorkSheet:= MyWorkBook.AddWorksheet(FontSheet);
+
+ // Write out all font styles at various sizes
+ for row := 0 to High(SollSizes) do begin
+ for col := 0 to High(SollStyles) do begin
+ cellText := Format('%s, %.1f-pt', [AFontName, SollSizes[row]]);
+ MyWorksheet.WriteUTF8Text(row, col, celltext);
+ MyWorksheet.WriteFont(row, col, AFontName, SollSizes[row], SollStyles[col], scBlack);
+
+ MyCell := MyWorksheet.FindCell(row, col);
+ if MyCell = nil then
+ fail('Error in test code. Failed to get cell.');
+ font := MyWorkbook.GetFont(MyCell^.FontIndex);
+ CheckEquals(SollSizes[row], font.Size,
+ 'Test unsaved font size, cell ' + CellNotation(MyWorksheet,0,0));
+ currValue := GetEnumName(TypeInfo(TsFontStyles), byte(font.Style));
+ expectedValue := GetEnumName(TypeInfo(TsFontStyles), byte(SollStyles[col]));
+ CheckEquals(currValue, expectedValue,
+ 'Test unsaved font style, cell ' + CellNotation(MyWorksheet,0,0));
+ end;
+ end;
+ MyWorkBook.WriteToFile(TempFile,sfExcel8,true);
+ MyWorkbook.Free;
+
+ // Open the spreadsheet, as biff8
+ MyWorkbook := TsWorkbook.Create;
+ MyWorkbook.ReadFromFile(TempFile, sfExcel8);
+ MyWorksheet := GetWorksheetByName(MyWorkBook, FontSheet);
+ if MyWorksheet=nil then
+ fail('Error in test code. Failed to get named worksheet');
+ for row := 0 to MyWorksheet.GetLastRowNumber do
+ for col := 0 to MyWorksheet.GetLastColNumber do begin
+ MyCell := MyWorksheet.FindCell(row, col);
+ if MyCell = nil then
+ fail('Error in test code. Failed to get cell.');
+ font := MyWorkbook.GetFont(MyCell^.FontIndex);
+ CheckEquals(SollSizes[row], font.Size,
+ 'Test saved font size, cell '+CellNotation(MyWorksheet,Row,Col));
+ currValue := GetEnumName(TypeInfo(TsFontStyles), byte(font.Style));
+ expectedValue := GetEnumName(TypeInfo(TsFontStyles), byte(SollStyles[col]));
+ CheckEquals(currValue, expectedValue,
+ 'Test unsaved font style, cell ' + CellNotation(MyWorksheet,0,0));
+ end;
+ MyWorkbook.Free;
+
+ DeleteFile(TempFile);
+end;
+
+procedure TSpreadWriteReadFontTests.TestWriteReadFont_Arial;
+begin
+ TestWriteReadFont('Arial');
+end;
+
+procedure TSpreadWriteReadFontTests.TestWriteReadFont_TimesNewRoman;
+begin
+ TestWriteReadFont('TimesNewRoman');
+end;
+
+procedure TSpreadWriteReadFontTests.TestWriteReadFont_CourierNew;
+begin
+ TestWriteReadFont('CourierNew');
+end;
+
+initialization
+ RegisterTest(TSpreadWriteReadFontTests);
+
+end.
+
diff --git a/components/fpspreadsheet/tests/formattests.pas b/components/fpspreadsheet/tests/formattests.pas
index 3734be6ca..669523ccf 100644
--- a/components/fpspreadsheet/tests/formattests.pas
+++ b/components/fpspreadsheet/tests/formattests.pas
@@ -53,8 +53,6 @@ type
procedure TestWriteReadWordWrap;
// Test alignments
procedure TestWriteReadAlignments;
- // Test background colors
- procedure TestWriteReadBackgroundColors;
end;
implementation
@@ -398,63 +396,6 @@ begin
DeleteFile(TempFile);
end;
-procedure TSpreadWriteReadFormatTests.TestWriteReadBackgroundColors;
-// see also "manualtests".
-const
- CELLTEXT = 'Color test';
-var
- MyWorksheet: TsWorksheet;
- MyWorkbook: TsWorkbook;
- row, col: Integer;
- MyCell: PCell;
- TempFile: string; //write xls/xml to this file and read back from it
- color: TsColor;
-begin
- TempFile:=GetTempFileName;
- {// Not needed: use workbook.writetofile with overwrite=true
- if fileexists(TempFile) then
- DeleteFile(TempFile);
- }
- // Write out all colors
- MyWorkbook := TsWorkbook.Create;
- MyWorkSheet:= MyWorkBook.AddWorksheet(FmtNumbersSheet);
-
- row := 0;
- col := 0;
- for color := Low(TsColor) to scGrey20pct do begin // !!! other colors not working yet!
-// for color in TsColor do begin // this is the full test - failing!
- MyWorksheet.WriteUTF8Text(row, col, CELLTEXT);
- MyWorksheet.WriteBackgroundColor(row, col, color);
- MyCell := MyWorksheet.FindCell(row, col);
- if MyCell = nil then
- fail('Error in test code. Failed to get cell.');
- CheckEquals(color = MyCell^.BackgroundColor, true,
- 'Test unsaved background color, cell ' + CellNotation(MyWorksheet,0,0));
- inc(row);
- end;
- MyWorkBook.WriteToFile(TempFile,sfExcel8,true);
- MyWorkbook.Free;
-
- // Open the spreadsheet, as biff8
- MyWorkbook := TsWorkbook.Create;
- MyWorkbook.ReadFromFile(TempFile, sfExcel8);
- MyWorksheet:=GetWorksheetByName(MyWorkBook, FmtNumbersSheet);
- if MyWorksheet=nil then
- fail('Error in test code. Failed to get named worksheet');
- for row := 0 to MyWorksheet.GetLastRowNumber do begin
- MyCell := MyWorksheet.FindCell(row, col);
- if MyCell = nil then
- fail('Error in test code. Failed to get cell.');
- color := TsColor(row);
- CheckEquals(color = MyCell^.BackgroundColor, true,
- 'Test saved background color, cell '+CellNotation(MyWorksheet,Row,Col));
- end;
- MyWorkbook.Free;
-
- DeleteFile(TempFile);
-end;
-
-
initialization
RegisterTest(TSpreadWriteReadFormatTests);
InitSollFmtData;
diff --git a/components/fpspreadsheet/tests/manualtests.pas b/components/fpspreadsheet/tests/manualtests.pas
index 5cb90b0a1..41c54abac 100644
--- a/components/fpspreadsheet/tests/manualtests.pas
+++ b/components/fpspreadsheet/tests/manualtests.pas
@@ -27,8 +27,8 @@ uses
var
// Norm to test against - list of dates/times that should occur in spreadsheet
- SollColors: array[0..22] of tsColor; //"Soll" is a German word in Dutch accountancy jargon meaning "normative value to check against". There ;)
- SollColorNames: array[0..22] of string; //matching names for SollColors
+ SollColors: array[0..16] of tsColor; //"Soll" is a German word in Dutch accountancy jargon meaning "normative value to check against". There ;)
+ SollColorNames: array[0..16] of string; //matching names for SollColors
// Initializes Soll*/normative variables.
// Useful in test setup procedures to make sure the norm is correct.
procedure InitSollColors;
@@ -101,6 +101,8 @@ begin
SollColors[13]:=scTEAL;
SollColors[14]:=scSilver;
SollColors[15]:=scGrey;
+ SollColors[16]:=scOrange;
+ {
SollColors[16]:=scGrey10pct;
SollColors[17]:=scGrey20pct;
SollColors[18]:=scOrange;
@@ -108,7 +110,7 @@ begin
SollColors[20]:=scBrown;
SollColors[21]:=scBeige;
SollColors[22]:=scWheat;
-
+ }
// Corresponding names for display in cells:
SollColorNames[0]:='scBlack';
SollColorNames[1]:='scWhite';
@@ -126,6 +128,8 @@ begin
SollColorNames[13]:='scTEAL';
SollColorNames[14]:='scSilver';
SollColorNames[15]:='scGrey';
+ SollColorNames[16]:='scOrange';
+ {
SollColorNames[16]:='scGrey10pct';
SollColorNames[17]:='scGrey20pct';
SollColorNames[18]:='scOrange';
@@ -133,6 +137,7 @@ begin
SollColorNames[20]:='scBrown';
SollColorNames[21]:='scBeige';
SollColorNames[22]:='scWheat';
+ }
end;
{ TSpreadManualSetup }
diff --git a/components/fpspreadsheet/tests/numberstests.pas b/components/fpspreadsheet/tests/numberstests.pas
index 68e74a949..9b1af8f25 100644
--- a/components/fpspreadsheet/tests/numberstests.pas
+++ b/components/fpspreadsheet/tests/numberstests.pas
@@ -217,7 +217,7 @@ begin
fail('Error in test code. Failed to get named worksheet');
ActualNumber:=MyWorkSheet.ReadAsNumber(Row, 0);
- CheckEquals(SollNumbers[Row],ActualNumber,'Test value mismatch '
+ CheckEquals(abs(SollNumbers[Row]-ActualNumber) < 1E-4, true,'Test value mismatch '
+'cell '+CellNotation(MyWorkSheet,Row));
// Finalization
diff --git a/components/fpspreadsheet/tests/spreadtestgui.lpi b/components/fpspreadsheet/tests/spreadtestgui.lpi
index 84b9f1466..492991859 100644
--- a/components/fpspreadsheet/tests/spreadtestgui.lpi
+++ b/components/fpspreadsheet/tests/spreadtestgui.lpi
@@ -79,7 +79,7 @@
-
+
@@ -120,6 +120,16 @@
+
+
+
+
+
+
+
+
+
+
@@ -142,7 +152,7 @@
-
+
@@ -161,6 +171,10 @@
+
+
+
+
diff --git a/components/fpspreadsheet/tests/spreadtestgui.lpr b/components/fpspreadsheet/tests/spreadtestgui.lpr
index acf3b5dba..d3a39ee6c 100644
--- a/components/fpspreadsheet/tests/spreadtestgui.lpr
+++ b/components/fpspreadsheet/tests/spreadtestgui.lpr
@@ -3,9 +3,8 @@ program spreadtestgui;
{$mode objfpc}{$H+}
uses
- Interfaces, Forms, GuiTestRunner,
- datetests, stringtests,
- numberstests, manualtests, testsutility, internaltests, formattests;
+ Interfaces, Forms, GuiTestRunner, datetests, stringtests, numberstests,
+ manualtests, testsutility, internaltests, formattests, colortests, fonttests;
begin
Application.Initialize;
diff --git a/components/fpspreadsheet/wikitable.pas b/components/fpspreadsheet/wikitable.pas
index 4392cc9ec..2523d96e2 100644
--- a/components/fpspreadsheet/wikitable.pas
+++ b/components/fpspreadsheet/wikitable.pas
@@ -70,7 +70,7 @@ type
TsWikiTable_PipesReader = class(TsWikiTableReader)
public
- constructor Create; override;
+ constructor Create(AWorkbook: TsWorkbook); override;
end;
{ TsWikiTableWriter }
@@ -81,15 +81,15 @@ type
public
SubFormat: TsSpreadsheetFormat;
{ General writing methods }
- procedure WriteToStrings(AStrings: TStrings; AData: TsWorkbook); override;
- procedure WriteToStrings_WikiMedia(AStrings: TStrings; AData: TsWorkbook);
+ procedure WriteToStrings(AStrings: TStrings); override;
+ procedure WriteToStrings_WikiMedia(AStrings: TStrings);
end;
{ TsWikiTable_WikiMediaWriter }
TsWikiTable_WikiMediaWriter = class(TsWikiTableWriter)
public
- constructor Create; override;
+ constructor Create(AWorkbook: TsWorkbook); override;
end;
implementation
@@ -318,18 +318,18 @@ end;
{ TsWikiTable_PipesReader }
-constructor TsWikiTable_PipesReader.Create;
+constructor TsWikiTable_PipesReader.Create(AWorkbook: TsWorkbook);
begin
- inherited Create;
+ inherited Create(AWorkbook);
SubFormat := sfWikiTable_Pipes;
end;
{ TsWikiTableWriter }
-procedure TsWikiTableWriter.WriteToStrings(AStrings: TStrings; AData: TsWorkbook);
+procedure TsWikiTableWriter.WriteToStrings(AStrings: TStrings);
begin
case SubFormat of
- sfWikiTable_WikiMedia: WriteToStrings_WikiMedia(AStrings, AData);
+ sfWikiTable_WikiMedia: WriteToStrings_WikiMedia(AStrings);
end;
end;
@@ -345,8 +345,7 @@ Format mediawiki:
! style="background-color:green;color:white;" | PASS
|}
*)
-procedure TsWikiTableWriter.WriteToStrings_WikiMedia(AStrings: TStrings;
- AData: TsWorkbook);
+procedure TsWikiTableWriter.WriteToStrings_WikiMedia(AStrings: TStrings);
var
i, j: Integer;
lCurStr: string = '';
@@ -356,7 +355,7 @@ var
lColorStr: String;
begin
AStrings.Add('{| border="1" cellpadding="2" class="wikitable sortable"');
- FWorksheet := AData.GetFirstWorksheet();
+ FWorksheet := Workbook.GetFirstWorksheet();
for i := 0 to FWorksheet.GetLastRowNumber() do
begin
AStrings.Add('|-');
@@ -404,9 +403,9 @@ end;
{ TsWikiTable_WikiMediaWriter }
-constructor TsWikiTable_WikiMediaWriter.Create;
+constructor TsWikiTable_WikiMediaWriter.Create(AWorkbook: TsWorkbook);
begin
- inherited Create;
+ inherited Create(AWorkbook);
SubFormat := sfWikiTable_WikiMedia;
end;
diff --git a/components/fpspreadsheet/xlsbiff2.pas b/components/fpspreadsheet/xlsbiff2.pas
index 0a9d85e44..c817d79fb 100755
--- a/components/fpspreadsheet/xlsbiff2.pas
+++ b/components/fpspreadsheet/xlsbiff2.pas
@@ -45,6 +45,8 @@ type
WorkBookEncoding: TsEncoding;
RecordSize: Word;
FWorksheet: TsWorksheet;
+ FXFList: TFPList;
+ FFont: TsFont;
procedure ReadRowInfo(AStream: TStream);
protected
procedure ApplyCellFormatting(ARow, ACol: Word; XF, AFormat, AFont, AStyle: Byte);
@@ -53,12 +55,16 @@ type
{ Record writing methods }
procedure ReadBlank(AStream: TStream); override;
procedure ReadFont(AStream: TStream);
+ procedure ReadFontColor(AStream: TStream);
procedure ReadFormula(AStream: TStream); override;
procedure ReadLabel(AStream: TStream); override;
procedure ReadNumber(AStream: TStream); override;
procedure ReadInteger(AStream: TStream);
+ procedure ReadXF(AStream: TStream);
public
{ General reading methods }
+ constructor Create(AWorkbook: TsWorkbook); override;
+ destructor Destroy; override;
procedure ReadFromStream(AStream: TStream; AData: TsWorkbook); override;
end;
@@ -71,14 +77,14 @@ type
procedure WriteBOF(AStream: TStream);
procedure WriteCellFormatting(AStream: TStream; ACell: PCell; XFIndex: Word);
procedure WriteEOF(AStream: TStream);
- procedure WriteFont(AStream: TStream; AData: TsWorkbook; AFontIndex: Integer);
- procedure WriteFonts(AStream: TStream; AData: TsWorkbook);
+ procedure WriteFont(AStream: TStream; AFontIndex: Integer);
+ procedure WriteFonts(AStream: TStream);
procedure WriteIXFE(AStream: TStream; XFIndex: Word);
procedure WriteXF(AStream: TStream; AFontIndex, AFormatIndex: byte;
ABorders: TsCellBorders = []; AHorAlign: TsHorAlignment = haLeft;
AddBackground: Boolean = false);
procedure WriteXFFieldsForFormattingStyles(AStream: TStream);
- procedure WriteXFRecords(AStream: TStream; AData: TsWorkbook);
+ procedure WriteXFRecords(AStream: TStream);
protected
procedure AddDefaultFormats(); override;
procedure WriteBlank(AStream: TStream; const ARow, ACol: Cardinal; ACell: PCell); override;
@@ -88,9 +94,21 @@ type
procedure WriteDateTime(AStream: TStream; const ARow, ACol: Cardinal; const AValue: TDateTime; ACell: PCell); override;
public
{ General writing methods }
- procedure WriteToStream(AStream: TStream; AData: TsWorkbook); override;
+ procedure WriteToStream(AStream: TStream); override;
end;
+const
+ PALETTE_BIFF2: array[$0..$07] of DWord = (
+ $000000, // $00: black
+ $FFFFFF, // $01: white
+ $FF0000, // $02: red
+ $00FF00, // $03: green
+ $0000FF, // $04: blue
+ $FFFF00, // $05: yellow
+ $FF00FF, // $06: magenta
+ $00FFFF // $07: cyan
+ );
+
implementation
const
@@ -117,6 +135,11 @@ const
INT_EXCEL_CHART = $0020;
INT_EXCEL_MACRO_SHEET = $0040;
+type
+ TXFData = class
+ FontIndex: Integer;
+ end;
+
{ TsSpreadBIFF2Writer }
procedure TsSpreadBIFF2Writer.AddDefaultFormats();
@@ -219,15 +242,13 @@ end;
Excel 2.x files support only one Worksheet per Workbook,
so only the first will be written.
}
-procedure TsSpreadBIFF2Writer.WriteToStream(AStream: TStream; AData: TsWorkbook);
+procedure TsSpreadBIFF2Writer.WriteToStream(AStream: TStream);
begin
WriteBOF(AStream);
- WriteFonts(AStream, AData);
-
- WriteXFRecords(AStream, AData);
-
- WriteCellsToStream(AStream, AData.GetFirstWorksheet.Cells);
+ WriteFonts(AStream);
+ WriteXFRecords(AStream);
+ WriteCellsToStream(AStream, Workbook.GetFirstWorksheet.Cells);
WriteEOF(AStream);
end;
@@ -358,7 +379,7 @@ begin
end;
end;
-procedure TsSpreadBIFF2Writer.WriteXFRecords(AStream: TStream; AData: TsWorkbook);
+procedure TsSpreadBIFF2Writer.WriteXFRecords(AStream: TStream);
begin
WriteXF(AStream, 0, 0); // XF0
WriteXF(AStream, 0, 0); // XF1
@@ -378,7 +399,7 @@ begin
WriteXF(AStream, 0, 0); // XF15 - Default, no formatting
// Add all further non-standard/built-in formatting styles
- ListAllFormattingStyles(AData);
+ ListAllFormattingStyles;
WriteXFFieldsForFormattingStyles(AStream);
end;
@@ -416,15 +437,14 @@ end;
Writes an Excel 2 font record
The font data is passed as font index.
}
-procedure TsSpreadBIFF2Writer.WriteFont(AStream: TStream; AData: TsWorkbook;
- AFontIndex: Integer);
+procedure TsSpreadBIFF2Writer.WriteFont(AStream: TStream; AFontIndex: Integer);
var
Len: Byte;
lFontName: AnsiString;
optn: Word;
font: TsFont;
begin
- font := AData.GetFont(AFontIndex);
+ font := Workbook.GetFont(AFontIndex);
if font = nil then // this happens for FONT4 in case of BIFF
exit;
@@ -465,12 +485,12 @@ begin
AStream.WriteWord(WordToLE(word(font.Color)));
end;
-procedure TsSpreadBiff2Writer.WriteFonts(AStream: TStream; AData: TsWorkbook);
+procedure TsSpreadBiff2Writer.WriteFonts(AStream: TStream);
var
i: Integer;
begin
- for i:=0 to AData.GetFontCount-1 do
- WriteFont(AStream, AData, i);
+ for i:=0 to Workbook.GetFontCount-1 do
+ WriteFont(AStream, i);
end;
{
@@ -773,17 +793,35 @@ end;
{ TsSpreadBIFF2Reader }
+constructor TsSpreadBIFF2Reader.Create(AWorkbook: TsWorkbook);
+begin
+ inherited Create(AWorkbook);
+ FXFList := TFPList.Create;
+end;
+
+destructor TsSpreadBIFF2Reader.Destroy;
+var
+ j: integer;
+begin
+ for j := FXFList.Count-1 downto 0 do TObject(FXFList[j]).Free;
+ FXFList.Free;
+ inherited;
+end;
+
procedure TsSpreadBIFF2Reader.ApplyCellFormatting(ARow, ACol: Word;
XF, AFormat, AFont, AStyle: Byte);
var
lCell: PCell;
+ xfData: TXFData;
begin
lCell := FWorksheet.GetCell(ARow, ACol);
if Assigned(lCell) then begin
+ xfData := TXFData(FXFList.items[xf]);
+
// Font index
Include(lCell^.UsedFormattingFields, uffFont);
- lCell^.FontIndex := AFont;
+ lCell^.FontIndex := xfData.FontIndex; //AFont;
// Horizontal justification
if AStyle and $07 <> 0 then begin
@@ -825,30 +863,34 @@ var
lOptions: Word;
Len: Byte;
lFontName: UTF8String;
- font: TsFont;
begin
- font := TsFont.Create;
+ FFont := TsFont.Create;
{ Height of the font in twips = 1/20 of a point }
lHeight := WordLEToN(AStream.ReadWord); // WordToLE(200)
- font.Size := lHeight/20;
+ FFont.Size := lHeight/20;
{ Option flags }
lOptions := WordLEToN(AStream.ReadWord);
- font.Style := [];
- if lOptions and $0001 <> 0 then Include(font.Style, fssBold);
- if lOptions and $0002 <> 0 then Include(font.Style, fssItalic);
- if lOptions and $0004 <> 0 then Include(font.Style, fssUnderline);
- if lOptions and $0008 <> 0 then Include(font.Style, fssStrikeout);
+ FFont.Style := [];
+ if lOptions and $0001 <> 0 then Include(FFont.Style, fssBold);
+ if lOptions and $0002 <> 0 then Include(FFont.Style, fssItalic);
+ if lOptions and $0004 <> 0 then Include(FFont.Style, fssUnderline);
+ if lOptions and $0008 <> 0 then Include(FFont.Style, fssStrikeout);
{ Font name: Unicodestring, char count in 1 byte }
Len := AStream.ReadByte();
SetLength(lFontName, Len);
AStream.ReadBuffer(lFontName[1], Len);
- font.FontName := lFontName;
+ FFont.FontName := lFontName;
{ Add font to workbook's font list }
- FWorkbook.AddFont(font);
+ FWorkbook.AddFont(FFont);
+end;
+
+procedure TsSpreadBIFF2Reader.ReadFontColor(AStream: TStream);
+begin
+ FFont.Color := WordLEToN(AStream.ReadWord);
end;
procedure TsSpreadBIFF2Reader.ReadFromStream(AStream: TStream; AData: TsWorkbook);
@@ -879,15 +921,17 @@ begin
case RecordType of
- INT_EXCEL_ID_BLANK: ReadBlank(AStream);
- INT_EXCEL_ID_FONT: ReadFont(AStream);
- INT_EXCEL_ID_INTEGER: ReadInteger(AStream);
- INT_EXCEL_ID_NUMBER: ReadNumber(AStream);
- INT_EXCEL_ID_LABEL: ReadLabel(AStream);
- INT_EXCEL_ID_FORMULA: ReadFormula(AStream);
- INT_EXCEL_ID_ROWINFO: ReadRowInfo(AStream);
- INT_EXCEL_ID_BOF: ;
- INT_EXCEL_ID_EOF: BIFF2EOF := True;
+ INT_EXCEL_ID_BLANK : ReadBlank(AStream);
+ INT_EXCEL_ID_FONT : ReadFont(AStream);
+ INT_EXCEL_ID_FONTCOLOR : ReadFontColor(AStream);
+ INT_EXCEL_ID_INTEGER : ReadInteger(AStream);
+ INT_EXCEL_ID_NUMBER : ReadNumber(AStream);
+ INT_EXCEL_ID_LABEL : ReadLabel(AStream);
+ INT_EXCEL_ID_FORMULA : ReadFormula(AStream);
+ INT_EXCEL_ID_ROWINFO : ReadRowInfo(AStream);
+ INT_EXCEL_ID_XF : ReadXF(AStream);
+ INT_EXCEL_ID_BOF : ;
+ INT_EXCEL_ID_EOF : BIFF2EOF := True;
else
// nothing
@@ -1020,6 +1064,30 @@ begin
end;
end;
+procedure TsSpreadBIFF2Reader.ReadXF(AStream: TStream);
+type
+ TXFRecord = packed record // see p. 224
+ FontIndex: byte; // Offset 0, Size 1
+ NotUsed: byte; // Offset 1, Size 1
+ NumFormat_Flags: byte; // Offset 2, Size 1
+ HorAlign_Border_BackGround: Byte; // Offset 3, Size 1
+ end;
+var
+ xfData: TXFData;
+ xf: TXFRecord;
+ b: Byte;
+begin
+ AStream.ReadBuffer(xf, SizeOf(xf));
+
+ xfData := TXFData.Create;
+
+ // Font index
+ xfData.FontIndex := xf.FontIndex;
+
+ // Add the XF to the list
+ FXFList.Add(xfData);
+end;
+
{*******************************************************************
* Initialization section
*
diff --git a/components/fpspreadsheet/xlsbiff5.pas b/components/fpspreadsheet/xlsbiff5.pas
index 2034fe91b..6169f2e8e 100755
--- a/components/fpspreadsheet/xlsbiff5.pas
+++ b/components/fpspreadsheet/xlsbiff5.pas
@@ -134,11 +134,85 @@ type
procedure WriteXF(AStream: TStream; AFontIndex: Word; AXF_TYPE_PROT: Byte);
public
{ General writing methods }
- procedure WriteToFile(const AFileName: string; AData: TsWorkbook;
+ procedure WriteToFile(const AFileName: string;
const AOverwriteExisting: Boolean = False); override;
- procedure WriteToStream(AStream: TStream; AData: TsWorkbook); override;
+ procedure WriteToStream(AStream: TStream); override;
end;
+const
+ PALETTE_BIFF5: array[$00..$3F] of DWord = (
+ $000000, // $00: black
+ $FFFFFF, // $01: white
+ $FF0000, // $02: red
+ $00FF00, // $03: green
+ $0000FF, // $04: blue
+ $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
+
+ $8080FF, // $18:
+ $802060, // $19:
+ $FFFFC0, // $1A:
+ $A0E0F0, // $1B:
+ $600080, // $1C:
+ $FF8080, // $1D:
+ $0080C0, // $1E:
+ $C0C0FF, // $1F:
+
+ $000080, // $20:
+ $FF00FF, // $21:
+ $FFFF00, // $22:
+ $00FFFF, // $23:
+ $800080, // $24:
+ $800000, // $25:
+ $008080, // $26:
+ $0000FF, // $27:
+ $00CFFF, // $28:
+ $69FFFF, // $29:
+ $E0FFE0, // $2A:
+ $FFFF80, // $2B:
+ $A6CAF0, // $2C:
+ $DD9CB3, // $2D:
+ $B38FEE, // $2E:
+ $E3E3E3, // $2F:
+
+ $2A6FF9, // $30:
+ $3FB8CD, // $31:
+ $488436, // $32:
+ $958C41, // $33:
+ $8E5E42, // $34:
+ $A0627A, // $35:
+ $624FAC, // $36:
+ $969696, // $37:
+ $1D2FBE, // $38:
+ $286676, // $39:
+ $004500, // $3A:
+ $453E01, // $3B:
+ $6A2813, // $3C:
+ $85396A, // $3D:
+ $4A3285, // $3E:
+ $424242 // $3F:
+ );
+
+
implementation
const
@@ -285,7 +359,7 @@ const
*
*******************************************************************}
procedure TsSpreadBIFF5Writer.WriteToFile(const AFileName: string;
- AData: TsWorkbook; const AOverwriteExisting: Boolean);
+ const AOverwriteExisting: Boolean);
var
MemStream: TMemoryStream;
OutputStorage: TOLEStorage;
@@ -294,7 +368,7 @@ begin
MemStream := TMemoryStream.Create;
OutputStorage := TOLEStorage.Create;
try
- WriteToStream(MemStream, AData);
+ WriteToStream(MemStream);
// Only one stream is necessary for any number of worksheets
OLEDocument.Stream := MemStream;
@@ -315,7 +389,7 @@ end;
* part of the document, just the BIFF records
*
*******************************************************************}
-procedure TsSpreadBIFF5Writer.WriteToStream(AStream: TStream; AData: TsWorkbook);
+procedure TsSpreadBIFF5Writer.WriteToStream(AStream: TStream);
var
FontData: TFPCustomFont;
MyData: TMemoryStream;
@@ -324,14 +398,12 @@ var
i, len: Integer;
begin
{ Store some data about the workbook that other routines need }
- WorkBookEncoding := AData.Encoding;
+ WorkBookEncoding := Workbook.Encoding;
{ Write workbook globals }
WriteBOF(AStream, INT_BOF_WORKBOOK_GLOBALS);
-
WriteCodepage(AStream, WorkBookEncoding);
-
WriteWindow1(AStream);
FontData := TFPCustomFont.Create;
@@ -388,18 +460,18 @@ begin
WriteStyle(AStream);
// A BOUNDSHEET for each worksheet
- for i := 0 to AData.GetWorksheetCount - 1 do
+ for i := 0 to Workbook.GetWorksheetCount - 1 do
begin
len := Length(Boundsheets);
SetLength(Boundsheets, len + 1);
- Boundsheets[len] := WriteBoundsheet(AStream, AData.GetWorksheetByIndex(i).Name);
+ Boundsheets[len] := WriteBoundsheet(AStream, Workbook.GetWorksheetByIndex(i).Name);
end;
WriteEOF(AStream);
{ Write each worksheet }
- for i := 0 to AData.GetWorksheetCount - 1 do
+ for i := 0 to Workbook.GetWorksheetCount - 1 do
begin
{ First goes back and writes the position of the BOF of the
sheet on the respective BOUNDSHEET record }
@@ -411,12 +483,10 @@ begin
WriteBOF(AStream, INT_BOF_SHEET);
WriteIndex(AStream);
-
- WriteDimensions(AStream, AData.GetWorksheetByIndex(i));
-
+ WriteDimensions(AStream, Workbook.GetWorksheetByIndex(i));
WriteWindow2(AStream, True);
- WriteCellsToStream(AStream, AData.GetWorksheetByIndex(i).Cells);
+ WriteCellsToStream(AStream, Workbook.GetWorksheetByIndex(i).Cells);
WriteEOF(AStream);
end;
diff --git a/components/fpspreadsheet/xlsbiff8.pas b/components/fpspreadsheet/xlsbiff8.pas
index 6741f03ca..be4cb5566 100755
--- a/components/fpspreadsheet/xlsbiff8.pas
+++ b/components/fpspreadsheet/xlsbiff8.pas
@@ -143,7 +143,7 @@ type
procedure ReadLabel(AStream: TStream); override;
procedure ReadNumber(AStream: TStream); override;
public
- constructor Create; override;
+ constructor Create(AWorkbook: TsWorkbook); override;
destructor Destroy; override;
{ General reading methods }
procedure ReadFromFile(AFileName: string; AData: TsWorkbook); override;
@@ -154,8 +154,6 @@ type
TsSpreadBIFF8Writer = class(TsSpreadBIFFWriter)
private
- // Convert our representation of RGB color to physical ARGB in Excel file
- function LongRGBToExcelPhysical(const RGB: DWord): DWord;
// Writes index to XF record according to cell's formatting
procedure WriteXFIndex(AStream: TStream; ACell: PCell);
procedure WriteXFFieldsForFormattingStyles(AStream: TStream);
@@ -174,13 +172,12 @@ type
procedure WriteDimensions(AStream: TStream; AWorksheet: TsWorksheet);
procedure WriteEOF(AStream: TStream);
procedure WriteFont(AStream: TStream; AFont: TsFont);
- procedure WriteFonts(AStream: TStream; AData: TsWorkbook);
+ procedure WriteFonts(AStream: TStream);
procedure WriteFormula(AStream: TStream; const ARow, ACol: Cardinal;
const AFormula: TsFormula; ACell: PCell); override;
procedure WriteIndex(AStream: TStream);
procedure WriteLabel(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: string; ACell: PCell); override;
- procedure WritePalette(AStream: TStream);
procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: double; ACell: PCell); override;
procedure WriteRPNFormula(AStream: TStream; const ARow, ACol: Cardinal;
@@ -193,16 +190,86 @@ type
AHorAlignment: TsHorAlignment = haDefault; AVertAlignment: TsVertAlignment = vaDefault;
AWordWrap: Boolean = false; AddBackground: Boolean = false;
ABackgroundColor: TsColor = scSilver);
- procedure WriteXFRecords(AStream: TStream; AData: TsWorkbook);
+ procedure WriteXFRecords(AStream: TStream);
public
-// constructor Create;
-// destructor Destroy; override;
{ General writing methods }
- procedure WriteToFile(const AFileName: string; AData: TsWorkbook;
+ procedure WriteToFile(const AFileName: string;
const AOverwriteExisting: Boolean = False); override;
- procedure WriteToStream(AStream: TStream; AData: TsWorkbook); override;
+ procedure WriteToStream(AStream: TStream); override;
end;
+const
+ PALETTE_BIFF8: array[$00..$3F] of DWord = (
+ $000000, // $00: black // 8 built-in default colors
+ $FFFFFF, // $01: white
+ $FF0000, // $02: red
+ $00FF00, // $03: green
+ $0000FF, // $04: blue
+ $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
+ $9999FF, // $18:
+ $993366, // $19:
+ $FFFFCC, // $1A:
+ $CCFFFF, // $1B:
+ $660066, // $1C:
+ $FF8080, // $1D:
+ $0066CC, // $1E:
+ $CCCCFF, // $1F:
+
+ $000080, // $20:
+ $FF00FF, // $21:
+ $FFFF00, // $22:
+ $00FFFF, // $23:
+ $800080, // $24:
+ $800000, // $25:
+ $008080, // $26:
+ $0000FF, // $27:
+ $00CCFF, // $28:
+ $CCFFFF, // $29:
+ $CCFFCC, // $2A:
+ $FFFF99, // $2B:
+ $99CCFF, // $2C:
+ $FF99CC, // $2D:
+ $CC99FF, // $2E:
+ $FFCC99, // $2F:
+
+ $3366FF, // $30:
+ $33CCCC, // $31:
+ $99CC00, // $32:
+ $FFCC00, // $33:
+ $FF9900, // $34:
+ $FF6600, // $35:
+ $666699, // $36:
+ $969696, // $37:
+ $003366, // $38:
+ $339966, // $39:
+ $003300, // $3A:
+ $333300, // $3B:
+ $993300, // $3C:
+ $993366, // $3D:
+ $333399, // $3E:
+ $333333 // $3F:
+ );
+
implementation
const
@@ -229,8 +296,6 @@ const
INT_EXCEL_ID_SST = $00FC; //BIFF8 only
INT_EXCEL_ID_CONTINUE = $003C;
INT_EXCEL_ID_LABELSST = $00FD; //BIFF8 only
- INT_EXCEL_ID_PALETTE = $0092;
- INT_EXCEL_ID_CODEPAGE = $0042;
INT_EXCEL_ID_FORMAT = $041E;
INT_EXCEL_ID_FORCEFULLCALCULATION = $08A3;
@@ -345,24 +410,6 @@ const
{ TsSpreadBIFF8Writer }
-function TsSpreadBIFF8Writer.LongRGBToExcelPhysical(const RGB: DWord): DWord;
-// Converts RGB part of a LongRGB logical structure
-// to its physical representation
-// IOW: RGBA (where A is 0 and omitted in the function call) => ABGR
-begin
- {$IFDEF FPC}
- {$IFDEF ENDIAN_LITTLE}
- result:=(RGB shl 8); //tags $00 at end for the A byte
- result:=SwapEndian(result); //flip byte order
- {$ELSE}
- //Big endian
- result:=RGB; //leave value as is //todo: verify if this turns out ok
- {$ENDIF}
- {$ELSE}
- // messed up result
- {$ENDIF}
-end;
-
{ Index to XF record, according to formatting }
procedure TsSpreadBIFF8Writer.WriteXFIndex(AStream: TStream; ACell: PCell);
var
@@ -558,7 +605,7 @@ end;
*
*******************************************************************}
procedure TsSpreadBIFF8Writer.WriteToFile(const AFileName: string;
- AData: TsWorkbook; const AOverwriteExisting: Boolean);
+ const AOverwriteExisting: Boolean);
var
MemStream: TMemoryStream;
OutputStorage: TOLEStorage;
@@ -567,7 +614,7 @@ begin
MemStream := TMemoryStream.Create;
OutputStorage := TOLEStorage.Create;
try
- WriteToStream(MemStream, AData);
+ WriteToStream(MemStream);
// Only one stream is necessary for any number of worksheets
OLEDocument.Stream := MemStream;
@@ -588,7 +635,7 @@ end;
* part of the document, just the BIFF records
*
*******************************************************************}
-procedure TsSpreadBIFF8Writer.WriteToStream(AStream: TStream; AData: TsWorkbook);
+procedure TsSpreadBIFF8Writer.WriteToStream(AStream: TStream);
var
MyData: TMemoryStream;
CurrentPos: Int64;
@@ -602,31 +649,26 @@ begin
WriteBOF(AStream, INT_BOF_WORKBOOK_GLOBALS);
WriteWindow1(AStream);
-
- WriteFonts(AStream, AData);
-
- // PALETTE
+ WriteFonts(AStream);
WritePalette(AStream);
-
- // XF Records
- WriteXFRecords(AStream, AData);
+ WriteXFRecords(AStream);
WriteStyle(AStream);
// A BOUNDSHEET for each worksheet
- for i := 0 to AData.GetWorksheetCount - 1 do
+ for i := 0 to Workbook.GetWorksheetCount - 1 do
begin
len := Length(Boundsheets);
SetLength(Boundsheets, len + 1);
- Boundsheets[len] := WriteBoundsheet(AStream, AData.GetWorksheetByIndex(i).Name);
+ Boundsheets[len] := WriteBoundsheet(AStream, Workbook.GetWorksheetByIndex(i).Name);
end;
WriteEOF(AStream);
{ Write each worksheet }
- for i := 0 to AData.GetWorksheetCount - 1 do
+ for i := 0 to Workbook.GetWorksheetCount - 1 do
begin
- sheet := AData.GetWorksheetByIndex(i);
+ sheet := Workbook.GetWorksheetByIndex(i);
{ First goes back and writes the position of the BOF of the
sheet on the respective BOUNDSHEET record }
@@ -938,12 +980,12 @@ end;
* used fonts in the workbook.
*
*******************************************************************}
-procedure TsSpreadBiff8Writer.WriteFonts(AStream: TStream; AData: TsWorkbook);
+procedure TsSpreadBiff8Writer.WriteFonts(AStream: TStream);
var
i: Integer;
begin
- for i:=0 to AData.GetFontCount-1 do
- WriteFont(AStream, AData.GetFont(i));
+ for i:=0 to Workbook.GetFontCount-1 do
+ WriteFont(AStream, Workbook.GetFont(i));
end;
{*******************************************************************
@@ -1321,90 +1363,6 @@ begin
AStream.WriteBuffer(AValue, 8);
end;
-
-(*******************************************************************
-* TsSpreadBIFF8Writer.WritePalette
-*
-* DESCRIPTION: Writes Excel PALETTE records
-*
-*******************************************************************)
-
-procedure TsSpreadBIFF8Writer.WritePalette(AStream: TStream);
-begin
- { BIFF Record header }
- AStream.WriteWord(WordToLE(INT_EXCEL_ID_PALETTE));
- AStream.WriteWord(WordToLE(2+4*56));
-
- { Number of colors }
- AStream.WriteWord(WordToLE(56));
-
- { Now the colors, first the standard 16 from Excel }
- AStream.WriteDWord(LongRGBToExcelPhysical($000000)); // $08
- AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
- AStream.WriteDWord(LongRGBToExcelPhysical($FF0000));
- AStream.WriteDWord(LongRGBToExcelPhysical($00FF00));
- AStream.WriteDWord(LongRGBToExcelPhysical($0000FF));
- AStream.WriteDWord(LongRGBToExcelPhysical($FFFF00));
- AStream.WriteDWord(LongRGBToExcelPhysical($FF00FF));
- AStream.WriteDWord(LongRGBToExcelPhysical($00FFFF));
- AStream.WriteDWord(LongRGBToExcelPhysical($800000));
- AStream.WriteDWord(LongRGBToExcelPhysical($008000));
- AStream.WriteDWord(LongRGBToExcelPhysical($000080));
- AStream.WriteDWord(LongRGBToExcelPhysical($808000));
- AStream.WriteDWord(LongRGBToExcelPhysical($800080));
- AStream.WriteDWord(LongRGBToExcelPhysical($008080));
- AStream.WriteDWord(LongRGBToExcelPhysical($C0C0C0));
- AStream.WriteDWord(LongRGBToExcelPhysical($808080)); //$17
-
- { Now some colors which we define ourselves }
- AStream.WriteDWord(LongRGBToExcelPhysical($E6E6E6)); //$18 //todo: shouldn't we write $18..$3F and add this color later? see 5.74.3 Built-In Default Colour Tables
- AStream.WriteDWord(LongRGBToExcelPhysical($CCCCCC)); //$19 //todo: shouldn't we write $18..$3F and add this color later? see 5.74.3 Built-In Default Colour Tables
-
- { And padding }
- AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
- AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
- AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
- AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
- AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
- AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
-
- AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF)); //$20 //todo: is this still correct?
- AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
- AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
- AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
- AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
- AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
- AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
- AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
-
- AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
- AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
- AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
- AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
- AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
- AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
- AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
- AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
-
- AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF)); //$30
- AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
- AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
- AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
- AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
- AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
- AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
- AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
-
- AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
- AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
- AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
- AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
- AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
- AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
- AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
- AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
-end;
-
{*******************************************************************
* TsSpreadBIFF8Writer.WriteStyle ()
*
@@ -1627,12 +1585,12 @@ begin
// Background Pattern Color, always zeroed
if AddBackground then
- AStream.WriteWord(WordToLE(FPSColorToEXCELPalette(ABackgroundColor)))
+ AStream.WriteWord(WordToLE(ABackgroundColor))
else
AStream.WriteWord(0);
end;
-procedure TsSpreadBIFF8Writer.WriteXFRecords(AStream: TStream; AData: TsWorkbook);
+procedure TsSpreadBIFF8Writer.WriteXFRecords(AStream: TStream);
begin
// XF0
WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, []);
@@ -1668,7 +1626,7 @@ begin
WriteXF(AStream, 0, 0, 0, XF_ROTATION_HORIZONTAL, []);
// Add all further non-standard/built-in formatting styles
- ListAllFormattingStyles(AData);
+ ListAllFormattingStyles;
WriteXFFieldsForFormattingStyles(AStream);
end;
@@ -1952,7 +1910,7 @@ begin
CurStreamPos := AStream.Position;
- if RecordType<>INT_EXCEL_ID_CONTINUE then begin
+ if RecordType <> INT_EXCEL_ID_CONTINUE then begin
case RecordType of
INT_EXCEL_ID_BOF: ;
INT_EXCEL_ID_BOUNDSHEET: ReadBoundSheet(AStream);
@@ -1963,6 +1921,7 @@ begin
INT_EXCEL_ID_XF: ReadXF(AStream);
INT_EXCEL_ID_FORMAT: ReadFormat(AStream);
INT_EXCEL_ID_DATEMODE: ReadDateMode(AStream);
+ INT_EXCEL_ID_PALETTE: ReadPalette(AStream);
else
// nothing
end;
@@ -2140,8 +2099,10 @@ begin
XFData := TXFRecordData(FXFList.Items[XFIndex]);
// Font
- Include(lCell^.UsedFormattingFields, uffFont);
- lCell^.FontIndex := XFData.FontIndex;
+ if XFData.FontIndex > 0 then begin
+ Include(lCell^.UsedFormattingFields, uffFont);
+ lCell^.FontIndex := XFData.FontIndex;
+ end;
// Alignment
lCell^.HorAlignment := XFData.HorAlignment;
@@ -2161,8 +2122,10 @@ begin
Exclude(lCell^.UsedFormattingFields, uffBorder);
// Background color
- Include(lCell^.UsedFormattingFields, uffBackgroundColor);
- lCell^.BackgroundColor := XFData.BackgroundColor;
+ if XFData.BackgroundColor <> 0 then begin
+ Include(lCell^.UsedFormattingFields, uffBackgroundColor);
+ lCell^.BackgroundColor := XFData.BackgroundColor;
+ end;
end;
end;
@@ -2172,9 +2135,9 @@ begin
Result:=UTF16ToUTF8(ReadWideString(AStream, ALength));
end;
-constructor TsSpreadBIFF8Reader.Create;
+constructor TsSpreadBIFF8Reader.Create(AWorkbook: TsWorkbook);
begin
- inherited Create;
+ inherited Create(AWorkbook);
FXFList := TFPList.Create;
FFormatList := TFPList.Create;
end;
@@ -2188,6 +2151,7 @@ begin
FXFList.Free;
FFormatList.Free;
if Assigned(FSharedStringTable) then FSharedStringTable.Free;
+ inherited;
end;
procedure TsSpreadBIFF8Reader.ReadFromFile(AFileName: string; AData: TsWorkbook);
@@ -2532,8 +2496,8 @@ begin
Include(lData.Borders, cbSouth);
// Background color;
- xf.Border_Background_3 := WordLEToN(xf.Border_Background_3);
- lData.BackgroundColor := ExcelPaletteToFPSColor(xf.Border_Background_3 AND $007F);
+ xf.Border_Background_3 := DWordLEToN(xf.Border_Background_3);
+ lData.BackgroundColor := xf.Border_Background_3 AND $007F;
// Add the XF to the list
FXFList.Add(lData);
diff --git a/components/fpspreadsheet/xlscommon.pas b/components/fpspreadsheet/xlscommon.pas
index 6b86022fc..a40f3ab56 100644
--- a/components/fpspreadsheet/xlscommon.pas
+++ b/components/fpspreadsheet/xlscommon.pas
@@ -19,6 +19,7 @@ const
INT_EXCEL_ID_FONT = $0031;
INT_EXCEL_ID_CODEPAGE = $0042;
INT_EXCEL_ID_DATEMODE = $0022;
+ INT_EXCEL_ID_PALETTE = $0092;
{ Formula constants TokenID values }
@@ -285,16 +286,18 @@ type
FCodepage: string; // in a format prepared for lconvencoding.ConvertEncoding
FDateMode: TDateMode;
// converts an Excel color index to a color value.
- function ExcelPaletteToFPSColor(AIndex: Word): TsColor;
+// function ExcelPaletteToFPSColor(AIndex: Word): TsColor;
// Here we can add reading of records which didn't change across BIFF2-8 versions
// Workbook Globals records
procedure ReadCodePage(AStream: TStream);
// Figures out what the base year for dates is for this file
procedure ReadDateMode(AStream: TStream);
+ // Read palette
+ procedure ReadPalette(AStream: TStream);
// Read row info
- procedure ReadRowInfo(const AStream: TStream); virtual;
+ procedure ReadRowInfo(AStream: TStream); virtual;
public
- constructor Create; override;
+ constructor Create(AWorkbook: TsWorkbook); override;
end;
{ TsSpreadBIFFWriter }
@@ -304,7 +307,7 @@ type
FDateMode: TDateMode;
FLastRow: Integer;
FLastCol: Word;
- function FPSColorToExcelPalette(AColor: TsColor): Word;
+// function FPSColorToExcelPalette(AColor: TsColor): Word;
procedure GetLastRowCallback(ACell: PCell; AStream: TStream);
function GetLastRowIndex(AWorksheet: TsWorksheet): Integer;
procedure GetLastColCallback(ACell: PCell; AStream: TStream);
@@ -316,8 +319,10 @@ type
procedure WriteCodepage(AStream: TStream; AEncoding: TsEncoding);
// Writes out DATEMODE record depending on FDateMode
procedure WriteDateMode(AStream: TStream);
+ // Writes out a PALETTE record containing all colors defined in the workbook
+ procedure WritePalette(AStream: TStream);
public
- constructor Create; override;
+ constructor Create(AWorkbook: TsWorkbook); override;
end;
function IsExpNumberFormat(s: String; out Decimals: Word): Boolean;
@@ -383,13 +388,13 @@ end;
{ TsSpreadBIFFReader }
-constructor TsSpreadBIFFReader.Create;
+constructor TsSpreadBIFFReader.Create(AWorkbook: TsWorkbook);
begin
- inherited Create;
+ inherited Create(AWorkbook);
// Initial base date in case it won't be read from file
FDateMode := dm1900;
end;
-
+ (*
function TsSpreadBIFFReader.ExcelPaletteToFPSColor(AIndex: Word): TsColor;
begin
case AIndex of
@@ -414,7 +419,7 @@ begin
EXTRA_COLOR_PALETTE_GREY20PCT: Result := scGrey20pct;
end;
end;
-
+ *)
// In BIFF 8 it seams to always use the UTF-16 codepage
procedure TsSpreadBIFFReader.ReadCodePage(AStream: TStream);
var
@@ -492,8 +497,23 @@ begin
end;
end;
+// Read the palette
+procedure TsSpreadBIFFReader.ReadPalette(AStream: TStream);
+var
+ i, n: Word;
+ pal: Array of DWord;
+begin
+ n := WordLEToN(AStream.ReadWord) + 8;
+ SetLength(pal, n);
+ for i:=0 to 7 do
+ pal[i] := Workbook.GetPaletteColor(i);
+ for i:=8 to n-1 do
+ pal[i] := DWordLEToN(AStream.ReadDWord);
+ Workbook.UsePalette(@pal[0], n, false);
+end;
+
// Read the part of the ROW record that is common to all BIFF versions
-procedure TsSpreadBIFFReader.ReadRowInfo(const AStream: TStream);
+procedure TsSpreadBIFFReader.ReadRowInfo(AStream: TStream);
type
TRowRecord = packed record
RowIndex: Word;
@@ -515,53 +535,15 @@ begin
end;
end;
-function TsSpreadBIFFWriter.FPSColorToExcelPalette(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;
- //
- scGrey10pct: Result := EXTRA_COLOR_PALETTE_GREY10PCT;
- scGrey20pct: Result := EXTRA_COLOR_PALETTE_GREY20PCT;
- end;
-end;
-procedure TsSpreadBIFFWriter.GetLastRowCallback(ACell: PCell; AStream: TStream);
-begin
- if ACell^.Row > FLastRow then FLastRow := ACell^.Row;
-end;
+{ TsSpreadBIFFWriter }
-function TsSpreadBIFFWriter.GetLastRowIndex(AWorksheet: TsWorksheet): Integer;
+constructor TsSpreadBIFFWriter.Create(AWorkbook: TsWorkbook);
begin
- FLastRow := 0;
- IterateThroughCells(nil, AWorksheet.Cells, GetLastRowCallback);
- Result := FLastRow;
-end;
-
-procedure TsSpreadBIFFWriter.GetLastColCallback(ACell: PCell; AStream: TStream);
-begin
- if ACell^.Col > FLastCol then FLastCol := ACell^.Col;
-end;
-
-function TsSpreadBIFFWriter.GetLastColIndex(AWorksheet: TsWorksheet): Word;
-begin
- FLastCol := 0;
- IterateThroughCells(nil, AWorksheet.Cells, GetLastColCallback);
- Result := FLastCol;
+ inherited Create(AWorkbook);
+ // Initial base date in case it won't be set otherwise.
+ // Use 1900 to get a bit more range between 1900..1904.
+ FDateMode := dm1900;
end;
function TsSpreadBIFFWriter.FormulaElementKindToExcelTokenID(
@@ -736,6 +718,30 @@ begin
end;
end;
+procedure TsSpreadBIFFWriter.GetLastRowCallback(ACell: PCell; AStream: TStream);
+begin
+ if ACell^.Row > FLastRow then FLastRow := ACell^.Row;
+end;
+
+function TsSpreadBIFFWriter.GetLastRowIndex(AWorksheet: TsWorksheet): Integer;
+begin
+ FLastRow := 0;
+ IterateThroughCells(nil, AWorksheet.Cells, GetLastRowCallback);
+ Result := FLastRow;
+end;
+
+procedure TsSpreadBIFFWriter.GetLastColCallback(ACell: PCell; AStream: TStream);
+begin
+ if ACell^.Col > FLastCol then FLastCol := ACell^.Col;
+end;
+
+function TsSpreadBIFFWriter.GetLastColIndex(AWorksheet: TsWorksheet): Word;
+begin
+ FLastCol := 0;
+ IterateThroughCells(nil, AWorksheet.Cells, GetLastColCallback);
+ Result := FLastCol;
+end;
+
procedure TsSpreadBIFFWriter.WriteCodepage(AStream: TStream;
AEncoding: TsEncoding);
var
@@ -774,12 +780,25 @@ begin
end;
end;
-constructor TsSpreadBIFFWriter.Create;
+procedure TsSpreadBIFFWriter.WritePalette(AStream: TStream);
+var
+ i, n: Integer;
begin
- inherited Create;
- // Initial base date in case it won't be set otherwise.
- // Use 1900 to get a bit more range between 1900..1904.
- FDateMode := dm1900;
+ { BIFF Record header }
+ AStream.WriteWord(WordToLE(INT_EXCEL_ID_PALETTE));
+ AStream.WriteWord(WordToLE(2 + 4*56));
+
+ { Number of colors }
+ AStream.WriteWord(WordToLE(56));
+
+ { Take the colors from the palette of the Worksheet }
+ { Skip the first 8 entries - they are hard-coded into Excel }
+ n := Workbook.GetPaletteSize;
+ for i:=8 to 63 do
+ if i < n then
+ AStream.WriteDWord(DWordToLE(Workbook.GetPaletteColor(i)))
+ else
+ AStream.WriteDWord(DWordToLE($FFFFFF));
end;
diff --git a/components/fpspreadsheet/xlsxooxml.pas b/components/fpspreadsheet/xlsxooxml.pas
index ba38f1885..b339ef0ac 100755
--- a/components/fpspreadsheet/xlsxooxml.pas
+++ b/components/fpspreadsheet/xlsxooxml.pas
@@ -49,7 +49,7 @@ type
{ Strings with the contents of files }
FContentTypes: string;
FRelsRels: string;
- FWorkbook, FWorkbookRels, FStyles, FSharedStrings: string;
+ FWorkbookString, FWorkbookRelsString, FStylesString, FSharedStrings: string;
FSheets: array of string;
FSharedStringsCount: Integer;
{ Streams with the contents of files }
@@ -59,8 +59,8 @@ type
FSSheets: array of TStringStream;
FCurSheetNum: Integer;
{ Routines to write those files }
- procedure WriteGlobalFiles(AData: TsWorkbook);
- procedure WriteContent(AData: TsWorkbook);
+ procedure WriteGlobalFiles;
+ procedure WriteContent;
procedure WriteWorksheet(CurSheet: TsWorksheet);
function GetStyleIndex(ACell: PCell): Cardinal;
{ Record writing methods }
@@ -69,13 +69,12 @@ type
procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal; const AValue: double; ACell: PCell); override;
procedure WriteDateTime(AStream: TStream; const ARow, ACol: Cardinal; const AValue: TDateTime; ACell: PCell); override;
public
- constructor Create; override;
+ constructor Create(AWorkbook: TsWorkbook); override;
destructor Destroy; override;
{ General writing methods }
procedure WriteStringToFile(AFileName, AString: string);
- procedure WriteToFile(const AFileName: string; AData: TsWorkbook;
- const AOverwriteExisting: Boolean = False); override;
- procedure WriteToStream(AStream: TStream; AData: TsWorkbook); override;
+ procedure WriteToFile(const AFileName: string; const AOverwriteExisting: Boolean = False); override;
+ procedure WriteToStream(AStream: TStream); override;
end;
implementation
@@ -117,7 +116,7 @@ const
{ TsSpreadOOXMLWriter }
-procedure TsSpreadOOXMLWriter.WriteGlobalFiles(AData: TsWorkbook);
+procedure TsSpreadOOXMLWriter.WriteGlobalFiles;
var
i: Integer;
begin
@@ -133,7 +132,7 @@ begin
//
' ' + LineEnding +
' ' + LineEnding;
- for i := 1 to AData.GetWorksheetCount do
+ for i := 1 to Workbook.GetWorksheetCount do
begin
FContentTypes := FContentTypes +
Format(' ', [i, MIME_WORKSHEET]) + LineEnding;
@@ -149,7 +148,7 @@ begin
'' + LineEnding +
'';
- FStyles :=
+ FStylesString :=
XML_HEADER + LineEnding +
'' + LineEnding +
' ' + LineEnding +
@@ -189,28 +188,28 @@ begin
'';
end;
-procedure TsSpreadOOXMLWriter.WriteContent(AData: TsWorkbook);
+procedure TsSpreadOOXMLWriter.WriteContent;
var
i: Integer;
begin
{ Workbook relations - Mark relation to all sheets }
- FWorkbookRels :=
+ FWorkbookRelsString :=
XML_HEADER + LineEnding +
'' + LineEnding +
'' + LineEnding +
'' + LineEnding;
- for i := 1 to AData.GetWorksheetCount do
+ for i := 1 to Workbook.GetWorksheetCount do
begin
- FWorkbookRels := FWorkbookRels +
+ FWorkbookRelsString := FWorkbookRelsString +
Format('', [SCHEMAS_WORKSHEET, i, i+2]) + LineEnding;
end;
- FWorkbookRels := FWorkbookRels +
+ FWorkbookRelsString := FWorkbookRelsString +
'';
// Global workbook data - Mark all sheets
- FWorkbook :=
+ FWorkbookString :=
XML_HEADER + LineEnding +
'' + LineEnding +
' ' + LineEnding + // lastEdited="4" lowestEdited="4" rupBuild="4505"
@@ -219,13 +218,13 @@ begin
' ' + LineEnding +
' ' + LineEnding;
- FWorkbook := FWorkbook + ' ' + LineEnding;
- for i := 1 to AData.GetWorksheetCount do
- FWorkbook := FWorkbook +
+ FWorkbookString := FWorkbookString + ' ' + LineEnding;
+ for i := 1 to Workbook.GetWorksheetCount do
+ FWorkbookString := FWorkbookString +
Format(' ', [i, i, i+2]) + LineEnding;
- FWorkbook := FWorkbook + ' ' + LineEnding;
+ FWorkbookString := FWorkbookString + ' ' + LineEnding;
- FWorkbook := FWorkbook +
+ FWorkbookString := FWorkbookString +
' ' + LineEnding +
'';
@@ -236,10 +235,8 @@ begin
// Write all worksheets, which fills also FSharedStrings
SetLength(FSheets, 0);
- for i := 0 to AData.GetWorksheetCount - 1 do
- begin
- WriteWorksheet(Adata.GetWorksheetByIndex(i));
- end;
+ for i := 0 to Workbook.GetWorksheetCount - 1 do
+ WriteWorksheet(Workbook.GetWorksheetByIndex(i));
// Finalization of the shared strings document
FSharedStrings :=
@@ -354,9 +351,9 @@ begin
else Result := 0;
end;
-constructor TsSpreadOOXMLWriter.Create;
+constructor TsSpreadOOXMLWriter.Create(AWorkbook: TsWorkbook);
begin
- inherited Create;
+ inherited Create(AWorkbook);
FPointSeparatorSettings := DefaultFormatSettings;
FPointSeparatorSettings.DecimalSeparator := '.';
@@ -388,35 +385,35 @@ end;
Writes an OOXML document to the disc
}
procedure TsSpreadOOXMLWriter.WriteToFile(const AFileName: string;
- AData: TsWorkbook; const AOverwriteExisting: Boolean);
+ const AOverwriteExisting: Boolean);
var
lStream: TFileStream;
begin
- lStream:=TFileStream.Create(AFileName,fmCreate);
+ lStream:=TFileStream.Create(AFileName, fmCreate);
try
- WriteToStream(lStream, AData);
+ WriteToStream(lStream);
finally
FreeAndNil(lStream);
end;
end;
-procedure TsSpreadOOXMLWriter.WriteToStream(AStream: TStream; AData: TsWorkbook);
+procedure TsSpreadOOXMLWriter.WriteToStream(AStream: TStream);
var
FZip: TZipper;
i: Integer;
begin
{ Fill the strings with the contents of the files }
- WriteGlobalFiles(AData);
- WriteContent(AData);
+ WriteGlobalFiles;
+ WriteContent;
{ Write the data to streams }
FSContentTypes := TStringStream.Create(FContentTypes);
FSRelsRels := TStringStream.Create(FRelsRels);
- FSWorkbookRels := TStringStream.Create(FWorkbookRels);
- FSWorkbook := TStringStream.Create(FWorkbook);
- FSStyles := TStringStream.Create(FStyles);
+ FSWorkbookRels := TStringStream.Create(FWorkbookRelsString);
+ FSWorkbook := TStringStream.Create(FWorkbookString);
+ FSStyles := TStringStream.Create(FStylesString);
FSSharedStrings := TStringStream.Create(FSharedStrings);
SetLength(FSSheets, Length(FSheets));