diff --git a/components/fpspreadsheet/fpsutils.pas b/components/fpspreadsheet/fpsutils.pas
index b82245163..fa757d486 100644
--- a/components/fpspreadsheet/fpsutils.pas
+++ b/components/fpspreadsheet/fpsutils.pas
@@ -12,7 +12,8 @@ unit fpsutils;
interface
uses
- Classes, SysUtils, StrUtils, fpspreadsheet, fpsNumFormatParser;
+ Classes, SysUtils, StrUtils,
+ fpspreadsheet, fpsNumFormatParser;
// Exported types
type
@@ -138,6 +139,8 @@ procedure AppendToStream(AStream: TStream; const AString1, AString2, AString3: S
function PosInMemory(AMagic: QWord; ABuffer: PByteArray; ABufSize: Integer): Integer;
+function TintedColor(AColor: TsColorValue; tint: Double): TsColorValue;
+
procedure Unused(const A1);
procedure Unused(const A1, A2);
procedure Unused(const A1, A2, A3);
@@ -1987,6 +1990,148 @@ begin
end;
end;
+{ Modifying colors }
+{ Next function are copies of GraphUtils to avoid a dependence on the Graphics unit. }
+
+const
+ HUE_000 = 0;
+ HUE_060 = 43;
+ HUE_120 = 85;
+ HUE_180 = 128;
+ HUE_240 = 170;
+ HUE_300 = 213;
+
+procedure RGBtoHLS(const R, G, B: Byte; out H, L, S: Byte);
+var
+ cMax, cMin: Byte; // max and min RGB values
+ Rdelta, Gdelta, Bdelta: Byte; // intermediate value: % of spread from max
+ diff: Byte;
+begin
+ // calculate lightness
+ cMax := MaxIntValue([R, G, B]);
+ cMin := MinIntValue([R, G, B]);
+ L := (integer(cMax) + cMin + 1) div 2;
+ diff := cMax - cMin;
+
+ if diff = 0
+ then begin
+ // r=g=b --> achromatic case
+ S := 0;
+ H := 0;
+ end
+ else begin
+ // chromatic case
+ // saturation
+ if L <= 128
+ then S := integer(diff * 255) div (cMax + cMin)
+ else S := integer(diff * 255) div (510 - cMax - cMin);
+
+ // hue
+ Rdelta := (cMax - R);
+ Gdelta := (cMax - G);
+ Bdelta := (cMax - B);
+
+ if R = cMax
+ then H := (HUE_000 + integer(Bdelta - Gdelta) * HUE_060 div diff) and $ff
+ else if G = cMax
+ then H := HUE_120 + integer(Rdelta - Bdelta) * HUE_060 div diff
+ else H := HUE_240 + integer(Gdelta - Rdelta) * HUE_060 div diff;
+ end;
+end;
+
+
+procedure HLStoRGB(const H, L, S: Byte; out R, G, B: Byte);
+
+ // utility routine for HLStoRGB
+ function HueToRGB(const n1, n2: Byte; Hue: Integer): Byte;
+ begin
+ if Hue > 255
+ then Dec(Hue, 255)
+ else if Hue < 0
+ then Inc(Hue, 255);
+
+ // return r,g, or b value from this tridrant
+ case Hue of
+ HUE_000..HUE_060 - 1: Result := n1 + (n2 - n1) * Hue div HUE_060;
+ HUE_060..HUE_180 - 1: Result := n2;
+ HUE_180..HUE_240 - 1: Result := n1 + (n2 - n1) * (HUE_240 - Hue) div HUE_060;
+ else
+ Result := n1;
+ end;
+ end;
+
+var
+ n1, n2: Byte;
+begin
+ if S = 0
+ then begin
+ // achromatic case
+ R := L;
+ G := L;
+ B := L;
+ end
+ else begin
+ // chromatic case
+ // set up magic numbers
+ if L < 128
+ then begin
+ n2 := L + (L * S) div 255;
+ n1 := 2 * L - n2;
+ end
+ else begin
+ n2 := S + L - (L * S) div 255;
+ n1 := 2 * L - n2 - 1;
+ end;
+
+
+ // get RGB
+ R := HueToRGB(n1, n2, H + HUE_120);
+ G := HueToRGB(n1, n2, H);
+ B := HueToRGB(n1, n2, H - HUE_120);
+ end;
+end;
+
+{ Excel defines theme colors and applies a "tint" factor (-1...+1) to darken
+ or brighten them.
+ The algorithm is described in
+ http://msdn.microsoft.com/en-us/library/documentformat.openxml.spreadsheet.backgroundcolor.aspx
+ (with the exception that max hue is 240, nur 255!)
+}
+function TintedColor(AColor: TsColorValue; tint: Double): TsColorValue;
+type
+ TRGBA = record r, g, b, a: byte end;
+const
+ HLSMAX = 255;
+var
+ r, g, b: byte;
+ h, l, s: Byte;
+ lum: Double;
+begin
+ if tint = 0 then begin
+ Result := AColor;
+ exit;
+ end;
+
+ r := TRGBA(AColor).r;
+ g := TRGBA(AColor).g;
+ b := TRGBA(AColor).b;
+ RGBToHLS(r, g, b, h, l, s);
+
+ lum := l;
+ if tint < 0 then
+ lum := lum * (1.0 + tint)
+ else
+ if tint > 0 then
+ lum := lum * (1.0-tint) + (HLSMAX - HLSMAX * (1.0-tint));
+ l := Min(255, round(lum));
+ HLSToRGB(h, l, s, r, g, b);
+
+ TRGBA(Result).r := r;
+ TRGBA(Result).g := g;
+ TRGBA(Result).b := b;
+ TRGBA(Result).a := 0;
+end;
+
{$PUSH}{$HINTS OFF}
{@@ Silence warnings due to an unused parameter }
procedure Unused(const A1);
diff --git a/components/fpspreadsheet/fpsxmlcommon.pas b/components/fpspreadsheet/fpsxmlcommon.pas
index 5a3e6b314..09368ce60 100644
--- a/components/fpspreadsheet/fpsxmlcommon.pas
+++ b/components/fpspreadsheet/fpsxmlcommon.pas
@@ -29,9 +29,12 @@ var
i: integer;
Found: Boolean;
begin
+ Result := '';
+ if ANode = nil then
+ exit;
+
Found := false;
i := 0;
- Result := '';
while not Found and (i < ANode.Attributes.Length) do begin
if ANode.Attributes.Item[i].NodeName = AAttrName then begin
Found := true;
diff --git a/components/fpspreadsheet/tests/spreadtestgui.lpi b/components/fpspreadsheet/tests/spreadtestgui.lpi
index e3a5d330a..9ab1b5d1d 100644
--- a/components/fpspreadsheet/tests/spreadtestgui.lpi
+++ b/components/fpspreadsheet/tests/spreadtestgui.lpi
@@ -83,12 +83,10 @@
-
-
@@ -98,7 +96,6 @@
-
@@ -133,9 +130,6 @@
-
-
-
diff --git a/components/fpspreadsheet/xlsxooxml.pas b/components/fpspreadsheet/xlsxooxml.pas
index 9dbe66616..0d45686f8 100755
--- a/components/fpspreadsheet/xlsxooxml.pas
+++ b/components/fpspreadsheet/xlsxooxml.pas
@@ -64,10 +64,12 @@ type
FXfList: TFPList;
FFillList: TFPList;
FBorderList: TFPList;
+ FThemeColors: array of TsColorValue;
FWrittenByFPS: Boolean;
procedure ReadBorders(ANode: TDOMNode);
procedure ReadCell(ANode: TDOMNode; AWorksheet: TsWorksheet);
procedure ReadCellXfs(ANode: TDOMNode);
+ function ReadColor(ANode: TDOMNode): TsColor;
procedure ReadCols(ANode: TDOMNode; AWorksheet: TsWorksheet);
procedure ReadDateMode(ANode: TDOMNode);
procedure ReadFileVersion(ANode: TDOMNode);
@@ -80,6 +82,8 @@ type
procedure ReadSharedStrings(ANode: TDOMNode);
procedure ReadSheetList(ANode: TDOMNode; AList: TStrings);
procedure ReadSheetViews(ANode: TDOMNode; AWorksheet: TsWorksheet);
+ procedure ReadThemeElements(ANode: TDOMNode);
+ procedure ReadThemeColors(ANode: TDOMNode);
procedure ReadWorksheet(ANode: TDOMNode; AWorksheet: TsWorksheet);
protected
procedure ApplyCellFormatting(ACell: PCell; XfIndex: Integer);
@@ -159,23 +163,24 @@ uses
const
{ OOXML general XML constants }
- XML_HEADER = '';
+ XML_HEADER = '';
{ OOXML Directory structure constants }
// Note: directory separators are always / because the .xlsx is a zip file which
// requires / instead of \, even on Windows; see
// http://www.pkware.com/documents/casestudies/APPNOTE.TXT
// 4.4.17.1 All slashes MUST be forward slashes '/' as opposed to backwards slashes '\'
- OOXML_PATH_TYPES = '[Content_Types].xml';
- OOXML_PATH_RELS = '_rels/';
- OOXML_PATH_RELS_RELS = '_rels/.rels';
- OOXML_PATH_XL = 'xl/';
- OOXML_PATH_XL_RELS = 'xl/_rels/';
- OOXML_PATH_XL_RELS_RELS = 'xl/_rels/workbook.xml.rels';
- OOXML_PATH_XL_WORKBOOK = 'xl/workbook.xml';
- OOXML_PATH_XL_STYLES = 'xl/styles.xml';
- OOXML_PATH_XL_STRINGS = 'xl/sharedStrings.xml';
+ OOXML_PATH_TYPES = '[Content_Types].xml';
+ OOXML_PATH_RELS = '_rels/';
+ OOXML_PATH_RELS_RELS = '_rels/.rels';
+ OOXML_PATH_XL = 'xl/';
+ OOXML_PATH_XL_RELS = 'xl/_rels/';
+ OOXML_PATH_XL_RELS_RELS = 'xl/_rels/workbook.xml.rels';
+ OOXML_PATH_XL_WORKBOOK = 'xl/workbook.xml';
+ OOXML_PATH_XL_STYLES = 'xl/styles.xml';
+ OOXML_PATH_XL_STRINGS = 'xl/sharedStrings.xml';
OOXML_PATH_XL_WORKSHEETS = 'xl/worksheets/';
+ OOXML_PATH_XL_THEME = 'xl/theme/theme1.xml';
{ OOXML schemas constants }
SCHEMAS_TYPES = 'http://schemas.openxmlformats.org/package/2006/content-types';
@@ -440,6 +445,8 @@ procedure TsSpreadOOXMLReader.ReadBorders(ANode: TDOMNode);
while Assigned(colorNode) do begin
nodeName := colorNode.NodeName;
if nodeName = 'color' then begin
+ ABorderStyle.Color := ReadColor(colorNode);
+ {
s := GetAttrValue(colorNode, 'rgb');
if s <> '' then
ABorderStyle.Color := FWorkbook.AddColorToPalette(HTMLColorStrToColor('#' + s))
@@ -448,6 +455,7 @@ procedure TsSpreadOOXMLReader.ReadBorders(ANode: TDOMNode);
if s <> '' then
ABorderStyle.Color := StrToInt(s);
end;
+ }
end;
colorNode := colorNode.NextSibling;
end;
@@ -697,6 +705,50 @@ begin
end;
end;
+function TsSpreadOOXMLReader.ReadColor(ANode: TDOMNode): TsColor;
+type
+ TRGBA = record r,g,b,a: Byte end;
+var
+ s: String;
+ rgb: TsColorValue;
+ rgba: TRGBA absolute(rgb); // just for debugging
+ idx: Integer;
+ tint: Double;
+begin
+ Assert(ANode <> nil);
+
+ s := GetAttrValue(ANode, 'rgb');
+ if s <> '' then begin
+ Result := FWorkbook.AddColorToPalette(HTMLColorStrToColor('#' + s));
+ exit;
+ end;
+
+ s := GetAttrValue(ANode, 'indexed');
+ if s <> '' then begin
+ Result := StrToInt(s);
+ if (Result >= FWorkbook.GetPaletteSize) then
+ Result := scBlack;
+ exit;
+ end;
+
+ s := GetAttrValue(ANode, 'theme');
+ if s <> '' then begin
+ idx := StrToInt(s);
+ if idx < Length(FThemeColors) then begin
+ rgb := FThemeColors[StrToInt(s)];
+ s := GetAttrValue(ANode, 'tint');
+ if s <> '' then begin
+ tint := StrToFloat(s, FPointSeparatorSettings);
+ rgb := TintedColor(rgb, tint);
+ end;
+ Result := FWorkBook.AddColorToPalette(rgb);
+ exit;
+ end;
+ end;
+
+ Result := scBlack;
+end;
+
procedure TsSpreadOOXMLReader.ReadCols(ANode: TDOMNode; AWorksheet: TsWorksheet);
var
colNode: TDOMNode;
@@ -769,6 +821,8 @@ begin
while Assigned(colorNode) do begin
nodeName := colorNode.NodeName;
if nodeName = 'fgColor' then begin
+ fgclr := ReadColor(colorNode);
+ {
s := GetAttrValue(colorNode, 'rgb');
if s <> '' then
fgclr := FWorkbook.AddColorToPalette(HTMLColorStrToColor('#' + s))
@@ -777,9 +831,12 @@ begin
if s <> '' then
fgclr := StrToInt(s);
end;
+ }
end
else
if nodeName = 'bgColor' then begin
+ bgclr := ReadColor(colorNode);
+ {
s := GetAttrValue(colorNode, 'rgb');
if s <> '' then
bgclr := FWorkbook.AddColorToPalette(HTMLColorStrToColor('#' + s))
@@ -788,6 +845,7 @@ begin
if s <> '' then
bgclr := StrToInt(s);
end;
+ }
end;
colorNode := colorNode.NextSibling;
end;
@@ -863,22 +921,8 @@ begin
then fntStyles := fntStyles + [fssStrikeout];
end
else
- if nodename = 'color' then begin
- s := GetAttrValue(node, 'rgb');
- if s <> '' then begin
- fntColor := FWorkbook.AddColorToPalette(HTMLColorStrToColor('#' + s));
- node := node.NextSibling;
- continue;
- end;
- s := GetAttrValue(node, 'indexed');
- if s <> '' then begin
- fntColor := StrToInt(s);
- if (fntColor >= FWorkbook.GetPaletteSize) then
- fntColor := scBlack;
- node := node.NextSibling;
- continue;
- end;
- end;
+ if nodename = 'color' then
+ fntColor := ReadColor(node);
node := node.NextSibling;
end;
@@ -1031,18 +1075,6 @@ begin
if ANode = nil then
exit;
-
-{
-'' +
- ''+
- '' +
- '' +
- '' +
- '' +
- '' +
-'', [
-}
-
sheetViewNode := ANode.FirstChild;
while Assigned(sheetViewNode) do begin
nodeName := sheetViewNode.NodeName;
@@ -1074,6 +1106,82 @@ begin
end;
end;
+procedure TsSpreadOOXMLReader.ReadThemeColors(ANode: TDOMNode);
+var
+ clrNode: TDOMNode;
+ nodeName: String;
+
+ procedure AddColor(AColorStr: String);
+ begin
+ if AColorStr <> '' then begin
+ SetLength(FThemeColors, Length(FThemeColors)+1);
+ FThemeColors[Length(FThemeColors)-1] := HTMLColorStrToColor('#' + AColorStr);
+ end;
+ end;
+
+begin
+ if not Assigned(ANode) then
+ exit;
+
+ SetLength(FThemeColors, 0);
+ clrNode := ANode.FirstChild;
+ while Assigned(clrNode) do begin
+ nodeName := clrNode.NodeName;
+ if nodeName = 'a:dk1' then
+ AddColor(GetAttrValue(clrNode.FirstChild, 'lastClr'))
+ else
+ if nodeName = 'a:lt1' then
+ AddColor(GetAttrValue(clrNode.FirstChild, 'lastClr'))
+ else
+ if nodeName = 'a:dk2' then
+ AddColor(GetAttrValue(clrNode.FirstChild, 'val'))
+ else
+ if nodeName = 'a:lt2' then
+ AddColor(GetAttrValue(clrNode.FirstChild, 'val'))
+ else
+ if nodeName = 'a:accent1' then
+ AddColor(GetAttrValue(clrNode.FirstChild, 'val'))
+ else
+ if nodeName = 'a:accent2' then
+ AddColor(GetAttrValue(clrNode.FirstChild, 'val'))
+ else
+ if nodeName = 'a:accent3' then
+ AddColor(GetAttrValue(clrNode.FirstChild, 'val'))
+ else
+ if nodeName = 'a:accent4' then
+ AddColor(GetAttrValue(clrNode.FirstChild, 'val'))
+ else
+ if nodeName = 'a:accent5' then
+ AddColor(GetAttrValue(clrNode.FirstChild, 'val'))
+ else
+ if nodeName = 'a:accent6' then
+ AddColor(GetAttrValue(clrNode.FirstChild, 'val'))
+ else
+ if nodeName = 'a:hlink' then
+ AddColor(GetAttrValue(clrNode.FirstChild, 'val'))
+ else
+ if nodeName = 'a:folHlink' then
+ AddColor(GetAttrValue(clrNode.FirstChild, 'aval'));
+ clrNode := clrNode.NextSibling;
+ end;
+end;
+
+procedure TsSpreadOOXMLReader.ReadThemeElements(ANode: TDOMNode);
+var
+ childNode: TDOMNode;
+ nodeName: String;
+begin
+ if not Assigned(ANode) then
+ exit;
+ childNode := ANode.FirstChild;
+ while Assigned(childNode) do begin
+ nodeName := childNode.NodeName;
+ if nodeName = 'a:clrScheme' then
+ ReadThemeColors(childNode);
+ childNode := childNode.NextSibling;
+ end;
+end;
+
procedure TsSpreadOOXMLReader.ReadWorksheet(ANode: TDOMNode; AWorksheet: TsWorksheet);
var
rownode: TDOMNode;
@@ -1117,6 +1225,7 @@ begin
FileList.Add(OOXML_PATH_XL_STYLES); // styles
FileList.Add(OOXML_PATH_XL_STRINGS); // sharedstrings
FileList.Add(OOXML_PATH_XL_WORKBOOK); // workbook
+ FileList.Add(OOXML_PATH_XL_THEME); // theme
try
Unzip.UnZipFiles(AFileName,FileList);
@@ -1128,6 +1237,14 @@ begin
Doc := nil;
SheetList := TStringList.Create;
try
+ // Retrieve theme colors
+ if FileExists(FilePath + OOXML_PATH_XL_THEME) then begin
+ ReadXMLFile(Doc, FilePath + OOXML_PATH_XL_THEME);
+ DeleteFile(FilePath + OOXML_PATH_XL_THEME);
+ ReadThemeElements(Doc.DocumentElement.FindNode('a:themeElements'));
+ FreeAndNil(Doc);
+ end;
+
// process the sharedStrings.xml file
if FileExists(FilePath + OOXML_PATH_XL_STRINGS) then begin
ReadXMLFile(Doc, FilePath + OOXML_PATH_XL_STRINGS);