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

fpspreadsheet: Write embedded images to ods files.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4541 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2016-03-11 17:54:29 +00:00
parent d7bba9bd93
commit 8a75b32525
4 changed files with 206 additions and 115 deletions
Download Patch File Download Diff File Expand all files Collapse all files

149
components/fpspreadsheet/fpsopendocument.pas
View File

@ -173,6 +173,7 @@ type
procedure WriteNumFormats(AStream: TStream);
procedure WriteRowStyles(AStream: TStream);
procedure WriteRowsAndCells(AStream: TStream; ASheet: TsWorksheet);
procedure WriteShapes(AStream: TStream; ASheet: TsWorksheet);
procedure WriteTableSettings(AStream: TStream);
procedure WriteTableStyles(AStream: TStream);
procedure WriteTextStyles(AStream: TStream);
@ -196,7 +197,8 @@ type
protected
FPointSeparatorSettings: TFormatSettings;
// Streams with the contents of files
FSMeta, FSSettings, FSStyles, FSContent, FSMimeType, FSMetaInfManifest: TStream;
FSMeta, FSSettings, FSStyles, FSContent: TStream;
FSMimeType, FSMetaInfManifest: TStream;
{ Helpers }
procedure AddBuiltinNumFormats; override;
@ -217,6 +219,7 @@ type
procedure WriteSettings;
procedure WriteStyles;
procedure WriteWorksheet(AStream: TStream; ASheetIndex: Integer);
procedure ZipPictures(AZip: TZipper);
{ Record writing methods }
procedure WriteBlank(AStream: TStream; const ARow, ACol: Cardinal;
@ -3855,6 +3858,13 @@ end;
single xlsx file. }
procedure TsSpreadOpenDocWriter.CreateStreams;
begin
FSMeta := CreateTempStream(FWorkbook, 'fpsM');
FSSettings := CreateTempStream(FWorkbook, 'fpsS');
FSStyles := CreateTempStream(FWorkbook, 'fpsSTY');
FSContent := CreateTempStream(FWorkbook, 'fpsC');
FSMimeType := CreateTempStream(FWorkbook, 'fpsMT');
FSMetaInfManifest := CreateTempStream(FWorkbook, 'fpsMIM');
{
if boFileStream in FWorkbook.Options then
begin
FSMeta := TFileStream.Create(GetTempFileName('', 'fpsM'), fmCreate);
@ -3881,31 +3891,19 @@ begin
FSMimeType := TMemoryStream.Create;
FSMetaInfManifest := TMemoryStream.Create;
end;
}
// FSSheets will be created when needed.
end;
{ Destroys the streams that were created by the writer }
{ Destroys the temporary streams that were created by the writer }
procedure TsSpreadOpenDocWriter.DestroyStreams;
procedure DestroyStream(AStream: TStream);
var
fn: String;
begin
if AStream is TFileStream then
begin
fn := TFileStream(AStream).Filename;
DeleteFile(fn);
end;
AStream.Free;
end;
begin
DestroyStream(FSMeta);
DestroyStream(FSSettings);
DestroyStream(FSStyles);
DestroyStream(FSContent);
DestroyStream(FSMimeType);
DestroyStream(FSMetaInfManifest);
DestroyTempStream(FSMeta);
DestroyTempStream(FSSettings);
DestroyTempStream(FSStyles);
DestroyTempStream(FSContent);
DestroyTempStream(FSMimeType);
DestroyTempStream(FSMetaInfManifest);
end;
procedure TsSpreadOpenDocWriter.InternalWriteToStream(AStream: TStream);
@ -3939,6 +3937,7 @@ begin
FZip.Entries.AddFileEntry(FSContent, OPENDOC_PATH_CONTENT);
FZip.Entries.AddFileEntry(FSMimetype, OPENDOC_PATH_MIMETYPE);
FZip.Entries.AddFileEntry(FSMetaInfManifest, OPENDOC_PATH_METAINF_MANIFEST);
ZipPictures(FZip);
ResetStreams;
@ -4194,6 +4193,9 @@ begin
end;
procedure TsSpreadOpenDocWriter.WriteMetaInfManifest;
var
i: Integer;
ext: String;
begin
AppendToStream(FSMetaInfManifest,
'<manifest:manifest xmlns:manifest="' + SCHEMAS_XMLNS_MANIFEST + '">');
@ -4207,6 +4209,15 @@ begin
'<manifest:file-entry manifest:media-type="text/xml" manifest:full-path="meta.xml" />');
AppendToStream(FSMetaInfManifest,
'<manifest:file-entry manifest:media-type="text/xml" manifest:full-path="settings.xml" />');
for i:=0 to FWorkbook.GetEmbeddedStreamCount-1 do
begin
ext := ExtractFileExt(FWorkbook.GetEmbeddedStream(i).Name);
Delete(ext, 1, 1);
AppendToStream(FSMetaInfManifest, Format(
'<manifest:file-entry manifest:media-type="image/%s" manifest:full-path="Pictures/%d.%s" />',
[ext, i+1, ext]
));
end;
AppendToStream(FSMetaInfManifest,
'</manifest:manifest>');
end;
@ -4230,6 +4241,23 @@ begin
'</office:document-meta>');
end;
procedure TsSpreadOpenDocWriter.ZipPictures(AZip: TZipper);
var
i: Integer;
embStream: TsEmbeddedStream;
embName: String;
begin
for i:=0 to FWorkbook.GetEmbeddedStreamCount-1 do
begin
embStream := FWorkbook.GetEmbeddedStream(i);
// The original ods files have a very long, ranomd, unique (?) filename.
// Test show that a simple, unique, increasing number works as well.
embName := IntToStr(i+1) + ExtractFileExt(embStream.Name);
embStream.Position := 0;
AZip.Entries.AddFileEntry(embStream, 'Pictures/' + embname);
end;
end;
procedure TsSpreadOpenDocWriter.WriteSettings;
var
i: Integer;
@ -4437,6 +4465,9 @@ begin
UTF8TextToXMLText(FWorkSheet.Name), ASheetIndex+1, WritePrintRangesAsXMLString(FWorksheet)
]));
// shapes
WriteShapes(AStream, FWorksheet);
// columns
WriteColumns(AStream, FWorkSheet);
@ -5777,6 +5808,61 @@ begin
Result := '';
end;
procedure TsSpreadOpenDocWriter.WriteShapes(AStream: TStream;
ASheet: TsWorksheet);
{
<table:shapes>
<draw:frame draw:z-index="0" draw:name="Bild 1" draw:style-name="gr1" draw:text-style-name="P1"
svg:width="4.45mm" svg:height="4.24mm" svg:x="0mm" svg:y="0mm">
<draw:image xlink:href="Pictures/100002010000001000000010DC3B2E96AAE6D486.png" xlink:type="simple" xlink:show="embed" xlink:actuate="onLoad">
<text:p />
</draw:image>
</draw:frame>
</table:shapes>
}
var
i: Integer;
img: TsImage;
r1,c1,r2,c2: Cardinal;
roffs1,coffs1, roffs2, coffs2: Double;
x,y,w,h: Double;
begin
if ASheet.GetImageCount = 0 then
exit;
AppendToStream(AStream,
'<table:shapes>');
for i:=0 to ASheet.GetImageCount-1 do
begin
img := ASheet.GetImage(i);
if not ASheet.CalcImageExtent(i,
r1, c1, r2, c2,
roffs1, coffs1, roffs2, coffs2, // mm
x, y, w, h) // mm
then begin
FWorkbook.AddErrorMsg('Failure reading image "%s"', [FWorkbook.GetEmbeddedStream(img.Index).Name]);
continue;
end;
AppendToStream(AStream, Format(
'<draw:frame draw:z-index="%d" draw:name="Image %d" draw:style-name="gr1" '+
'draw:text-style-name="P1" svg:width="%gmm" svg:height="%gmm" '+
'svg:x="%gmm" svg:y="%gmm">' +
'<draw:image xlink:href="Pictures/%d%s" xlink:type="simple" xlink:show="embed" xlink:actuate="onLoad">' +
'<text:p />' +
'</draw:image>' +
'</draw:frame>', [
i+1, i+1,
w, h,
x, y,
img.Index+1, ExtractFileExt(Workbook.GetEmbeddedStream(img.Index).Name)
], FPointSeparatorSettings));
end;
AppendToStream(AStream,
'</table:shapes>');
end;
procedure TsSpreadOpenDocWriter.WriteTableSettings(AStream: TStream);
var
i: Integer;
@ -5874,6 +5960,27 @@ begin
i+1, UTF8TextToXMLText(sheetname),
bidi
]));
if sheet.GetImageCount > 0 then
begin
// Embedded images written by fps refer to a graphic style "gr1"...
AppendToStream(AStream,
'<style:style style:name="gr1" style:family="graphic">'+
'<style:graphic-properties draw:stroke="none" draw:fill="none" '+
'draw:textarea-horizontal-align="center" '+
'draw:textarea-vertical-align="middle" '+
'draw:color-mode="standard" '+
'draw:luminance="0%" draw:contrast="0%" draw:image-opacity="100%" '+
'draw:gamma="100%" draw:red="0%" draw:green="0%" draw:blue="0%" '+
'fo:clip="rect(0mm, 0mm, 0mm, 0mm)" '+
'style:mirror="none"/>'+
'</style:style>');
// ... and a paragraph style named "P1"
AppendToStream(AStream,
'<style:style style:name="P1" style:family="paragraph">' +
'<loext:graphic-properties draw:fill="none" />' +
'<style:paragraph-properties fo:text-align="center" />' +
'</style:style>');
end;
end;
end;

3
components/fpspreadsheet/fpsutils.pas
View File

@ -29,6 +29,9 @@ type
{@@ Color value, composed of r(ed), g(reen) and b(lue) components }
TRGBA = record r, g, b, a: byte end;
{@@ Set of ansi characters }
TAnsiCharSet = set of ansichar;
const
{@@ Date formatting string for unambiguous date/time display as strings
Can be used for text output when date/time cell support is not available }

40
components/fpspreadsheet/fpsxmlcommon.pas
View File

@ -30,6 +30,10 @@ procedure UnzipFile(AZipFileName, AZippedFile, ADestFolder: String);
function UnzipToStream(AZipStream: TStream; const AZippedFile: String;
ADestStream: TStream): Boolean;
function CreateTempStream(AWorkbook: TsWorkbook; AFileNameBase: String): TStream;
procedure DestroyTempStream(AStream: TStream);
implementation
uses
@ -318,5 +322,41 @@ begin
end;
end;
{@@ ----------------------------------------------------------------------------
Creates a basic stream for storing of the individual files. Depending on
the set workbook options the stream is created as a memory stream (default),
buffered stream or file stream.
In the latter two cases a filename mask is provided to create a temporary
filename around this mask.
-------------------------------------------------------------------------------}
function CreateTempStream(AWorkbook: TsWorkbook; AFilenameBase: String): TStream;
begin
if boFileStream in AWorkbook.Options then
Result := TFileStream.Create(GetTempFileName('', AFilenameBase), fmCreate)
else
if boBufStream in AWorkbook.Options then
Result := TBufStream.Create(GetTempFileName('', AFilenameBase))
else
Result := TMemoryStream.Create;
end;
procedure DestroyTempStream(AStream: TStream);
var
fn: String;
begin
// TMemoryStream and TBufStream need not be considered separately,
// they destroy everything themselves. Only the TFileStream must delete its
// temporary file.
if AStream is TFileStream then
begin
fn := TFileStream(AStream).Filename;
DeleteFile(fn);
end;
AStream.Free;
end;
end.

129
components/fpspreadsheet/xlsxooxml.pas
View File

@ -119,7 +119,6 @@ type
out AComment_rId, AFirstHyperlink_rId, ADrawing_rId, ADrawingHF_rId: Integer);
protected
procedure AddBuiltinNumFormats; override;
function CreateStream(AFilenameBase: String): TStream;
procedure CreateStreams;
procedure DestroyStreams;
function FindBorderInList(AFormat: PsCellFormat): Integer;
@ -227,7 +226,8 @@ implementation
uses
variants, strutils, math, lazutf8, LazFileUtils, uriparser,
{%H-}fpsPatches,
fpsStrings, fpsStreams, fpsNumFormatParser, fpsClasses, fpsRegFileFormats;
fpsStrings, fpsStreams, fpsNumFormatParser, fpsClasses,
fpsRegFileFormats;
const
{ OOXML general XML constants }
@ -2507,16 +2507,7 @@ begin
// Create the comments stream
SetLength(FSComments, FCurSheetNum + 1);
FSComments[FCurSheetNum] := CreateStream(Format('fpsCMNT%d', [FCurSheetNum]));
{
if boFileStream in FWorkbook.Options then
FSComments[FCurSheetNum] := TFileStream.Create(GetTempFileName('', Format('fpsCMNT%d', [FCurSheetNum])), fmCreate)
else
if (boBufStream in Workbook.Options) then
FSComments[FCurSheetNum] := TBufStream.Create(GetTempFileName('', Format('fpsCMNT%d', [FCurSheetNum])))
else
FSComments[FCurSheetNum] := TMemoryStream.Create;
}
FSComments[FCurSheetNum] := CreateTempStream(FWorkbook, Format('fpsCMNT%d', [FCurSheetNum]));
// Header
AppendToStream(FSComments[FCurSheetNum],
@ -3275,16 +3266,7 @@ begin
exit;
SetLength(FSDrawings, FCurSheetNum + 1);
FSDrawings[FCurSheetNum] := CreateStream(Format('fpsD%d', [FCurSheetNum]));
{
if boFileStream in FWorkbook.Options then
FSDrawings[FCurSheetNum] := TFileStream.Create(GetTempFileName('', Format('fpsD%d', [FCurSheetNum])), fmCreate)
else
if boBufStream in FWorkbook.Options then
FSDrawings[FCurSheetNum] := TBufStream.Create(GetTempFileName('', Format('fpsD%d', [FCurSheetNum])))
else
FSDrawings[FCurSheetNum] := TMemoryStream.Create;
}
FSDrawings[FCurSheetNum] := CreateTempStream(FWorkbook, Format('fpsD%d', [FCurSheetNum]));
// Header
AppendToStream(FSDrawings[FCurSheetNum],
@ -3370,12 +3352,13 @@ procedure TsSpreadOOXMLWriter.WriteDrawingRels(AWorksheet: TsWorksheet);
var
i: Integer;
ext: String;
img: TsImage;
begin
if (AWorksheet.GetImageCount = 0) then
exit;
SetLength(FSDrawingsRels, FCurSheetNum + 1);
FSDrawingsRels[FCurSheetNum] := CreateStream(Format('fpsDR%d', [FCurSheetNum]));
FSDrawingsRels[FCurSheetNum] := CreateTempStream(FWorkbook, Format('fpsDR%d', [FCurSheetNum]));
// Header
AppendToStream(FSDrawingsRels[FCurSheetNum],
@ -3385,10 +3368,11 @@ begin
// Repeat for each image
for i:=0 to AWorksheet.GetImageCount - 1 do
begin
ext := ExtractFileExt(FWorkbook.GetEmbeddedStream(i).Name);
img := AWorksheet.GetImage(i);
ext := ExtractFileExt(FWorkbook.GetEmbeddedStream(img.Index).Name);
AppendToStream(FSDrawingsRels[FCurSheetNum], Format(
' <Relationship Id="rId%d" Type="%s" Target="../media/image%d%s"/>' + LineEnding, [
i+1, SCHEMAS_IMAGE, i+1, ext
img.Index+1, SCHEMAS_IMAGE, img.Index+1, ext
]));
end;
@ -3462,7 +3446,7 @@ begin
fileIndex := Length(FSVmlDrawings);
SetLength(FSVmlDrawings, fileIndex+1);
FSVmlDrawings[fileIndex] := CreateStream(Format('fpsVMLD%', [fileIndex+1]));
FSVmlDrawings[fileIndex] := CreateTempStream(FWorkbook, Format('fpsVMLD%', [fileIndex+1]));
// Header of file
AppendToStream(FSVmlDrawings[fileIndex],
@ -3610,7 +3594,7 @@ begin
fileIndex := Length(FSVmlDrawings);
SetLength(FSVmlDrawings, fileIndex+1);
FSVmlDrawings[fileIndex] := CreateStream(Format('fpsVMLD%d', [fileIndex+1]));
FSVmlDrawings[fileIndex] := CreateTempStream(FWorkbook, Format('fpsVMLD%d', [fileIndex+1]));
// Header of file
AppendToStream(FSVmlDrawings[fileIndex],
@ -3702,7 +3686,7 @@ begin
inc(fileIndex); // skip comments for numbering
SetLength(FSVmlDrawingsRels, fileIndex+1);
FsVmlDrawingsRels[fileIndex] := CreateStream(Format('fpsVMSDR%d', [fileIndex]));
FsVmlDrawingsRels[fileIndex] := CreateTempStream(FWorkbook, Format('fpsVMSDR%d', [fileIndex]));
// Write file header
AppendToStream(FSVmlDrawingsRels[fileIndex],
@ -3775,7 +3759,7 @@ begin
Get_rId(AWorksheet, rID_Comments, rId_Hyperlink, rId_Drawing, rId_DrawingHF);
// Create stream
FSSheetRels[FCurSheetNum] := CreateStream(Format('fpsWSR%d', [FCurSheetNum]));
FSSheetRels[FCurSheetNum] := CreateTempStream(FWorkbook, Format('fpsWSR%d', [FCurSheetNum]));
// Header
AppendToStream(FSSheetRels[FCurSheetNum],
@ -4198,18 +4182,7 @@ begin
rId_DrawingHF);
// Create the stream
FSSheets[FCurSheetNum] := CreateStream(Format('fpsSH%d', [FCurSheetNum]));
{
if boFileStream in FWorkbook.Options then
FSSheets[FCurSheetNum] := TFileStream.Create(GetTempFileName('',
Format('fpsSH%d', [FCurSheetNum])), fmCreate)
else
if (boBufStream in Workbook.Options) then
FSSheets[FCurSheetNum] := TBufStream.Create(GetTempFileName('',
Format('fpsSH%d', [FCurSheetNum])))
else
FSSheets[FCurSheetNum] := TMemoryStream.Create;
}
FSSheets[FCurSheetNum] := CreateTempStream(FWorkbook, Format('fpsSH%d', [FCurSheetNum]));
// Header
AppendToStream(FSSheets[FCurSheetNum],
@ -4270,25 +4243,6 @@ begin
);
end;
{@@ ----------------------------------------------------------------------------
Creates a basic stream for storing of the individual files. Depending on
the set workbook options the stream is created as a memory stream (default),
buffered stream or file stream.
In the latter two cases a filename mask is provided to create a temporary
filename around this mask.
-------------------------------------------------------------------------------}
function TsSpreadOOXMLWriter.CreateStream(AFilenameBase: String): TStream;
begin
if boFileStream in FWorkbook.Options then
Result := TFileStream.Create(GetTempFileName('', AFilenameBase), fmCreate)
else
if boBufStream in Workbook.Options then
Result := TBufStream.Create(GetTempFileName('', AFilenameBase))
else
Result := TMemoryStream.Create;
end;
{@@ ----------------------------------------------------------------------------
Creates the basic streams for the individual data files.
Will be zipped into a single xlsx file.
@ -4296,13 +4250,13 @@ end;
-------------------------------------------------------------------------------}
procedure TsSpreadOOXMLWriter.CreateStreams;
begin
FSContentTypes := CreateStream('fpsCT');
FSRelsRels := CreateStream('fpsRR');
FSWorkbookRels := CreateStream('fpsWBR');
FSWorkbook := CreateStream('fpsWB');
FSStyles := CreateStream('fpsSTY');
FSSharedStrings := CreateStream('fpsSS');
FSSharedStrings_complete := CreateStream('fpsSSC');
FSContentTypes := CreateTempStream(FWorkbook, 'fpsCT');
FSRelsRels := CreateTempStream(FWorkbook, 'fpsRR');
FSWorkbookRels := CreateTempStream(FWorkbook, 'fpsWBR');
FSWorkbook := CreateTempStream(FWorkbook, 'fpsWB');
FSStyles := CreateTempStream(FWorkbook, 'fpsSTY');
FSSharedStrings := CreateTempStream(FWorkbook, 'fpsSS');
FSSharedStrings_complete := CreateTempStream(FWorkbook, 'fpsSSC');
{
if boFileStream in FWorkbook.Options then
begin
@ -4340,42 +4294,29 @@ end;
Destroys the streams that were created by the writer
-------------------------------------------------------------------------------}
procedure TsSpreadOOXMLWriter.DestroyStreams;
procedure DestroyStream(AStream: TStream);
var
fn: String;
begin
if AStream is TFileStream then
begin
fn := TFileStream(AStream).Filename;
DeleteFile(fn);
end;
AStream.Free;
end;
var
stream: TStream;
begin
DestroyStream(FSContentTypes);
DestroyStream(FSRelsRels);
DestroyStream(FSWorkbookRels);
DestroyStream(FSWorkbook);
DestroyStream(FSStyles);
DestroyStream(FSSharedStrings);
DestroyStream(FSSharedStrings_complete);
for stream in FSSheets do DestroyStream(stream);
DestroyTempStream(FSContentTypes);
DestroyTempStream(FSRelsRels);
DestroyTempStream(FSWorkbookRels);
DestroyTempStream(FSWorkbook);
DestroyTempStream(FSStyles);
DestroyTempStream(FSSharedStrings);
DestroyTempStream(FSSharedStrings_complete);
for stream in FSSheets do DestroyTempStream(stream);
SetLength(FSSheets, 0);
for stream in FSComments do DestroyStream(stream);
for stream in FSComments do DestroyTempStream(stream);
SetLength(FSComments, 0);
for stream in FSSheetRels do DestroyStream(stream);
for stream in FSSheetRels do DestroyTempStream(stream);
SetLength(FSSheetRels, 0);
for stream in FSVmlDrawings do DestroyStream(stream);
for stream in FSVmlDrawings do DestroyTempStream(stream);
SetLength(FSVmlDrawings, 0);
for stream in FSVmlDrawingsRels do DestroyStream(stream);
for stream in FSVmlDrawingsRels do DestroyTempStream(stream);
SetLength(FSVmlDrawingsRels, 0);
for stream in FSDrawings do DestroyStream(stream);
for stream in FSDrawings do DestroyTempStream(stream);
SetLength(FSDrawings, 0);
for stream in FSDrawingsRels do DestroyStream(stream);
for stream in FSDrawingsRels do DestroyTempStream(stream);
Setlength(FSDrawings, 0);
end;