You've already forked lazarus-ccr
fpspreadsheet: Implementing reading of xlsx theme colors which are found in many xlsx files. Not quite correct yet.
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3440 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
@ -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);
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -83,12 +83,10 @@
|
||||
<Unit8>
|
||||
<Filename Value="colortests.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="colortests"/>
|
||||
</Unit8>
|
||||
<Unit9>
|
||||
<Filename Value="fonttests.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="fonttests"/>
|
||||
</Unit9>
|
||||
<Unit10>
|
||||
<Filename Value="optiontests.pas"/>
|
||||
@ -98,7 +96,6 @@
|
||||
<Unit11>
|
||||
<Filename Value="numformatparsertests.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="numformatparsertests"/>
|
||||
</Unit11>
|
||||
<Unit12>
|
||||
<Filename Value="rpnformulaunit.pas"/>
|
||||
@ -133,9 +130,6 @@
|
||||
<DebugInfoType Value="dsDwarf2Set"/>
|
||||
</Debugging>
|
||||
</Linking>
|
||||
<Other>
|
||||
<CompilerPath Value="$(CompPath)"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions Count="6">
|
||||
|
||||
@ -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 version="1.0" encoding="utf-8" ?>';
|
||||
XML_HEADER = '<?xml version="1.0" encoding="utf-8" ?>';
|
||||
|
||||
{ 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;
|
||||
|
||||
|
||||
{
|
||||
'<sheetViews>' +
|
||||
'<sheetView workbookViewId="0" %s%s>'+
|
||||
'<pane xSplit="%d" ySplit="%d" topLeftCell="%s" activePane="bottomRight" state="frozen" />' +
|
||||
'<selection pane="topRight" activeCell="%s" sqref="%s" />' +
|
||||
'<selection pane="bottomLeft" activeCell="%s" sqref="%s" />' +
|
||||
'<selection pane="bottomRight" activeCell="%s" sqref="%s" />' +
|
||||
'</sheetView>' +
|
||||
'</sheetViews>', [
|
||||
}
|
||||
|
||||
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);
|
||||
|
||||
Reference in New Issue
Block a user