From 66201c6caabea3a31caed4b5a5d44139a743e254 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Wed, 16 Mar 2016 12:24:47 +0000 Subject: [PATCH] fpspreadsheet: Add reading of ods sheet images. Update TsSpreadsheetInspector. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4559 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../examples/visual/shared/shyperlinkform.pas | 4 +- components/fpspreadsheet/fpsimages.pas | 5 +- components/fpspreadsheet/fpsopendocument.pas | 90 ++++++++++++++++++- components/fpspreadsheet/fpspreadsheet.pas | 82 +++++++++++++---- .../fpspreadsheet/fpspreadsheetctrls.pas | 88 +++++++++++++++--- components/fpspreadsheet/fpsxmlcommon.pas | 27 +++++- 6 files changed, 263 insertions(+), 33 deletions(-) diff --git a/components/fpspreadsheet/examples/visual/shared/shyperlinkform.pas b/components/fpspreadsheet/examples/visual/shared/shyperlinkform.pas index e60880b6f..30ca3fd62 100644 --- a/components/fpspreadsheet/examples/visual/shared/shyperlinkform.pas +++ b/components/fpspreadsheet/examples/visual/shared/shyperlinkform.pas @@ -5,7 +5,7 @@ unit sHyperlinkForm; interface uses - Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ButtonPanel, + Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ButtonPanel, ExtCtrls, Buttons, StdCtrls, ComCtrls, fpsTypes, fpspreadsheet; @@ -104,7 +104,7 @@ implementation {$R *.lfm} uses - URIParser, + URIParser, LazFileUtils, fpsUtils; const diff --git a/components/fpspreadsheet/fpsimages.pas b/components/fpspreadsheet/fpsimages.pas index 93f8ea0b9..8bfe762c7 100644 --- a/components/fpspreadsheet/fpsimages.pas +++ b/components/fpspreadsheet/fpsimages.pas @@ -51,7 +51,7 @@ type public destructor Destroy; override; function LoadFromFile(const AFileName: String): Boolean; - function LoadFromStream(AStream: TStream): Boolean; + function LoadFromStream(AStream: TStream; AName: String): Boolean; property FileName: String read FFileName; property ImageType: TsImagetype read FImageType; property ImageWidth: Double read FWidth; @@ -888,12 +888,13 @@ begin end; end; -function TsEmbeddedObj.LoadFromStream(AStream: TStream): Boolean; +function TsEmbeddedObj.LoadFromStream(AStream: TStream; AName: String): Boolean; begin FreeAndNil(FStream); FStream := TMemoryStream.Create; FStream.CopyFrom(AStream, AStream.Size); Result := CheckStream(itUnknown); + if Result then FFileName := AName; end; diff --git a/components/fpspreadsheet/fpsopendocument.pas b/components/fpspreadsheet/fpsopendocument.pas index 8d3cf51d7..111bd05e2 100755 --- a/components/fpspreadsheet/fpsopendocument.pas +++ b/components/fpspreadsheet/fpsopendocument.pas @@ -16,7 +16,7 @@ Specifications obtained from: http://docs.oasis-open.org/office/v1.1/OS/OpenDocument-v1.1.pdf -AUTHORS: Felipe Monteiro de Carvalho / Jose Luis Jurado Rincon +AUTHORS: Felipe Monteiro de Carvalho / Jose Luis Jurado Rincon / Werner Pamler } @@ -120,9 +120,11 @@ type var AFontSize: Double; var AFontStyle: TsHeaderFooterFontStyles; var AFontColor: TsColor); function ReadHeaderFooterText(ANode: TDOMNode): String; + procedure ReadPictures(AStream: TStream); procedure ReadPrintRanges(ATableNode: TDOMNode; ASheet: TsWorksheet); procedure ReadRowsAndCells(ATableNode: TDOMNode); procedure ReadRowStyle(AStyleNode: TDOMNode); + procedure ReadShapes(ATableNode: TDOMNode); procedure ReadTableStyle(AStyleNode: TDOMNode); protected @@ -2244,6 +2246,9 @@ begin Doc := nil; try + // Extract the embedded pictures + ReadPictures(AStream); + // process the styles.xml file XMLStream := CreateXMLStream; try @@ -2301,6 +2306,8 @@ begin end; FWorkSheet := FWorkbook.AddWorksheet(GetAttrValue(TableNode, 'table:name'), true); tablestyleName := GetAttrValue(TableNode, 'table:style-name'); + // Collect embedded images + ReadShapes(TableNode); // Collect column styles used ReadColumns(TableNode); // Process each row inside the sheet and process each cell of the row @@ -3059,6 +3066,31 @@ begin end; end; +procedure TsSpreadOpenDocReader.ReadPictures(AStream: TStream); +var + memstream: TMemoryStream; + unzip: TStreamUnzipper; + fn: String; + i: Integer; +begin + unzip := TStreamUnzipper.Create(AStream); + try + unzip.Examine; + for i := 0 to unzip.Entries.Count-1 do begin + fn := unzip.Entries.Entries[i].ArchiveFileName; + if ExtractFileDir(fn) = 'Pictures' then begin + memStream := TMemoryStream.Create; + unzip.UnzipFile(fn, memStream); + memstream.Position := 0; + FWorkbook.AddEmbeddedObj(memstream, ExtractFileName(fn)); + memStream.Free; + end; + end; + finally + unzip.Free; + end; +end; + procedure TsSpreadOpenDocReader.ReadPrintRanges(ATableNode: TDOMNode; ASheet: TsWorksheet); var @@ -3467,6 +3499,62 @@ begin end; end; +{ '' + + '' + + '' + + '' + + '', [ +} + +procedure TsSpreadOpenDocReader.ReadShapes(ATableNode: TDOMNode); +var + shapesNode, shapeNode, childShapeNode: TDOMNode; + nodeName: String; + r, c: Cardinal; + w, h, x, y: Double; + dr, dc, sx, sy: Double; + idx: Integer; + href: String; +begin + shapesNode := ATableNode.FirstChild; + while Assigned(shapesNode) do + begin + nodeName := shapesNode.NodeName; + if nodeName = 'table:shapes' then + begin + shapeNode := shapesNode.FirstChild; + while Assigned(shapeNode) do + begin + nodeName := shapeNode.NodeName; + if nodeName = 'draw:frame' then + begin + x := PtsToMM(HTMLLengthStrToPts(GetAttrValue(shapeNode, 'svg:x'))); + y := PtsToMM(HTMLLengthStrToPts(GetAttrValue(shapeNode, 'svg:y'))); + w := PtsToMM(HTMLLengthStrToPts(GetAttrValue(shapeNode, 'svg:width'))); + h := PtsToMM(HTMLLengthStrToPts(GetAttrValue(shapeNode, 'svg:height'))); + childShapeNode := shapeNode.FirstChild; + while Assigned(childShapeNode) do + begin + href := GetAttrValue(childShapeNode, 'xlink:href'); + if href <> '' then + begin + idx := FWorkbook.FindEmbeddedObj(ExtractFileName(href)); + FWorksheet.CalcImageCell(idx, x, y, w, h, r, c, dr, dc, sx, sy); + FWorksheet.WriteImage(r, c, idx, dr, dc, sx, sy); + end; + childShapeNode := childShapeNode.NextSibling; + end; + end; + shapeNode := shapeNode.NextSibling; + end; + end; + shapesNode := shapesNode.NextSibling; + end; +end; + procedure TsSpreadOpenDocReader.ReadStyles(AStylesNode: TDOMNode); var styleNode: TDOMNode; diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas index 01cc4501e..b9f18947a 100755 --- a/components/fpspreadsheet/fpspreadsheet.pas +++ b/components/fpspreadsheet/fpspreadsheet.pas @@ -494,6 +494,8 @@ type out ARow1, ACol1, ARow2, ACol2: Cardinal; out ARowOffs1, AColOffs1, ARowOffs2, AColOffs2: Double; out x, y, AWidth, AHeight: Double); + procedure CalcImageCell(AIndex: Integer; x, y, AWidth, AHeight: Double; + out ARow, ACol: Cardinal; out ARowOffs, AColOffs, AScaleX, AScaleY: Double); function GetImage(AIndex: Integer): TsImage; function GetImageCount: Integer; procedure RemoveAllImages; @@ -504,6 +506,9 @@ type function WriteImage(ARow, ACol: Cardinal; AStream: TStream; AOffsetX: Double = 0.0; AOffsetY: Double = 0.0; AScaleX: Double = 1.0; AScaleY: Double = 1.0): Integer; overload; + function WriteImage(ARow, ACol: Cardinal; AImageIndex: Integer; + AOffsetX: Double = 0.0; AOffsetY: Double = 0.0; + AScaleX: Double = 1.0; AScaleY: Double = 1.0): Integer; overload; // Notification of changed cells procedure ChangedCell(ARow, ACol: Cardinal); @@ -769,7 +774,8 @@ type { Embedded objects } function AddEmbeddedObj(const AFileName: String): Integer; overload; - function AddEmbeddedObj(AStream: TStream): Integer; overload; + function AddEmbeddedObj(AStream: TStream; + const AName: String = ''): Integer; overload; function FindEmbeddedObj(const AFileName: String): Integer; function GetEmbeddedObj(AIndex: Integer): TsEmbeddedObj; function GetEmbeddedObjCount: Integer; @@ -3327,6 +3333,42 @@ begin Result := FImages.Count; end; +procedure TsWorksheet.CalcImageCell(AIndex: Integer; x, y, AWidth, AHeight: Double; + out ARow, ACol: Cardinal; out ARowOffs, AColOffs, AScaleX, AScaleY: Double); +var + colW, rowH, sum: Double; + factor: Double; + embobj: TsEmbeddedObj; +begin + factor := FWorkbook.GetDefaultFont.Size/2; // Width of "0" character in pts + ACol := 0; + sum := 0; + repeat + colW := ptsToMM(GetColWidth(ACol) * factor); + sum := sum + colW; + inc(ACol); + until sum > x; + sum := sum - colW; + AColOffs := x - sum; + dec(ACol); + + factor := FWorkbook.GetDefaultFont.Size; // Height of line in pts + ARow := 0; + sum := 0; + repeat + rowH := ptsToMM(CalcAutoRowHeight(ARow) * factor); // row height in mm + sum := sum + rowH; + inc(ARow); + until sum > y; + sum := sum - rowH; + ARowOffs := y - sum; + dec(ARow); + + embObj := FWorkbook.GetEmbeddedObj(AIndex); + AScaleX := AWidth / embObj.ImageWidth; + AScaleY := AHeight / embObj.ImageHeight; +end; + {@@ ---------------------------------------------------------------------------- Calculates image extent @@ -3435,7 +3477,6 @@ function TsWorksheet.WriteImage(ARow, ACol: Cardinal; AFileName: String; AOffsetX: Double = 0.0; AOffsetY: Double = 0.0; AScaleX: Double = 1.0; AScaleY: Double = 1.0): Integer; var - img: PsImage; idx: Integer; begin // Does the image already exist? @@ -3448,10 +3489,7 @@ begin exit; // Everything ok here... - New(img); - InitImageRecord(img^, ARow, ACol, AOffsetX, AOffsetY, AScaleX, AScaleY); - img^.Index := idx; - Result := FImages.Add(img); + Result := WriteImage(ARow, ACol, idx, AOffsetX, AOffsetY, AScaleX, AScaleY); end; {@@ ---------------------------------------------------------------------------- @@ -3474,7 +3512,6 @@ function TsWorksheet.WriteImage(ARow, ACol: Cardinal; AStream: TStream; AOffsetX: Double = 0.0; AOffsetY: Double = 0.0; AScaleX: Double = 1.0; AScaleY: Double = 1.0): Integer; var - img: PsImage; idx: Integer; begin // Copy the stream to a new item in embedded object list. @@ -3484,12 +3521,20 @@ begin exit; // Everything ok here... - New(img); - InitImageRecord(img^, ARow, ACol, AOffsetX, AOffsetY, AScaleX, AScaleY); - img^.Index := idx; - Result := FImages.Add(img); + Result := WriteImage(ARow, ACol, idx, AOffsetX, AOffsetY, AScaleX, AScaleY); end; +function TsWorksheet.WriteImage(ARow, ACol: Cardinal; AImageIndex: integer; + AOffsetX: Double = 0.0; AOffsetY: Double = 0.0; + AScaleX: Double = 1.0; AScaleY: Double = 1.0): Integer; +var + img: PsImage; +begin + New(img); + InitImageRecord(img^, ARow, ACol, AOffsetX, AOffsetY, AScaleX, AScaleY); + img^.Index := AImageIndex; + Result := FImages.Add(img); +end; {@@ ---------------------------------------------------------------------------- Removes an image from the internal image list. The image is identified by its index. @@ -8397,10 +8442,8 @@ begin end; {@@ ---------------------------------------------------------------------------- - Creates a new stream with the specified name, adds it to the internal list - and returns its index. - Embedded streams are used to store embedded images. AFileName is the - filename of the image. The image will be loaded to the stream later. + Creates a new "embedded" stream and load the specified file. + Returns the index of the embedded file item. -------------------------------------------------------------------------------} function TsWorkbook.AddEmbeddedObj(const AFileName: String): Integer; var @@ -8425,13 +8468,18 @@ begin end; end; -function TsWorkbook.AddEmbeddedObj(AStream: TStream): Integer; +{@@ ---------------------------------------------------------------------------- + Creates a new "embedded" stream and copies the specified stream to it. + Returns the index of the embedded object. +-------------------------------------------------------------------------------} +function TsWorkbook.AddEmbeddedObj(AStream: TStream; + const AName: String = ''): Integer; var obj: TsEmbeddedObj = nil; w, h: Double; begin obj := TsEmbeddedObj.Create; - if obj.LoadFromStream(AStream) then + if obj.LoadFromStream(AStream, AName) then Result := FEmbeddedObjList.Add(obj) else begin AddErrorMsg(rsImageFormatNotSupported); diff --git a/components/fpspreadsheet/fpspreadsheetctrls.pas b/components/fpspreadsheet/fpspreadsheetctrls.pas index 8d85ecaa9..2e0b65b9b 100644 --- a/components/fpspreadsheet/fpspreadsheetctrls.pas +++ b/components/fpspreadsheet/fpspreadsheetctrls.pas @@ -427,7 +427,8 @@ type TsInspectorMode = (imWorkbook, imWorksheet, imCellValue, imCellProperties); {@@ Inspector expanded nodes } - TsInspectorExpandedNode = (ienFormatSettings, ienPageLayout); + TsInspectorExpandedNode = (ienFormatSettings, ienPageLayout, ienFonts, ienFormats, + ienEmbeddedObj, ienImages); TsInspectorExpandedNodes = set of TsInspectorExpandedNode; {@@ TsSpreadsheetInspector displays all properties of a workbook, worksheet, @@ -472,7 +473,8 @@ type property DisplayOptions default [doColumnTitles, doAutoColResize]; {@@ Displays subproperties } property ExpandedNodes: TsInspectorExpandedNodes - read FExpanded write SetExpanded default [ienFormatSettings, ienPageLayout]; + read FExpanded write SetExpanded + default [ienFormatSettings, ienPageLayout, ienFonts, ienFormats, ienEmbeddedObj, ienImages]; {@@ inherited from TValueListEditor. Turns of the fixed column by default} property FixedCols default 0; {@@ inherited from TStringGrid, but not published in TValueListEditor. } @@ -492,8 +494,8 @@ implementation uses Types, Math, StrUtils, TypInfo, LCLType, LCLIntf, LCLProc, Dialogs, Forms, Clipbrd, - fpsStrings, fpsRegFileFormats, fpsUtils, fpsNumFormat, fpsHTMLUtils, - fpsCSV; + fpsStrings, fpsRegFileFormats, fpsUtils, fpsNumFormat, fpsImages, + fpsHTMLUtils, fpsCSV; var cfBiff8Format: Integer = 0; @@ -2717,7 +2719,8 @@ begin inherited Create(AOwner); DisplayOptions := DisplayOptions - [doKeyColFixed]; FixedCols := 0; - FExpanded := [ienFormatSettings, ienPageLayout]; + FExpanded := [ienFormatSettings, ienPageLayout, ienFonts, ienFormats, + ienEmbeddedObj, ienImages]; with (TitleCaptions as TStringList) do begin OnChange := nil; // This fixes an issue with Laz 1.0 Clear; @@ -2758,6 +2761,27 @@ begin if (ienPageLayout in expNodes) then Exclude(expNodes, ienPageLayout) else Include(expNodes, ienPageLayout); + end else + if (pos('Images', s) > 0) then + begin + if (ienEmbeddedObj in expNodes) + then Exclude(expNodes, ienEmbeddedObj) + else Include(expNodes, ienEmbeddedObj); + if (ienImages in expNodes) + then Exclude(expNodes, ienImages) + else Include(expNodes, ienImages); + end else + if (pos('Fonts', s) > 0) then + begin + if (ienFonts in expNodes) + then Exclude(expNodes, ienFonts) + else Include(expNodes, ienFonts); + end else + if (pos('Cell formats', s) > 0) then + begin + if (ienFormats in expNodes) + then Exclude(expNodes, ienFormats) + else Include(expNodes, ienFormats); end else exit; SetExpanded(expNodes); @@ -3124,6 +3148,7 @@ var bo: TsWorkbookOption; s: String; i: Integer; + embobj: TsEmbeddedObj; begin if AWorkbook = nil then begin @@ -3132,6 +3157,7 @@ begin AStrings.Add('Options='); AStrings.Add('ActiveWorksheet='); AStrings.Add('FormatSettings='); + AStrings.Add('Images='); end else begin AStrings.Add(Format('FileName=%s', [AWorkbook.FileName])); @@ -3189,11 +3215,31 @@ begin end else AStrings.Add('(+) FormatSettings=(dblclick for more...)'); - for i:=0 to AWorkbook.GetFontCount-1 do - AStrings.Add(Format('Font%d=%s', [i, AWorkbook.GetFontAsString(i)])); + if (ienEmbeddedObj in FExpanded) then begin + AStrings.Add('(-) Images='); + for i:=0 to AWorkbook.GetEmbeddedObjCount-1 do + begin + embObj := AWorkbook.GetEmbeddedObj(i); + AStrings.Add(' Filename='+embobj.FileName); + AStrings.Add(' ImageWidth=%.2f mm', [embObj.ImageWidth]); + AStrings.Add(' ImageHeight=%.2f mm', [embObj.ImageHeight]); + end; + end else + AStrings.Add('(+) Images=(dblclick for more...)'); - for i:=0 to AWorkbook.GetNumCellFormats-1 do - AStrings.Add(Format('CellFormat%d=%s', [i, AWorkbook.GetCellFormatAsString(i)])); + if (ienFonts in FExpanded) then begin + AStrings.Add('(-) Fonts='); + for i:=0 to AWorkbook.GetFontCount-1 do + AStrings.Add(Format(' Font%d=%s', [i, AWorkbook.GetFontAsString(i)])); + end else + AStrings.Add('(+) Fonts=(dblclick for more...)'); + + if (ienFormats in FExpanded) then begin + AStrings.Add('(-) Cell formats='); + for i:=0 to AWorkbook.GetNumCellFormats-1 do + AStrings.Add(Format(' CellFormat%d=%s', [i, AWorkbook.GetCellFormatAsString(i)])); + end else + AStrings.Add('(+) Cell formats=(dblclick for more...)'); end; end; @@ -3208,8 +3254,11 @@ end; procedure TsSpreadsheetInspector.UpdateWorksheet(ASheet: TsWorksheet; AStrings: TStrings); var + i: Integer; s: String; po: TsPrintOption; + img: TsImage; + embObj: TsEmbeddedObj; begin if ASheet = nil then begin @@ -3233,9 +3282,10 @@ begin AStrings.Add(Format('Comments=%d items', [ASheet.Comments.Count])); AStrings.Add(Format('Hyperlinks=%d items', [ASheet.Hyperlinks.Count])); AStrings.Add(Format('MergedCells=%d items', [ASheet.MergedCells.Count])); + if ienPageLayout in FExpanded then begin - AStrings.Add('(+) Page layout='); + AStrings.Add('(-) Page layout='); AStrings.Add(Format(' Orientation=%s', [GetEnumName(TypeInfo(TsPageOrientation), ord(ASheet.PageLayout.Orientation))])); AStrings.Add(Format(' Page width=%.1f mm', [ASheet.PageLayout.PageWidth])); AStrings.Add(Format(' Page height=%.1f mm', [ASheet.PageLayout.PageHeight])); @@ -3271,6 +3321,24 @@ begin AStrings.Add(Format(' Options=%s', [s])); end else AStrings.Add('(+) Page layout=(dblclick for more...)'); + + if (ienImages in FExpanded) then begin + AStrings.Add('(-) Images='); + for i:=0 to ASheet.GetImageCount-1 do + begin + img := ASheet.GetImage(i); + AStrings.Add(' Row=%d', [img.Row]); + AStrings.Add(' Col=%d', [img.Col]); + embObj := ASheet.Workbook.GetEmbeddedObj(img.Index); + AStrings.Add(' Index=%d [%s; %.2fmm x %.2fmm]', [img.Index, embobj.FileName, embObj.ImageWidth, embObj.ImageHeight]); + AStrings.Add(' OffsetX=%.2f mm', [img.OffsetX]); + AStrings.Add(' OffsetY=%.2f mm', [img.OffsetY]); + AStrings.Add(' ScaleX=%.2f', [img.ScaleX]); + AStrings.Add(' ScaleY=%.2f', [img.ScaleY]); + end; + end else + AStrings.Add('(+) Images=(dblclick for more...)'); + end; end; diff --git a/components/fpspreadsheet/fpsxmlcommon.pas b/components/fpspreadsheet/fpsxmlcommon.pas index 03a982bd1..368c24ffc 100644 --- a/components/fpspreadsheet/fpsxmlcommon.pas +++ b/components/fpspreadsheet/fpsxmlcommon.pas @@ -10,6 +10,11 @@ interface uses Classes, SysUtils, laz2_xmlread, laz2_DOM, + {$IF FPC_FULLVERSION >= 20701} + zipper, + {$ELSE} + fpszipper, + {$ENDIF} fpSpreadsheet, fpsreaderwriter; type @@ -19,6 +24,23 @@ type procedure ReadXMLStream(out ADoc: TXMLDocument; AStream: TStream); end; + TStreamUnzipper = class(TUnzipper) + private + FInputStream: TStream; + FOutputStream: TStream; + FSuccess: Boolean; + procedure CloseInputStream(Sender: TObject; var AStream: TStream); + procedure CreateStream(Sender: TObject; var AStream: TStream; + AItem: TFullZipFileEntry); + procedure DoneStream(Sender: TObject; var AStream: TStream; + AItem: TFullZipFileEntry); + procedure OpenInputStream(Sender: TObject; var AStream: TStream); + public + constructor Create(AInputStream: TStream); + function UnzipFile(const AZippedFile: string; ADestStream: TStream): Boolean; + end; + + function GetAttrValue(ANode : TDOMNode; AAttrName : string) : string; function GetNodeValue(ANode: TDOMNode): String; @@ -37,11 +59,13 @@ procedure DestroyTempStream(AStream: TStream); implementation uses + (* {$IF FPC_FULLVERSION >= 20701} zipper, {$ELSE} fpszipper, {$ENDIF} + *) fpsStreams, fpsUtils; {------------------------------------------------------------------------------} @@ -184,6 +208,7 @@ end; {------------------------------------------------------------------------------} { Unzipping } {------------------------------------------------------------------------------} +(* type TStreamUnzipper = class(TUnzipper) private @@ -200,7 +225,7 @@ type constructor Create(AInputStream: TStream); function UnzipFile(const AZippedFile: string; ADestStream: TStream): Boolean; end; - +*) constructor TStreamUnzipper.Create(AInputStream: TStream); begin inherited Create;