paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

FPSpreadsheet: Proper usage of Theme colors by xlsx chart reader.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9452 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2024-09-19 11:22:04 +00:00
parent 56886c8959
commit a8c183b57a
2 changed files with 81 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

95
components/fpspreadsheet/source/common/xlsxooxml.pas
View File

@ -87,8 +87,8 @@ type
FEmbeddedObjList: TFPList;
FHyperlinkList: TFPList;
FSharedFormulaBaseList: TFPList;
FThemeColorList: TFPList;
FPalette: TsPalette;
FThemeColors: array of TsColor;
FLastRow, FLastCol: Cardinal;
FWrittenByFPS: Boolean;
procedure ApplyCellFormatting(ACell: PCell; XfIndex: Integer);
@ -169,6 +169,7 @@ type
destructor Destroy; override;
class function CheckFileFormat(AStream: TStream): Boolean; override;
function CreateXMLStream: TStream;
function GetThemeColor(AName: String): Integer;
function NeedsPassword(AStream: TStream): Boolean; override;
procedure ReadFromStream(AStream: TStream; APassword: String = '';
AParams: TsStreamParams = []); override;
@ -488,6 +489,11 @@ type
RelId: String;
end;
TThemeColor = class
Name: String;
Color: TsColor;
end;
const
PATTERN_TYPES: array [TsFillStyle] of string = (
'none', // fsNoFill
@ -846,6 +852,7 @@ begin
FCellFormatList := TsCellFormatList.Create(true);
FDifferentialFormatList := TFPList.Create;
FDrawingToSheetRelList := TFPList.Create;
FThemeColorList := TFPList.Create;
FEmbeddedObjList := TFPList.Create;
// Allow duplicates because xf indexes used in cell records cannot be found any more.
FSharedFormulaBaseList := TFPList.Create;
@ -882,9 +889,14 @@ begin
TObject(FDifferentialFormatList[j]).Free;
FDifferentialFormatList.Free;
for j := FThemeColorList.Count-1 downto 0 do
TObject(FThemeColorList[j]).Free;
FThemeColorList.Free;
for j := FDrawingToSheetRelList.Count-1 downto 0 do
TObject(FDrawingToSheetRelList[j]).Free;
FDrawingToSheetRelList.Free;
for j := FSheetList.Count-1 downto 0 do
TObject(FSheetList[j]).Free;
FSheetList.Free;
@ -985,6 +997,21 @@ begin
Result := TMemoryStream.Create;
end;
function TsSpreadOOXMLReader.GetThemeColor(AName: String): Integer;
var
i: Integer;
begin
AName := 'a:' + AName;
for i := 0 to FThemeColorList.Count-1 do
if SameText(TThemeColor(FThemeColorList[i]).Name, AName) then
begin
Result := TThemeColor(FThemeColorList[i]).Color;
exit;
end;
Result := scNotDefined;
end;
{ Checks the file header for the signature of the decrypted file format. }
class function TsSpreadOOXMLReader.IsEncrypted(AStream: TStream): Boolean;
var
@ -2108,7 +2135,7 @@ begin
s := GetAttrValue(ANode, 'theme');
if s <> '' then begin
idx := StrToInt(s);
if idx < Length(FThemeColors) then begin
if idx < FThemeColorList.Count then begin
// For some reason the first two pairs of colors are interchanged in Excel!
case idx of
0: idx := 1;
@ -2116,7 +2143,7 @@ begin
2: idx := 3;
3: idx := 2;
end;
rgb := FThemeColors[idx];
rgb := TThemeColor(FThemeColorList[idx]).Color;
s := GetAttrValue(ANode, 'tint');
if s <> '' then begin
tint := StrToFloat(s, FPointSeparatorSettings);
@ -4349,14 +4376,37 @@ end;
procedure TsSpreadOOXMLReader.ReadThemeColors(ANode: TDOMNode);
var
child: TDOMNode;
clrNode: TDOMNode;
nodeName: String;
j: Integer;
procedure AddColor(AColorStr: String);
function GetColorFromNode(ANode: TDOMNode; AAttrName: String): String;
var
nodeName: String;
begin
while Assigned(ANode) do
begin
nodeName := ANode.NodeName;
if (nodeName = 'a:sysClr') or (nodeName = 'a:srgbClr') then
begin
Result := GetAttrValue(ANode, AAttrName);
exit;
end;
ANode := ANode.NextSibling;
end;
Result := '';
end;
procedure AddColor(AColorName, AColorStr: String);
var
themeClr: TThemeColor;
begin
if AColorStr <> '' then begin
SetLength(FThemeColors, Length(FThemeColors)+1);
FThemeColors[Length(FThemeColors)-1] := HTMLColorStrToColor('#' + AColorStr);
themeClr := TThemeColor.Create;
themeClr.Name := AColorName;
themeClr.Color := HTMLColorStrToColor('#' + AColorStr);
FThemeColorList.Add(themeClr);
end;
end;
@ -4364,45 +4414,52 @@ begin
if not Assigned(ANode) then
exit;
SetLength(FThemeColors, 0);
if FThemeColorList.Count > 0 then
begin
for j := FThemeColorList.Count-1 downto 0 do
TObject(FThemeColorList[j]).Free;
FThemeColorList.Clear;
end;
clrNode := ANode.FirstChild;
while Assigned(clrNode) do begin
nodeName := clrNode.NodeName;
child := clrNode.FirstChild;
if nodeName = 'a:dk1' then
AddColor(GetAttrValue(clrNode.FirstChild, 'lastClr'))
AddColor(nodeName, GetColorFromNode(child, 'lastClr'))
else
if nodeName = 'a:lt1' then
AddColor(GetAttrValue(clrNode.FirstChild, 'lastClr'))
AddColor(nodeName, GetColorFromNode(child, 'lastClr'))
else
if nodeName = 'a:dk2' then
AddColor(GetAttrValue(clrNode.FirstChild, 'val'))
AddColor(nodeName, GetColorFromNode(child, 'val'))
else
if nodeName = 'a:lt2' then
AddColor(GetAttrValue(clrNode.FirstChild, 'val'))
AddColor(nodeName, GetColorFromNode(child, 'val'))
else
if nodeName = 'a:accent1' then
AddColor(GetAttrValue(clrNode.FirstChild, 'val'))
AddColor(nodeName, GetColorFromNode(child, 'val'))
else
if nodeName = 'a:accent2' then
AddColor(GetAttrValue(clrNode.FirstChild, 'val'))
AddColor(nodeName, GetColorFromNode(child, 'val'))
else
if nodeName = 'a:accent3' then
AddColor(GetAttrValue(clrNode.FirstChild, 'val'))
AddColor(nodeName, GetColorFromNode(child, 'val'))
else
if nodeName = 'a:accent4' then
AddColor(GetAttrValue(clrNode.FirstChild, 'val'))
AddColor(nodeName, GetColorFromNode(child, 'val'))
else
if nodeName = 'a:accent5' then
AddColor(GetAttrValue(clrNode.FirstChild, 'val'))
AddColor(nodeName, GetColorFromNode(child, 'val'))
else
if nodeName = 'a:accent6' then
AddColor(GetAttrValue(clrNode.FirstChild, 'val'))
AddColor(nodeName, GetColorFromNode(child, 'val'))
else
if nodeName = 'a:hlink' then
AddColor(GetAttrValue(clrNode.FirstChild, 'val'))
AddColor(nodeName, GetColorFromNode(child, 'val'))
else
if nodeName = 'a:folHlink' then
AddColor(GetAttrValue(clrNode.FirstChild, 'aval'));
AddColor(nodeName, GetColorFromNode(child, 'aval'));
clrNode := clrNode.NextSibling;
end;
end;

26
components/fpspreadsheet/source/common/xlsxooxmlchart.pas
View File

@ -8,7 +8,7 @@ interface
{$ifdef FPS_CHARTS}
uses //LazLoggerBase,
Classes, SysUtils, StrUtils, Contnrs, FPImage, fgl,
Classes, SysUtils, StrUtils, Contnrs, FPImage,
{$ifdef FPS_PATCHED_ZIPPER}fpszipper,{$else}zipper,{$endif}
laz2_xmlread, laz2_DOM,
fpsTypes, fpSpreadsheet, fpsChart, fpsUtils, fpsNumFormat, fpsImages,
@ -20,7 +20,6 @@ type
TsSpreadOOXMLChartReader = class(TsBasicSpreadChartReader)
private
FPointSeparatorSettings: TFormatSettings;
FColors: specialize TFPGMap<string, TsColor>;
FImages: TFPObjectList;
FXAxisID, FYAxisID, FX2AxisID, FY2AxisID: DWord;
FXAxisDelete, FYAxisDelete, FX2AxisDelete, FY2AxisDelete: Boolean;
@ -282,27 +281,12 @@ begin
FPointSeparatorSettings := SysUtils.DefaultFormatSettings;
FPointSeparatorSettings.DecimalSeparator:='.';
// The following color values are directly copied from xlsx files written by Excel.
// In the long term, they should be read from xl/theme/theme1.xml.
FColors := specialize TFPGMap<string, TsColor>.Create;
FColors.Add('dk1', scBlack);
FColors.Add('lt1', scWhite);
FColors.Add('dk2', FlipColorBytes($44546A));
FColors.Add('lt2', FlipColorBytes($E7E6E6));
FColors.Add('accent1', FlipColorBytes($4472C4));
FColors.Add('accent2', FlipColorBytes($ED7D31));
FColors.Add('accent3', FlipColorBytes($A5A5A5));
FColors.Add('accent4', FlipColorBytes($FFC000));
FColors.Add('accent5', FlipColorBytes($5B9BD5));
FColors.Add('accent6', FlipColorBytes($70AD47));
FImages := TFPObjectList.Create;
end;
destructor TsSpreadOOXMLChartReader.Destroy;
begin
FImages.Free;
FColors.Free;
inherited;
end;
@ -672,9 +656,9 @@ procedure TsSpreadOOXMLChartReader.ReadChartColor(ANode: TDOMNode;
var
nodeName, s: String;
idx: Integer;
n: Integer;
child: TDOMNode;
themeRGB: TsColor;
lumMod: Single = 1.0;
lumOff: Single = 0.0;
begin
@ -687,10 +671,10 @@ begin
s := GetAttrValue(ANode, 'val');
if (s <> '') then
begin
idx := FColors.IndexOf(ColorAlias(s));
if idx > -1 then
themeRGB := TsSpreadOOXMLReader(Reader).GetThemeColor(ColorAlias(s));
if themeRGB <> scNotDefined then
begin
AColor.Color := FColors.Data[idx];
AColor.Color := themeRGB;
child := ANode.FirstChild;
while Assigned(child) do
begin