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

fpspreadsheet: xlsx chart reader with limited support of image fills.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9177 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2024-01-26 23:24:26 +00:00
parent 555cab8fa2
commit 9f5ceb3297
3 changed files with 141 additions and 56 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
components/fpspreadsheet/source/common/fpschart.pas
View File

@ -158,7 +158,7 @@ type
Image: TFPCustomImage;
Width, Height: Double; // mm
destructor Destroy; override;
procedure Copyfrom(ASource: TsChartImage);
procedure CopyFrom(ASource: TsChartImage);
end;
TsChartImagelist = class(TFPObjectList)

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

@ -50,6 +50,24 @@ uses
fpsxmlcommon, xlsCommon;
type
TXlsxRelationship = class
RelID: String;
Target: String;
Schema: String;
end;
TXlsxRelationshipList = class(TFPList)
private
function GetItem(AIndex: Integer): TXlsxRelationship;
procedure SetItem(AIndex: Integer; AValue: TXlsxRelationship);
public
destructor Destroy; override;
function Add(ARelID, ASchema, ATarget: String): TXlsxRelationship;
procedure Clear;
procedure Delete(AIndex: Integer);
function FindTarget(ARelID: String): String;
property Items[AIndex: Integer]: TXlsxRelationship read GetItem write SetItem; default;
end;
{ TsSpreadOOXMLReader }
@ -128,7 +146,6 @@ type
procedure ReadPageSetup(ANode: TDOMNode; AWorksheet: TsBasicWorksheet);
procedure ReadPalette(ANode: TDOMNode);
procedure ReadPrintOptions(ANode: TDOMNode; AWorksheet: TsBasicWorksheet);
procedure ReadRels(AStream: TStream; ARelsFile: String; ARelsList: TFPList);
procedure ReadRow(ANode: TDOMNode; AWorksheet: TsBasicWorksheet; var ARowIndex: Cardinal);
procedure ReadSharedStrings(ANode: TDOMNode);
procedure ReadSheetFormatPr(ANode: TDOMNode; AWorksheet: TsBasicWorksheet);
@ -155,6 +172,7 @@ type
function CreateXMLStream: TStream;
procedure ReadFromStream(AStream: TStream; APassword: String = '';
AParams: TsStreamParams = []); override;
procedure ReadRels(AStream: TStream; ARelsFile: String; ARelsList: TFPList);
end;
{ TsSpreadOOXMLWriter }
@ -311,6 +329,7 @@ var
sfidOOXML: TsSpreadFormatID;
procedure InitOOXMLLimitations(out ALimitations: TsSpreadsheetFormatLimitations);
function MakeXLPath(AFileName: String): String;
implementation
@ -460,25 +479,6 @@ type
Formula: String;
end;
TRelationship = class
RelID: String;
Target: String;
Schema: String;
end;
TRelationshipList = class(TFPList)
private
function GetItem(AIndex: Integer): TRelationship;
procedure SetItem(AIndex: Integer; AValue: TRelationship);
public
destructor Destroy; override;
function Add(ARelID, ASchema, ATarget: String): TRelationship;
procedure Clear;
procedure Delete(AIndex: Integer);
function FindTarget(ARelID: String): String;
property Items[AIndex: Integer]: TRelationship read GetItem write SetItem; default;
end;
TSheetData = class
Name: String;
ID: String;
@ -488,10 +488,10 @@ type
SheetRels: TFPList;
SheetRelsFile: String;
Drawing_File: String;
DrawingRels: TRelationshipList;
DrawingRels: TXlsxRelationshipList;
VmlDrawing_File: String;
VmlDrawingRels: TRelationshipList;
HyperlinkRels: TRelationshipList;
VmlDrawingRels: TXlsxRelationshipList;
HyperlinkRels: TXlsxRelationshipList;
Comments_File: String;
constructor Create;
destructor Destroy; override;
@ -754,20 +754,20 @@ begin
end;
{ TRelationshipList }
{ TXlsxRelationshipList }
destructor TRelationshipList.Destroy;
destructor TXlsxRelationshipList.Destroy;
begin
Clear;
inherited;
end;
function TRelationshipList.Add(ARelID, ASchema, ATarget: String): TRelationship;
function TXlsxRelationshipList.Add(ARelID, ASchema, ATarget: String): TXlsxRelationship;
var
rel: TRelationship;
rel: TXlsxRelationship;
idx: Integer;
begin
rel := TRelationship.Create;
rel := TXlsxRelationship.Create;
rel.RelID := ARelID;
rel.Schema := ASchema;
rel.Target := ATarget;
@ -775,7 +775,7 @@ begin
Result := Items[idx];
end;
procedure TRelationshipList.Clear;
procedure TXlsxRelationshipList.Clear;
var
j: Integer;
begin
@ -783,16 +783,16 @@ begin
inherited;
end;
procedure TRelationshipList.Delete(AIndex: Integer);
procedure TXlsxRelationshipList.Delete(AIndex: Integer);
begin
Items[AIndex].Free;
inherited;
end;
function TRelationshipList.FindTarget(ARelID: String): String;
function TXlsxRelationshipList.FindTarget(ARelID: String): String;
var
i: Integer;
rel: TRelationship;
rel: TXlsxRelationship;
begin
for i := 0 to Count-1 do
begin
@ -806,12 +806,12 @@ begin
Result := '';
end;
function TRelationshipList.GetItem(AIndex: Integer): TRelationship;
function TXlsxRelationshipList.GetItem(AIndex: Integer): TXlsxRelationship;
begin
Result := TRelationship(inherited Items[AIndex]);
Result := TXlsxRelationship(inherited Items[AIndex]);
end;
procedure TRelationshipList.SetItem(AIndex: Integer; AValue: TRelationship);
procedure TXlsxRelationshipList.SetItem(AIndex: Integer; AValue: TXlsxRelationship);
begin
inherited Items[AIndex] := AValue;
end;
@ -822,10 +822,10 @@ end;
constructor TSheetData.Create;
begin
inherited;
SheetRels := TRelationshipList.Create;
DrawingRels := TRelationshipList.Create;
VmlDrawingRels := TRelationshipList.Create;
HyperlinkRels := TRelationshipList.Create;
SheetRels := TXlsxRelationshipList.Create;
DrawingRels := TXlsxRelationshipList.Create;
VmlDrawingRels := TXlsxRelationshipList.Create;
HyperlinkRels := TXlsxRelationshipList.Create;
end;
destructor TSheetData.Destroy;
@ -853,7 +853,7 @@ begin
FSharedStrings := TStringList.Create;
FSheetList := TFPList.Create;
FWorkbookRels := TRelationshipList.Create;
FWorkbookRels := TXlsxRelationshipList.Create;
FFillList := TFPList.Create;
FBorderList := TFPList.Create;
FHyperlinkList := TFPList.Create;
@ -3771,7 +3771,7 @@ begin
relSchema := GetAttrValue(node, 'Type');
relTarget := GetAttrValue(node, 'Target');
if (relID <> '') and (relTarget <> '') then
(ARelsList as TRelationshipList).Add(relID, relSchema, relTarget);
(ARelsList as TXlsxRelationshipList).Add(relID, relSchema, relTarget);
end;
node := node.NextSibling;
end;
@ -4153,7 +4153,7 @@ begin
for i := 0 to FSheetList.Count-1 do
begin
sheetData := TSheetData(FSheetList[i]);
sheetData.Target := TRelationshipList(FWorkbookRels).FindTarget(sheetData.RelID);
sheetData.Target := TXlsxRelationshipList(FWorkbookRels).FindTarget(sheetData.RelID);
sheetData.SheetRelsFile := OOXML_PATH_XL_WORKSHEETS + '_rels/' + ExtractFileName(sheetData.Target) + '.rels';
ReadRels(AStream, sheetData.SheetRelsFile, sheetData.SheetRels);
end;
@ -4169,7 +4169,7 @@ var
sheetIndex: Integer;
relID: String;
sheetRelsFile: String;
rels: TRelationshipList;
rels: TXlsxRelationshipList;
i: Integer;
begin
sheetIndex := TsWorksheet(AWorksheet).Index;
@ -4184,7 +4184,7 @@ begin
begin
// This node points to the drawing.xml file with parameters for embedded
// images.
rels := TRelationshipList.Create;
rels := TXlsxRelationshipList.Create;
try
ReadRels(AStream, sheetRelsFile, rels);
relID := GetAttrValue(ANode, 'r:id');
@ -4197,7 +4197,7 @@ begin
if nodeName = 'legacyDrawingHF' then
begin
// This is the node pointer to parameters for heater/footer images.
rels := TRelationshipList.Create;
rels := TXlsxRelationshipList.Create;
try
ReadRels(AStream, sheetRelsFile, rels);
relID := GetAttrValue(ANode, 'r:id');
@ -4212,7 +4212,7 @@ begin
// This node is for comment size & position. We do not support this.
// But it indicates the presence of comments and extract the name of the
// comments.xml file from the sheet<n>.xml.rels file
rels := TRelationshipList.Create;
rels := TXlsxRelationshipList.Create;
try
ReadRels(AStream, sheetRelsFile, rels);
for i := 0 to rels.Count-1 do
@ -4231,7 +4231,7 @@ begin
// It contains also the relationship ids to external files listed in
// the sheet<n>.xml.rels file. We read these relationships here and store
// them in the HyperlinkRels of the sheetdata.
rels := TRelationshipList.Create;
rels := TXlsxRelationshipList.Create;
try
ReadRels(AStream, sheetRelsfile, rels);
for i := 0 to rels.Count-1 do
@ -4699,7 +4699,7 @@ begin
// unzip sheet file
XMLStream := CreateXMLStream;
try
fn := TRelationshipList(FWorkbookRels).FindTarget(sheetData.RelID);
fn := TXlsxRelationshipList(FWorkbookRels).FindTarget(sheetData.RelID);
if fn = '' then
fn := OOXML_PATH_XL_WORKSHEETS + Format('sheet%d.xml', [i+1])
else

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

@ -41,7 +41,7 @@ type
function ReadChartAxisTickMarks(ANode: TDOMNode): TsChartAxisTicks;
procedure ReadChartBarSeries(ANode: TDOMNode; AChart: TsChart);
procedure ReadChartBubbleSeries(ANode: TDOMNode; AChart: TsChart);
procedure ReadChartSeriesDataPointStyles(ANode: TDOMNode; ASeries: TsChartSeries);
procedure ReadChartImages(AStream: TStream; AChart: TsChart; ARelsList: TFPList);
procedure ReadChartLegend(ANode: TDOMNode; AChartLegend: TsChartLegend);
procedure ReadChartLineSeries(ANode: TDOMNode; AChart: TsChart);
procedure ReadChartPieSeries(ANode: TDOMNode; AChart: TsChart; RingMode: Boolean);
@ -49,6 +49,7 @@ type
procedure ReadChartRadarSeries(ANode: TDOMNode; AChart: TsChart);
procedure ReadChartScatterSeries(ANode: TDOMNode; AChart: TsChart);
procedure ReadChartSeriesAxis(ANode: TDOMNode; ASeries: TsChartSeries);
procedure ReadChartSeriesDataPointStyles(ANode: TDOMNode; ASeries: TsChartSeries);
procedure ReadChartSeriesErrorBars(ANode: TDOMNode; ASeries: TsChartSeries);
procedure ReadChartSeriesLabels(ANode: TDOMNode; ASeries: TsChartSeries);
procedure ReadChartSeriesMarker(ANode: TDOMNode; ASeries: TsCustomLineSeries);
@ -59,11 +60,10 @@ type
procedure ReadChartStockSeries(ANode: TDOMNode; AChart: TsChart);
procedure ReadChartStockSeriesUpDownBars(ANode: TDOMNode; ASeries: TsStockSeries);
procedure ReadChartTitle(ANode: TDOMNode; ATitle: TsChartText);
public
constructor Create(AReader: TsBasicSpreadReader); override;
destructor Destroy; override;
procedure ReadChartXML(AStream: TStream; AChart: TsChart; AChartXML: String);
procedure ReadChartXML(AStream: TStream; AChart: TsChart; AChartXMLFile: String);
end;
@ -545,6 +545,8 @@ var
gradient: TsChartGradient;
color: TsColor;
hatch: string;
relID: String;
imgWidth, imgHeight: Double;
begin
if ANode = nil then
exit;
@ -723,6 +725,27 @@ begin
end;
end;
// Image fill
// to do: only partially supported since TAChart cannot display this and we cannot write it back.
'a:blipFill':
begin
AFill.Style := cfsImage;
child1 := ANode.FirstChild;
while Assigned(child1) do
begin
nodeName := child1.NodeName;
case nodeName of
'a:blip':
relID := GetAttrValue(child1, 'r:embed');
'a:tile':
// contains x/y scaling factor and image offset.
;
end;
child1 := child1.NextSibling;
end;
AFill.Image := AChart.Images.IndexOf(relID);
end;
// Line style
'a:ln':
ReadChartLineProps(ANode, AChart, ALine);
@ -809,13 +832,54 @@ begin
end;
end;
procedure TsSpreadOOXMLChartReader.ReadChartImages(AStream: TStream;
AChart: TsChart; ARelsList: TFPList);
var
i: Integer;
rel: TXlsxRelationship;
img: TFPCustomImage;
imgFileName: string;
memStream: TMemoryStream;
unzip: TStreamUnzipper;
begin
for i := 0 to ARelsList.Count-1 do
begin
rel := TXlsxRelationshipList(ARelsList)[i];
if rel.Schema = 'http://schemas.openxmlformats.org/officeDocument/2006/relationships/image' then
begin
imgFileName := MakeXLPath(rel.Target);
if imgFileName = '' then
Continue;
unzip := TStreamUnzipper.Create(AStream);
try
unzip.Examine;
memStream := TMemoryStream.Create;
try
unzip.UnzipFile(imgFileName, memStream);
memStream.Position := 0;
if memStream.Size > 0 then
begin
img := TFPMemoryImage.Create(0, 0); // do not destroy this image here!
img.LoadFromStream(memStream);
AChart.Images.AddImage(rel.RelID, img);
end;
finally
memStream.Free;
end;
finally
unzip.Free;
end;
end;
end;
end;
{@@ ----------------------------------------------------------------------------
Reads the individual data point styles of a series.
@param ANode First child of the <c:dPt> node
@param ASeries Series to which these data points belong
-------------------------------------------------------------------------------}
procedure TsSpreadOOXMLChartreader.ReadChartSeriesDataPointStyles(ANode: TDOMNode;
procedure TsSpreadOOXMLChartReader.ReadChartSeriesDataPointStyles(ANode: TDOMNode;
ASeries: TsChartSeries);
var
nodename, s: String;
@ -1997,23 +2061,44 @@ begin
end;
end;
{@@ ----------------------------------------------------------------------------
Reads the main xml file of a chart (and the associated rels file)
@param AStream Stream of the xlsx file
@param AChart Chart instance, already created, but empty
@param AChartXMLFile Name of the xml file with the chart data, usually 'xl/charts/chart1.xml'
-------------------------------------------------------------------------------}
procedure TsSpreadOOXMLChartReader.ReadChartXML(AStream: TStream; AChart: TsChart;
AChartXML: String);
AChartXMLFile: String);
var
lReader: TsSpreadOOXMLReader;
xmlStream: TStream;
doc: TXMLDocument = nil;
node: TDOMNode;
nodeName: String;
relsFileName: String;
relsList: TXlsxRelationshipList;
begin
lReader := TsSpreadOOXMLReader(Reader);
// Read the rels file of the chart. The items go into the FRelsList.
relsFileName := ExtractFilePath(AChartXMLFile) + '_rels/' + ExtractFileName(AChartXMLFile) + '.rels';
relsList := TXlsxRelationshipList.Create;
try
lReader.ReadRels(AStream, relsFileName, relsList);
// Read the images mentioned in the rels file.
ReadChartImages(AStream, AChart, relsList);
finally
relsList.Free;
end;
// Read the xml file of the chart
xmlStream := lReader.CreateXMLStream;
try
if UnzipToStream(AStream, AChartXML, xmlStream) then
if UnzipToStream(AStream, AChartXMLFile, xmlStream) then
begin
lReader.ReadXMLStream(doc, xmlStream);
node := doc.DocumentElement.FirstChild; //FindNode('c:chart');
node := doc.DocumentElement.FirstChild;
while Assigned(node) do
begin
nodeName := node.NodeName;