From eba44b8b4563261ae6ac1003a9f314087d1f5054 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Sat, 6 Oct 2018 11:23:12 +0000 Subject: [PATCH] fpspreadsheet: ODS now can read images with hyperlinks. Fix image reading for new ODS format. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6674 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../source/common/fpsopendocument.pas | 96 ++++++++++++++----- .../source/common/fpspreadsheet.pas | 36 +++---- 2 files changed, 87 insertions(+), 45 deletions(-) diff --git a/components/fpspreadsheet/source/common/fpsopendocument.pas b/components/fpspreadsheet/source/common/fpsopendocument.pas index a4cc632a0..79bc86262 100644 --- a/components/fpspreadsheet/source/common/fpsopendocument.pas +++ b/components/fpspreadsheet/source/common/fpsopendocument.pas @@ -115,6 +115,7 @@ type // procedure FixFormulas; procedure ReadCell(ANode: TDOMNode; ARow, ACol: Integer; AFormatIndex: Integer; out AColsRepeated: Integer); + procedure ReadCellImages(ANode: TDOMNode; ARow, ACol: Cardinal); procedure ReadColumns(ATableNode: TDOMNode); procedure ReadColumnStyle(AStyleNode: TDOMNode); procedure ReadDateMode(SpreadSheetNode: TDOMNode); @@ -132,6 +133,8 @@ type procedure ReadPrintRanges(ATableNode: TDOMNode; ASheet: TsBasicWorksheet); procedure ReadRowsAndCells(ATableNode: TDOMNode); procedure ReadRowStyle(AStyleNode: TDOMNode); + procedure ReadShape(ANode: TDOMNode; ARow: Cardinal = UNASSIGNED_ROW_COL_INDEX; + ACol: Cardinal = UNASSIGNED_ROW_COL_INDEX); procedure ReadShapes(ATableNode: TDOMNode); procedure ReadSheetProtection(ANode: TDOMNode; ASheet: TsBasicWorksheet); procedure ReadSheets(ANode: TDOMNode); @@ -3627,9 +3630,13 @@ begin don't understand this mechanism of ods at all } end; + // Read cell comment ReadComment(ARow, ACol, ANode); + // Read cell image(s) + ReadCellImages(ANode, ARow, ACol); + s := GetAttrValue(ANode, 'table:number-columns-spanned'); if s <> '' then colsSpanned := StrToInt(s) - 1 @@ -3652,6 +3659,21 @@ begin AColsRepeated := 1; end; +procedure TsSpreadOpenDocReader.ReadCellImages(ANode: TDOMNode; + ARow, ACol: Cardinal); +var + childNode: TDOMNode; + nodeName: String; +begin + childNode := ANode.FirstChild; + while Assigned(childNode) do + begin + nodeName := childNode.NodeName; + ReadShape(childnode, ARow, ACol); + childNode := childNode.NextSibling; + end; +end; + { Reads the cells in the given table. Loops through all rows, and then finds all cells of each row. } procedure TsSpreadOpenDocReader.ReadRowsAndCells(ATableNode: TDOMNode); @@ -4049,13 +4071,20 @@ end; '' + '', [ } -procedure TsSpreadOpenDocReader.ReadShapes(ATableNode: TDOMNode); +{ ARow, ACol are specified when called from a cell node, + unspecified when called from the Shapes node. } +procedure TsSpreadOpenDocReader.ReadShape(ANode: TDOMNode; + ARow: Cardinal = UNASSIGNED_ROW_COL_INDEX; + ACol: Cardinal = UNASSIGNED_ROW_COL_INDEX); - procedure ReadFrame(ANode: TDOMNode; AHLink: String); + procedure ReadDrawFrame(ANode: TDOMNode; AHLink: String); var r, c: Cardinal; x, y, w, h: Double; - dr, dc, sx, sy: Double; + dx: Double = 0.0; + dy: Double = 0.0; + sx: Double = 1.0; + sy: Double = 1.0; childNode: TDOMNode; idx: Integer; href: String; @@ -4073,8 +4102,18 @@ procedure TsSpreadOpenDocReader.ReadShapes(ATableNode: TDOMNode); begin idx := TsWorkbook(FWorkbook).FindEmbeddedObj(ExtractFileName(href)); with FWorksheet as TsWorksheet do begin - CalcImageCell(idx, x, y, w, h, r, c, dr, dc, sx, sy); - idx := WriteImage(r, c, idx, dc, dr, sx, sy); // order of dc and dr is correct! + // When called from a cell node, x and y are relative to the cell. + // When called from the Shapes node, x and y refer to the worksheet. + CalcImageCell(idx, x, y, w, h, r, c, dy, dx, sx, sy); // order of dx and dy is correct! + if ARow <> UNASSIGNED_ROW_COL_INDEX then begin + r := ARow; + dy := y; + end; + if ACol <> UNASSIGNED_ROW_COL_INDEX then begin + c := ACol; + dx := x; + end; + idx := WriteImage(r, c, idx, dx, dy, sx, sy); if AHLink <> '' then begin img := GetPointerToImage(idx); img^.HyperlinkTarget := AHLink; @@ -4086,9 +4125,37 @@ procedure TsSpreadOpenDocReader.ReadShapes(ATableNode: TDOMNode); end; var - shapesNode, shapeNode, childNode: TDOMNode; nodeName: String; hlink: String; + linktype: String; + childnode: TDOMNode; +begin + if ANode = nil then + exit; + nodeName := ANode.NodeName; + if nodeName = 'draw:frame' then + ReadDrawFrame(ANode, '') + else + if nodeName = 'draw:a' then begin + hlink := GetAttrValue(ANode, 'xlink:href'); + linktype := GetAttrValue(ANode, 'xlink:type'); + if Lowercase(linktype) = 'simple' then + begin + childNode := ANode.FirstChild; + while assigned(childNode) do begin + nodeName := childNode.NodeName; + if nodeName = 'draw:frame' then + ReadDrawFrame(childNode, hlink); + childNode := childNode.NextSibling; + end; + end; + end; +end; + +procedure TsSpreadOpenDocReader.ReadShapes(ATableNode: TDOMNode); +var + shapesNode, shapeNode: TDOMNode; + nodeName: String; begin shapesNode := ATableNode.FirstChild; while Assigned(shapesNode) do @@ -4100,22 +4167,7 @@ begin while Assigned(shapeNode) do begin nodeName := shapeNode.NodeName; - if nodeName = 'draw:frame' then - ReadFrame(shapeNode, '') - else - if nodeName = 'draw:a' then begin - hlink := GetAttrValue(shapeNode, 'xlink:href'); - if Lowercase(GetAttrValue(shapeNode, 'xlink:type')) = 'simple' then - begin - childNode := shapeNode.FirstChild; - while assigned(childNode) do begin - nodeName := childNode.NodeName; - if nodeName = 'draw:frame' then - ReadFrame(childNode, hlink); - childNode := childNode.NextSibling; - end; - end; - end; + ReadShape(shapeNode); shapeNode := shapeNode.NextSibling; end; end; diff --git a/components/fpspreadsheet/source/common/fpspreadsheet.pas b/components/fpspreadsheet/source/common/fpspreadsheet.pas index a01cf5bc8..316bf55b1 100644 --- a/components/fpspreadsheet/source/common/fpspreadsheet.pas +++ b/components/fpspreadsheet/source/common/fpspreadsheet.pas @@ -3760,6 +3760,19 @@ begin Result := FImages.Count; end; +{@@ ---------------------------------------------------------------------------- + Calculates the position of the image with given index relative to the cell + containing the top/left corner of the image. + + @@param x worksheet-relative coordinate of the left image edge, in workbook units + @@param y worksheet-relative coordinate of the top image edge, in workbook units + @@param ARow Index of the row containing the top/left corner of the image + @@param ACol Index of the column containing the top/left corner of the image + @@param ARowOffset Distance, in workbook units, between top cell and image borders + @@param AColOffset Distance, in workbook units, between left cell and image borders + @@param AScaleX Scaling factor for the image width + @@param AScaleY Scaling factor for the image height +-------------------------------------------------------------------------------} procedure TsWorksheet.CalcImageCell(AIndex: Integer; x, y, AWidth, AHeight: Double; out ARow, ACol: Cardinal; out ARowOffs, AColOffs, AScaleX, AScaleY: Double); // All lengths are in workbook units! @@ -3776,17 +3789,6 @@ begin colW := GetColWidth(ACol, FWorkbook.Units); end; AColOffs := x - sum; - { - sum := 0; - repeat - colW := GetColWidth(ACol, FWorkbook.Units);; - sum := sum + colW; - inc(ACol); - until sum > x; - sum := sum - colW; - AColOffs := x - sum; - dec(ACol); - } ARow := 0; sum := 0; @@ -3797,18 +3799,6 @@ begin rowH := CalcRowHeight(ARow); end; ARowOffs := y - sum; - { - ARow := 0; - sum := 0; - repeat - rowH := CalcRowHeight(ARow); - sum := sum + rowH; - inc(ARow); - until sum > y; - sum := sum - rowH; - ARowOffs := y - sum; - dec(ARow); - } embObj := FWorkbook.GetEmbeddedObj(AIndex); AScaleX := AWidth / embObj.ImageWidth;