pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

fpspreadsheet: Refactor xlsx reader for images to avoid excessive unzipping.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8336 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2022-07-04 16:13:07 +00:00
parent 702fd643f3
commit 37685f0c64
2 changed files with 217 additions and 123 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
components/fpspreadsheet/examples/other/images/demo_read_images.lpr
View File

@ -20,6 +20,7 @@ var
begin begin
WriteLn('Starting program "demo_read_images"...'); WriteLn('Starting program "demo_read_images"...');
WriteLn;
// Create a spreadsheet // Create a spreadsheet
workbook := TsWorkbook.Create; workbook := TsWorkbook.Create;
@ -54,6 +55,7 @@ begin
if embObj.FileName <> '' then if embObj.FileName <> '' then
embobj.Stream.SaveToFile(ExtractFileName(embobj.FileName)); embobj.Stream.SaveToFile(ExtractFileName(embobj.FileName));
end; end;
WriteLn;
end; end;
WriteLn('Finished.'); WriteLn('Finished.');

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

@ -53,7 +53,6 @@ type
private private
FDateMode: TDateMode; FDateMode: TDateMode;
FPointSeparatorSettings: TFormatSettings; FPointSeparatorSettings: TFormatSettings;
FFileNames: TStrings;
FSharedStrings: TStringList; FSharedStrings: TStringList;
FSheetList: TFPList; FSheetList: TFPList;
FFillList: TFPList; FFillList: TFPList;
@ -71,6 +70,7 @@ type
function CreateXMLStream: TStream; function CreateXMLStream: TStream;
function FindCommentsFileName(ANode: TDOMNode): String; function FindCommentsFileName(ANode: TDOMNode): String;
function MakeXLPath(AFileName: String): String; function MakeXLPath(AFileName: String): String;
protected
procedure ReadActiveSheet(ANode: TDOMNode; out ActiveSheetIndex: Integer); procedure ReadActiveSheet(ANode: TDOMNode; out ActiveSheetIndex: Integer);
procedure ReadBorders(ANode: TDOMNode); procedure ReadBorders(ANode: TDOMNode);
function ReadBorderStyle(ANode: TDOMNode; out ABorderStyle: TsCellBorderStyle): Boolean; function ReadBorderStyle(ANode: TDOMNode; out ABorderStyle: TsCellBorderStyle): Boolean;
@ -105,10 +105,9 @@ type
procedure ReadDifferentialFormat(ANode: TDOMNode); procedure ReadDifferentialFormat(ANode: TDOMNode);
procedure ReadDifferentialFormats(ANode: TDOMNode); procedure ReadDifferentialFormats(ANode: TDOMNode);
procedure ReadDimension(ANode: TDOMNode; AWorksheet: TsBasicWorksheet); procedure ReadDimension(ANode: TDOMNode; AWorksheet: TsBasicWorksheet);
procedure ReadDrawing(AStream: TStream; ARelsFile: String; ANode: TDOMNode; AWorksheet: TsBasicWorksheet); procedure ReadDrawing(ANode: TDOMNode; AWorksheet: TsBasicWorksheet);
procedure ReadDrawingRels(ANode: TDOMNode; ASheet: TsBasicWorksheet); procedure ReadDrawingRels(ANode: TDOMNode; ASheet: TsBasicWorksheet);
procedure ReadEmbeddedObjs(AStream: TStream); procedure ReadEmbeddedObjs(AStream: TStream);
function ReadFileNameFromRels(AStream: TStream; ARelsFile, ARelType, ARelID: String): String;
procedure ReadFileVersion(ANode: TDOMNode); procedure ReadFileVersion(ANode: TDOMNode);
procedure ReadFills(ANode: TDOMNode); procedure ReadFills(ANode: TDOMNode);
function ReadFont(ANode: TDOMNode): Integer; function ReadFont(ANode: TDOMNode): Integer;
@ -123,23 +122,21 @@ type
procedure ReadPageSetup(ANode: TDOMNode; AWorksheet: TsBasicWorksheet); procedure ReadPageSetup(ANode: TDOMNode; AWorksheet: TsBasicWorksheet);
procedure ReadPalette(ANode: TDOMNode); procedure ReadPalette(ANode: TDOMNode);
procedure ReadPrintOptions(ANode: TDOMNode; AWorksheet: TsBasicWorksheet); procedure ReadPrintOptions(ANode: TDOMNode; AWorksheet: TsBasicWorksheet);
procedure ReadRels(AStream: TStream; ARelsFile: String; ARelsList: TFPList);
procedure ReadRow(ANode: TDOMNode; AWorksheet: TsBasicWorksheet; var ARowIndex: Cardinal); procedure ReadRow(ANode: TDOMNode; AWorksheet: TsBasicWorksheet; var ARowIndex: Cardinal);
procedure ReadSharedStrings(ANode: TDOMNode); procedure ReadSharedStrings(ANode: TDOMNode);
procedure ReadSheetFormatPr(ANode: TDOMNode; AWorksheet: TsBasicWorksheet); procedure ReadSheetFormatPr(ANode: TDOMNode; AWorksheet: TsBasicWorksheet);
procedure ReadSheetList(ANode: TDOMNode); procedure ReadSheetList(ANode: TDOMNode);
procedure ReadSheetPr(ANode: TDOMNode; AWorksheet: TsBasicWorksheet); procedure ReadSheetPr(ANode: TDOMNode; AWorksheet: TsBasicWorksheet);
procedure ReadSheetProtection(ANode: TDOMNode; AWorksheet: TsBasicWorksheet); procedure ReadSheetProtection(ANode: TDOMNode; AWorksheet: TsBasicWorksheet);
procedure ReadSheetRelFileNames(AStream: TStream; AWorksheet: TsBasicWorksheet); procedure ReadSheetRels(AStream: TStream);
procedure ReadSheetRels(ANode: TDOMNode; AWorksheet: TsBasicWorksheet); procedure ReadSheetRels(AStream: TStream; ANode: TDOMNode; AWorksheet: TsBasicWorksheet);
procedure ReadSheetViews(ANode: TDOMNode; AWorksheet: TsBasicWorksheet); procedure ReadSheetViews(ANode: TDOMNode; AWorksheet: TsBasicWorksheet);
procedure ReadThemeColors(ANode: TDOMNode); procedure ReadThemeColors(ANode: TDOMNode);
procedure ReadThemeElements(ANode: TDOMNode); procedure ReadThemeElements(ANode: TDOMNode);
procedure ReadVmlDrawing(AStream: TStream; ARelsFile: String; ANode: TDOMNode; AWorksheet: TsBasicWorksheet); procedure ReadVmlDrawing(ANode: TDOMNode; AWorksheet: TsBasicWorksheet);
procedure ReadWorkbookProtection(ANode: TDOMNode); procedure ReadWorkbookProtection(ANode: TDOMNode);
procedure ReadWorksheet(ANode: TDOMNode; AWorksheet: TsBasicWorksheet); procedure ReadWorksheet(ANode: TDOMNode; AWorksheet: TsBasicWorksheet);
protected
procedure ListAllFileNames(AStream: TStream);
procedure ListFileNamesInDir(AList: TStrings; ADir: String);
protected protected
FFirstNumFormatIndexInFile: Integer; FFirstNumFormatIndexInFile: Integer;
procedure AddBuiltinNumFormats; override; procedure AddBuiltinNumFormats; override;
@ -422,14 +419,35 @@ type
Formula: String; Formula: String;
end; end;
TRelationship = class
RelID: String;
Target: String;
end;
TRelationshipList = class(TFPList)
private
function GetItem(AIndex: Integer): TRelationship;
procedure SetItem(AIndex: Integer; AValue: TRelationship);
public
destructor Destroy; override;
function Add(ARelID, 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 TSheetData = class
Name: String; Name: String;
ID: String; ID: String;
Hidden: Boolean; Hidden: Boolean;
Drawing_relID: String; SheetRels: TFPList;
Drawing_File: String; Drawing_File: String;
VmlDrawing_relID: String; DrawingRels: TRelationshipList;
VmlDrawing_File: String; VmlDrawing_File: String;
VmlDrawingRels: TRelationshipList;
constructor Create;
destructor Destroy; override;
end; end;
TSharedObjData = class TSharedObjData = class
@ -671,6 +689,82 @@ begin
end; end;
destructor TRelationshipList.Destroy;
begin
Clear;
inherited;
end;
function TRelationshipList.Add(ARelID, ATarget: String): TRelationship;
var
rel: TRelationship;
idx: Integer;
begin
rel := TRelationship.Create;
rel.RelID := ARelID;
rel.Target := ATarget;
idx := inherited Add(rel);
Result := Items[idx];
end;
procedure TRelationshipList.Clear;
var
j: Integer;
begin
for j := 0 to Count-1 do Items[j].Free;
inherited;
end;
procedure TRelationshipList.Delete(AIndex: Integer);
begin
Items[AIndex].Free;
inherited;
end;
function TRelationshipList.FindTarget(ARelID: String): String;
var
i: Integer;
rel: TRelationship;
begin
for i := 0 to Count-1 do
begin
rel := Items[i];
if (rel.RelID = ARelID) then
begin
Result := rel.Target;
exit;
end;
end;
Result := '';
end;
function TRelationshipList.GetItem(AIndex: Integer): TRelationship;
begin
Result := TRelationship(inherited Items[AIndex]);
end;
procedure TRelationshipList.SetItem(AIndex: Integer; AValue: TRelationship);
begin
inherited Items[AIndex] := AValue;
end;
constructor TSheetData.Create;
begin
inherited;
SheetRels := TRelationshipList.Create;
DrawingRels := TRelationshipList.Create;
VmlDrawingRels := TRelationshipList.Create;
end;
destructor TSheetData.Destroy;
begin
SheetRels.Free;
DrawingRels.Free;
VmlDrawingRels.Free;
inherited;
end;
{------------------------------------------------------------------------------} {------------------------------------------------------------------------------}
{ TsSpreadOOXMLReader } { TsSpreadOOXMLReader }
{------------------------------------------------------------------------------} {------------------------------------------------------------------------------}
@ -680,7 +774,6 @@ begin
inherited Create(AWorkbook); inherited Create(AWorkbook);
FDateMode := XlsxSettings.DateMode; FDateMode := XlsxSettings.DateMode;
FFileNames := TStringList.Create;
FSharedStrings := TStringList.Create; FSharedStrings := TStringList.Create;
FSheetList := TFPList.Create; FSheetList := TFPList.Create;
FFillList := TFPList.Create; FFillList := TFPList.Create;
@ -743,7 +836,6 @@ begin
// FCellFormatList, FNumFormatList and FFontList are destroyed by ancestor // FCellFormatList, FNumFormatList and FFontList are destroyed by ancestor
FPalette.Free; FPalette.Free;
FFileNames.Free;
inherited Destroy; inherited Destroy;
end; end;
@ -832,7 +924,7 @@ begin
s := GetAttrValue(ANode, 'Type'); s := GetAttrValue(ANode, 'Type');
if s = SCHEMAS_COMMENTS then if s = SCHEMAS_COMMENTS then
begin begin
Result := ExtractFileName(GetAttrValue(ANode, 'Target')); Result := ExtractFileName(GetAttrValue(ANode, 'Target')); // ??? ExtractFileName here ????
exit; exit;
end; end;
ANode := ANode.NextSibling; ANode := ANode.NextSibling;
@ -840,36 +932,6 @@ begin
Result := ''; Result := '';
end; end;
procedure TsSpreadOOXMLReader.ListAllFileNames(AStream: TStream);
var
unzip: TStreamUnzipper;
fn: String;
i: Integer;
begin
FFileNames.Clear;
unzip := TStreamUnzipper.Create(AStream);
try
unzip.Examine;
for i := 0 to unzip.Entries.Count-1 do begin
fn := unzip.Entries.Entries[i].ArchiveFileName;
FFileNames.Add(fn);
end;
finally
unzip.Free;
end;
end;
procedure TsSpreadOOXMLReader.ListFileNamesInDir(AList: TStrings; ADir: String);
var
i: Integer;
fn: String;
begin
AList.Clear;
for fn in FFileNames do
if pos(ADir, fn) = 1 then
AList.Add(fn);
end;
{ The rels files store relative file paths (e.g. ../media/image1.png). { The rels files store relative file paths (e.g. ../media/image1.png).
This function makes sure that the file path begins with 'xl'. This filename This function makes sure that the file path begins with 'xl'. This filename
can be used by the unzipper to extract the file from the xlsx (zip) archive. } can be used by the unzipper to extract the file from the xlsx (zip) archive. }
@ -2494,11 +2556,9 @@ begin
end; end;
{ Reads the parameters of the embedded images defined as children of the { Reads the parameters of the embedded images defined as children of the
specified node which is in a drawingX.xml file. specified node which is in a drawingX.xml file. }
ARelsFile is the associated rels file, drawingX.xml.rels in the _rels folder, procedure TsSpreadOOXMLReader.ReadDrawing(ANode: TDOMNode;
and contains the media file names of the images. } AWorksheet: TsBasicWorksheet);
procedure TsSpreadOOXMLReader.ReadDrawing(AStream: TStream; ARelsFile: String;
ANode: TDOMNode; AWorksheet: TsBasicWorksheet);
var var
node, child, child2: TDOMNode; node, child, child2: TDOMNode;
nodeName: String = ''; nodeName: String = '';
@ -2506,10 +2566,13 @@ var
fromCol, fromRow, toCol, toRow: Integer; fromCol, fromRow, toCol, toRow: Integer;
fromColOffs, fromRowOffs, toColOffs, toRowOffs: Double; fromColOffs, fromRowOffs, toColOffs, toRowOffs: Double;
data: TEmbeddedObjData; data: TEmbeddedObjData;
sheetData: TSheetData;
begin begin
if ANode = nil then if ANode = nil then
exit; exit;
sheetData := TSheetData(FSheetList[TsWorksheet(AWorksheet).Index]);
ANode := ANode.FirstChild; ANode := ANode.FirstChild;
while Assigned(ANode) do while Assigned(ANode) do
begin begin
@ -2600,7 +2663,7 @@ begin
data.ToRowOffs := toRowOffs; data.ToRowOffs := toRowOffs;
data.RelId := rId; data.RelId := rId;
data.FileName := fileName; data.FileName := fileName;
data.MediaName := ReadFileNameFromRels(AStream, ARelsFile, SCHEMAS_IMAGE, rID); data.MediaName := MakeXLPath(sheetData.DrawingRels.FindTarget(rID));
data.ImgIndex := -1; data.ImgIndex := -1;
data.Worksheet := AWorksheet; data.Worksheet := AWorksheet;
data.IsHeaderFooter := false; data.IsHeaderFooter := false;
@ -2672,7 +2735,7 @@ begin
sheetData := TSheetData(FSheetList[i]); sheetData := TSheetData(FSheetList[i]);
sheet := (FWorkbook as TsWorkbook).GetWorksheetByIndex(i); sheet := (FWorkbook as TsWorkbook).GetWorksheetByIndex(i);
// Read the drawings.xml file // Read the drawing<n>.xml file
fn := sheetData.Drawing_File; fn := sheetData.Drawing_File;
if fn <> '' then if fn <> '' then
begin begin
@ -2683,13 +2746,13 @@ begin
raise EFPSpreadsheetReader.CreateFmt(rsDefectiveInternalFileStructure, ['xlsx']); raise EFPSpreadsheetReader.CreateFmt(rsDefectiveInternalFileStructure, ['xlsx']);
ReadXMLStream(doc, XMLStream); ReadXMLStream(doc, XMLStream);
relsFn := RelsFileFor(fn); relsFn := RelsFileFor(fn);
ReadDrawing(AStream, relsFn, doc.DocumentElement, sheet); ReadDrawing(doc.DocumentElement, sheet);
finally finally
XMLStream.Free; XMLStream.Free;
end; end;
end; end;
// Now repeat the same with the vmlDrawings file // Now repeat the same with the vmlDrawing<n> file
fn := sheetData.VmlDrawing_File; fn := sheetData.VmlDrawing_File;
if fn <> '' then if fn <> '' then
begin begin
@ -2700,7 +2763,7 @@ begin
raise EFPSpreadsheetReader.CreateFmt(rsDefectiveInternalFileStructure, ['xlsx']); raise EFPSpreadsheetReader.CreateFmt(rsDefectiveInternalFileStructure, ['xlsx']);
ReadXMLStream(doc, XMLStream); ReadXMLStream(doc, XMLStream);
relsFn := RelsFileFor(fn); relsFn := RelsFileFor(fn);
ReadVmlDrawing(AStream, relsFn, doc.DocumentElement, sheet); ReadVmlDrawing(doc.DocumentElement, sheet);
finally finally
XMLStream.Free; XMLStream.Free;
end; end;
@ -2766,44 +2829,6 @@ begin
end; end;
end; end;
function TsSpreadOOXMLReader.ReadFileNameFromRels(AStream: TStream;
ARelsFile, ARelType, ARelID: String): String;
var
XMLStream: TStream;
doc: TXMLDocument;
node: TDOMNode;
relID: String;
relType: String;
relTarget: String;
begin
Result := '';
if ARelID = '' then
exit;
doc := nil;
XMLStream := CreateXMLStream;
try
if not UnzipToStream(AStream, ARelsFile, XMLStream) then
raise EFPSpreadsheetReader.CreateFmt(rsDefectiveInternalFileStructure, ['xlsx']);
ReadXMLStream(doc, XMLStream);
node := doc.DocumentElement.FindNode('Relationship');
while Assigned(node) do begin
relType := GetAttrValue(node, 'Type');
relID := GetAttrValue(node, 'Id');
if (relType = ARelType) and (relID = ARelID) then
begin
relTarget := GetAttrValue(node, 'Target');
Result := MakeXLPath(relTarget);
exit;
end;
node := node.NextSibling;
end;
finally
XMLStream.Free;
doc.Free;
end;
end;
procedure TsSpreadOOXMLReader.ReadFileVersion(ANode: TDOMNode); procedure TsSpreadOOXMLReader.ReadFileVersion(ANode: TDOMNode);
begin begin
FWrittenByFPS := GetAttrValue(ANode, 'appName') = 'fpspreadsheet'; FWrittenByFPS := GetAttrValue(ANode, 'appName') = 'fpspreadsheet';
@ -3481,15 +3506,55 @@ var
begin begin
if ANode = nil then if ANode = nil then
exit; exit;
s := Lowercase(GetAttrValue(ANode, 'headings'));
if StrIsTrue(s) then //(s = '1') or (s = 'true') then s := GetAttrValue(ANode, 'headings');
if StrIsTrue(s) then
with sheet.PageLayout do Options := Options + [poPrintHeaders]; with sheet.PageLayout do Options := Options + [poPrintHeaders];
s := Lowercase(GetAttrValue(ANode, 'gridLines')); s := GetAttrValue(ANode, 'gridLines');
if StrIsTrue(s) then //(s = '1') or (s = 'true') then if StrIsTrue(s) then
with sheet.PageLayout do Options := Options + [poPrintGridLines]; with sheet.PageLayout do Options := Options + [poPrintGridLines];
end; end;
procedure TsSpreadOOXMLReader.ReadRels(AStream: TStream; ARelsFile: String;
ARelsList: TFPList);
var
XMLStream: TStream;
doc: TXMLDocument;
node: TDOMNode;
relID, relTarget: String;
nodeName: String;
begin
// Avoid adding items again and again to the same list if this function is
// called multiple times.
if ARelsList.Count > 0 then
exit;
doc := nil;
XMLStream := CreateXMLStream;
try
// Unzip the requested file or exit if the file does not exist.
if not UnzipToStream(AStream, ARelsFile, XMLStream) then
exit;
ReadXMLStream(doc, XMLStream);
node := doc.DocumentElement.FindNode('Relationship');
while Assigned(node) do begin
nodeName := node.NodeName;
if nodeName = 'Relationship' then
begin
relID := GetAttrValue(node, 'Id');
relTarget := GetAttrValue(node, 'Target');
if (relID <> '') and (relTarget <> '') then
(ARelsList as TRelationshipList).Add(relID, relTarget);
end;
node := node.NextSibling;
end;
finally
XMLStream.Free;
doc.Free;
end;
end;
procedure TsSpreadOOXMLReader.ReadRow(ANode: TDOMNode; procedure TsSpreadOOXMLReader.ReadRow(ANode: TDOMNode;
AWorksheet: TsBasicWorksheet; var ARowIndex: Cardinal); AWorksheet: TsBasicWorksheet; var ARowIndex: Cardinal);
var var
@ -3660,8 +3725,9 @@ begin
begin begin
sheetData := TSheetData.Create; sheetData := TSheetData.Create;
sheetData.Name := GetAttrValue(node, 'name'); sheetData.Name := GetAttrValue(node, 'name');
sheetData.ID := GetAttrvalue(node, 'sheetID'); sheetData.ID := GetAttrvalue(node, 'sheetId');
sheetData.Hidden := GetAttrValue(node, 'state') = 'hidden'; sheetData.Hidden := GetAttrValue(node, 'state') = 'hidden';
// Add the sheetdata to the SheetList.
FSheetList.Add(sheetData); FSheetList.Add(sheetData);
// Create worksheet - needed because of 3d references // Create worksheet - needed because of 3d references
(FWorkbook as TsWorkbook).AddWorksheet(sheetData.Name, true); (FWorkbook as TsWorkbook).AddWorksheet(sheetData.Name, true);
@ -3848,41 +3914,69 @@ begin
end; end;
end; end;
// Get the names of the files associated with the specified worksheet by means { Store the contents of the worksheets/_rels/sheet<n>.xml.rels files in the
// of Relationship IDs. SheetData lists.
procedure TsSpreadOOXMLReader.ReadSheetRelFileNames(AStream: TStream; They contain the names of the drawing, vmlDrawing etc files needed
AWorksheet: TsBasicWorksheet); at several places.}
procedure TsSpreadOOXMLReader.ReadSheetRels(AStream: TStream);
var var
i: Integer;
sheetData: TSheetData; sheetData: TSheetData;
sheetIndex: Integer;
relsFile: String; relsFile: String;
begin begin
sheetIndex := TsWorksheet(AWorksheet).Index; for i := 0 to FSheetList.Count-1 do
sheetData := TSheetData(FSheetList[sheetIndex]); begin
relsFile := OOXML_PATH_XL_WORKSHEETS_RELS + 'sheet' + IntToStr(sheetIndex+1) + '.xml.rels'; sheetData := TSheetData(FSheetList[i]);
sheetData.Drawing_File := ReadFileNameFromRels(AStream, relsFile, SCHEMAS_DRAWING, sheetData.Drawing_relID); relsFile := OOXML_PATH_XL_WORKSHEETS + '_rels/sheet' + sheetData.ID + '.xml.rels';
sheetData.VMLDrawing_File := ReadFileNameFromRels(AStream, relsFile, SCHEMAS_VMLDRAWING, sheetData.VMLDrawing_relID); ReadRels(AStream, relsfile, sheetData.SheetRels);
end;
end; end;
{ Extract the Relationship-IDs of the files related to the specified worksheet } { Extract the rels files related to the specified worksheet
procedure TsSpreadOOXMLReader.ReadSheetRels(ANode: TDOMNode; (drawing<n>.xml.rel, vmlDrawing<n>.xml.rel) }
procedure TsSpreadOOXMLReader.ReadSheetRels(AStream: TStream; ANode: TDOMNode;
AWorksheet: TsBasicWorksheet); AWorksheet: TsBasicWorksheet);
var var
nodeName: string; nodeName: string;
sheetData: TSheetData; sheetData: TSheetData;
sheetIndex: Integer; sheetIndex: Integer;
relID: String;
sheetRelsFile: String;
rels: TRelationshipList;
j: Integer;
begin begin
sheetIndex := TsWorksheet(AWorksheet).Index; sheetIndex := TsWorksheet(AWorksheet).Index;
sheetData := TSheetData(FSheetList[sheetIndex]); sheetData := TSheetData(FSheetList[sheetIndex]);
sheetRelsFile := OOXML_PATH_XL_WORKSHEETS_RELS + 'sheet' + sheetData.ID + '.xml.rels';
ANode := ANode.FirstChild; ANode := ANode.FirstChild;
while Assigned(ANode) do while Assigned(ANode) do
begin begin
nodeName := ANode.NodeName; nodeName := ANode.NodeName;
if nodeName = 'drawing' then if nodeName = 'drawing' then
sheetData.Drawing_relID := GetAttrValue(ANode, 'r:id') begin
else if nodeName = 'legacyDrawingHF' then rels := TRelationshipList.Create;
sheetData.VMLDrawing_relID := GetAttrValue(ANode, 'r:id'); try
ReadRels(AStream, sheetRelsFile, rels);
relID := GetAttrValue(ANode, 'r:id');
sheetData.Drawing_File := MakeXLPath(rels.FindTarget(relID));
ReadRels(AStream, RelsFileFor(sheetData.Drawing_File), sheetData.DrawingRels);
finally
rels.Free;
end;
end else
if nodeName = 'legacyDrawingHF' then
begin
rels := TRelationshipList.Create;
try
ReadRels(AStream, sheetRelsFile, rels);
relID := GetAttrValue(ANode, 'r:id');
sheetData.VMLDrawing_File := MakeXLPath(rels.FindTarget(relID));
ReadRels(AStream, RelsFileFor(sheetData.VMLDrawing_File), sheetData.VmlDrawingRels);
finally
rels.Free;
end;
end;
ANode := ANode.NextSibling; ANode := ANode.NextSibling;
end; end;
end; end;
@ -4037,11 +4131,9 @@ begin
end; end;
{ Reads the parameters of the header/footer images defined as children of the { Reads the parameters of the header/footer images defined as children of the
specified node which is in a vmlDrawingX.xml file. specified node which is in a vmlDrawingX.xml file. }
ARelsFile is the associated rels file, vmlDrawingX.xml.rels in the _rels folder, procedure TsSpreadOOXMLReader.ReadVmlDrawing(ANode: TDOMNode;
and contains the media file names of the images. } AWorksheet: TsBasicWorksheet);
procedure TsSpreadOOXMLReader.ReadVmlDrawing(AStream: TStream; ARelsFile: String;
ANode: TDOMNode; AWorksheet: TsBasicWorksheet);
var var
nodeName: String; nodeName: String;
node: TDOMNode; node: TDOMNode;
@ -4049,7 +4141,10 @@ var
title: String; title: String;
data: TEmbeddedObjData; data: TEmbeddedObjData;
id: String; id: String;
sheetData: TSheetData;
begin begin
sheetData := TSheetData(FSheetList[TsWorksheet(AWorksheet).Index]);
ANode := ANode.FirstChild; ANode := ANode.FirstChild;
while Assigned(ANode) do while Assigned(ANode) do
begin begin
@ -4084,7 +4179,7 @@ begin
data.ToRowOffs := 0.0; data.ToRowOffs := 0.0;
data.RelId := relId; data.RelId := relId;
data.FileName := title; data.FileName := title;
data.MediaName := ReadFileNameFromRels(AStream, ARelsFile, SCHEMAS_IMAGE, relID); data.MediaName := MakeXLPath(sheetData.VMLDrawingRels.FindTarget(relID));
data.ImgIndex := -1; data.ImgIndex := -1;
data.Worksheet := AWorksheet; data.Worksheet := AWorksheet;
data.IsHeaderFooter := true; data.IsHeaderFooter := true;
@ -4215,9 +4310,6 @@ begin
Doc := nil; Doc := nil;
try try
// Get all filenames contained in the zipped xlsx file.
ListAllFileNames(AStream);
// Retrieve theme colors // Retrieve theme colors
XMLStream := CreateXMLStream; XMLStream := CreateXMLStream;
try try
@ -4241,6 +4333,7 @@ begin
ReadDateMode(Doc_FindNode('workbookPr')); ReadDateMode(Doc_FindNode('workbookPr'));
ReadWorkbookProtection(Doc_FindNode('workbookProtection')); ReadWorkbookProtection(Doc_FindNode('workbookProtection'));
ReadSheetList(Doc_FindNode('sheets')); ReadSheetList(Doc_FindNode('sheets'));
ReadSheetRels(AStream);
//ReadDefinedNames(Doc.DocumentElement.FindNode('definedNames')); -- don't read here because sheets do not yet exist //ReadDefinedNames(Doc.DocumentElement.FindNode('definedNames')); -- don't read here because sheets do not yet exist
ReadActiveSheet(Doc_FindNode('bookViews'), actSheetIndex); ReadActiveSheet(Doc_FindNode('bookViews'), actSheetIndex);
FreeAndNil(Doc); FreeAndNil(Doc);
@ -4326,8 +4419,7 @@ begin
ReadColRowBreaks(Doc_FindNode('rowBreaks'), FWorksheet); ReadColRowBreaks(Doc_FindNode('rowBreaks'), FWorksheet);
ReadColRowBreaks(Doc_FindNode('colBreaks'), FWorksheet); ReadColRowBreaks(Doc_FindNode('colBreaks'), FWorksheet);
ReadHeaderFooter(Doc_FindNode('headerFooter'), FWorksheet); ReadHeaderFooter(Doc_FindNode('headerFooter'), FWorksheet);
ReadSheetRels(Doc.DocumentElement, FWorksheet); ReadSheetRels(AStream, Doc.DocumentElement, FWorksheet);
ReadSheetRelFileNames(AStream, FWorksheet);
FreeAndNil(Doc); FreeAndNil(Doc);