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

fpspreadsheet: ODS now can read images with hyperlinks. Fix image reading for new ODS format.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6674 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2018-10-06 11:23:12 +00:00
parent 07991acca5
commit eba44b8b45
2 changed files with 87 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -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;
'</draw:image>' +
'</draw:frame>', [
}
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;

36
components/fpspreadsheet/source/common/fpspreadsheet.pas
View File

@ -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;