From 8a75b32525b362b3126af5e461c2a86637423a9f Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Fri, 11 Mar 2016 17:54:29 +0000 Subject: [PATCH] fpspreadsheet: Write embedded images to ods files. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4541 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- components/fpspreadsheet/fpsopendocument.pas | 149 ++++++++++++++++--- components/fpspreadsheet/fpsutils.pas | 3 + components/fpspreadsheet/fpsxmlcommon.pas | 40 +++++ components/fpspreadsheet/xlsxooxml.pas | 129 +++++----------- 4 files changed, 206 insertions(+), 115 deletions(-) diff --git a/components/fpspreadsheet/fpsopendocument.pas b/components/fpspreadsheet/fpsopendocument.pas index 18f8c6d00..c9474f983 100755 --- a/components/fpspreadsheet/fpsopendocument.pas +++ b/components/fpspreadsheet/fpsopendocument.pas @@ -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, ''); @@ -4207,6 +4209,15 @@ begin ''); AppendToStream(FSMetaInfManifest, ''); + for i:=0 to FWorkbook.GetEmbeddedStreamCount-1 do + begin + ext := ExtractFileExt(FWorkbook.GetEmbeddedStream(i).Name); + Delete(ext, 1, 1); + AppendToStream(FSMetaInfManifest, Format( + '', + [ext, i+1, ext] + )); + end; AppendToStream(FSMetaInfManifest, ''); end; @@ -4230,6 +4241,23 @@ begin ''); 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); +{ + + + + + + + +} +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, + ''); + + 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( + '' + + '' + + '' + + '' + + '', [ + i+1, i+1, + w, h, + x, y, + img.Index+1, ExtractFileExt(Workbook.GetEmbeddedStream(img.Index).Name) + ], FPointSeparatorSettings)); + end; + + AppendToStream(AStream, + ''); +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, + ''+ + ''+ + ''); + // ... and a paragraph style named "P1" + AppendToStream(AStream, + '' + + '' + + '' + + ''); + end; end; end; diff --git a/components/fpspreadsheet/fpsutils.pas b/components/fpspreadsheet/fpsutils.pas index 095bb3910..87d3b2f86 100644 --- a/components/fpspreadsheet/fpsutils.pas +++ b/components/fpspreadsheet/fpsutils.pas @@ -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 } diff --git a/components/fpspreadsheet/fpsxmlcommon.pas b/components/fpspreadsheet/fpsxmlcommon.pas index c8627f62d..4655a15f7 100644 --- a/components/fpspreadsheet/fpsxmlcommon.pas +++ b/components/fpspreadsheet/fpsxmlcommon.pas @@ -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. diff --git a/components/fpspreadsheet/xlsxooxml.pas b/components/fpspreadsheet/xlsxooxml.pas index dad241a4c..0bae7e836 100755 --- a/components/fpspreadsheet/xlsxooxml.pas +++ b/components/fpspreadsheet/xlsxooxml.pas @@ -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( ' ' + 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;