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

fpspreadsheet: Add reading of ods sheet images. Update TsSpreadsheetInspector.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4559 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2016-03-16 12:24:47 +00:00
parent 46d14f5cfe
commit 66201c6caa
6 changed files with 263 additions and 33 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
components/fpspreadsheet/examples/visual/shared/shyperlinkform.pas
View File

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

5
components/fpspreadsheet/fpsimages.pas
View File

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

90
components/fpspreadsheet/fpsopendocument.pas
View File

@ -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;
{ '<draw:frame draw:z-index="%d" draw:name="Image %d" '+
'draw:style-name="gr1" draw:text-style-name="P1" '+
'svg:width="%.2fmm" svg:height="%.2fmm" '+
'svg:x="%.2fmm" svg:y="%.2fmm">' +
'<draw:image xlink:href="Pictures/%d.%s" xlink:type="simple" xlink:show="embed" xlink:actuate="onLoad">' +
'<text:p />' +
'</draw:image>' +
'</draw:frame>', [
}
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;

82
components/fpspreadsheet/fpspreadsheet.pas
View File

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

88
components/fpspreadsheet/fpspreadsheetctrls.pas
View File

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

27
components/fpspreadsheet/fpsxmlcommon.pas
View File

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