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

@@ -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
+  DestroyTempStream(FSMeta);
-    begin
+  DestroyTempStream(FSSettings);
-      fn := TFileStream(AStream).Filename;
+  DestroyTempStream(FSStyles);
-      DeleteFile(fn);
+  DestroyTempStream(FSContent);
-    end;
+  DestroyTempStream(FSMimeType);
-    AStream.Free;
+  DestroyTempStream(FSMetaInfManifest);
-  end;
-
-begin
-  DestroyStream(FSMeta);
-  DestroyStream(FSSettings);
-  DestroyStream(FSStyles);
-  DestroyStream(FSContent);
-  DestroyStream(FSMimeType);
-  DestroyStream(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;
 

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 }

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.
 

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]));
+  FSComments[FCurSheetNum] := CreateTempStream(FWorkbook, 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;
-  }
 
   // Header
   AppendToStream(FSComments[FCurSheetNum],
@@ -3275,16 +3266,7 @@ begin
     exit;
 
   SetLength(FSDrawings, FCurSheetNum + 1);
-  FSDrawings[FCurSheetNum] := CreateStream(Format('fpsD%d', [FCurSheetNum]));
+  FSDrawings[FCurSheetNum] := CreateTempStream(FWorkbook, 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;
-  }
 
   // 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]));
+  FSSheets[FCurSheetNum] := CreateTempStream(FWorkbook, 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;
-  }
 
   // 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');
+  FSContentTypes := CreateTempStream(FWorkbook, 'fpsCT');
-  FSRelsRels := CreateStream('fpsRR');
+  FSRelsRels := CreateTempStream(FWorkbook, 'fpsRR');
-  FSWorkbookRels := CreateStream('fpsWBR');
+  FSWorkbookRels := CreateTempStream(FWorkbook, 'fpsWBR');
-  FSWorkbook := CreateStream('fpsWB');
+  FSWorkbook := CreateTempStream(FWorkbook, 'fpsWB');
-  FSStyles := CreateStream('fpsSTY');
+  FSStyles := CreateTempStream(FWorkbook, 'fpsSTY');
-  FSSharedStrings := CreateStream('fpsSS');
+  FSSharedStrings := CreateTempStream(FWorkbook, 'fpsSS');
-  FSSharedStrings_complete := CreateStream('fpsSSC');
+  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);
+  DestroyTempStream(FSContentTypes);
-  DestroyStream(FSRelsRels);
+  DestroyTempStream(FSRelsRels);
-  DestroyStream(FSWorkbookRels);
+  DestroyTempStream(FSWorkbookRels);
-  DestroyStream(FSWorkbook);
+  DestroyTempStream(FSWorkbook);
-  DestroyStream(FSStyles);
+  DestroyTempStream(FSStyles);
-  DestroyStream(FSSharedStrings);
+  DestroyTempStream(FSSharedStrings);
-  DestroyStream(FSSharedStrings_complete);
+  DestroyTempStream(FSSharedStrings_complete);
-  for stream in FSSheets do DestroyStream(stream);
+  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;