fpspreadsheet: Add stream variant of TsWorksheet.WriteImage.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4557 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/fpspreadsheet/fpsimages.pas

@@ -14,32 +14,45 @@ type
   TsImageType = integer;
 
 const
+  {@@ Identifier for unknown image type }
   itUnknown = -1;
 
 var
+  {@@ Identifier for the PNG image type (value 0) }
   itPNG: TsImageType;
+  {@@ Identifier for the JPEG image type (value 1) }
   itJPEG: TsImageType;
+  {@@ Identifier for the TIFF image type (value 2) }
   itTIFF: TsImageType;
+  {@@ Identifier for the BMP image type (value 3) }
   itBMP: TsImageType;
+  {@@ Identifier for the GIF image type (value 4) }
   itGIF: TsImageType;
+  {@@ Identifier for the SVG image type (value 5) }
   itSVG: TsImageType;
+  {@@ Identifier for the WMF image type (value 6) }
   itWMF: TsImageType;
+  {@@ Identifier for the EMF image type (value 7) }
   itEMF: TsImageType;
+  {@@ Identifier for the PCX image type (value 8) }
   itPCX: TsImageType;
 
 type
   { TsEmbeddedObj }
   TsEmbeddedObj = class
   private
+    FFileName: String;
     FStream: TMemoryStream;
-    FName: String;
     FImageType: TsImageType;  // image type, see itXXXX
     FWidth: Double;           // image width, in mm
     FHeight: Double;          // image height, in mm
+  protected
+    function CheckStream(AImageType: TsImageType): Boolean;
   public
-    constructor Create(AName: String);
     destructor Destroy; override;
-    property Name: String read FName;
+    function LoadFromFile(const AFileName: String): Boolean;
+    function LoadFromStream(AStream: TStream): Boolean;
+    property FileName: String read FFileName;
     property ImageType: TsImagetype read FImageType;
     property ImageWidth: Double read FWidth;
     property ImageHeight: Double read FHeight;
@@ -522,6 +535,9 @@ begin
       end;
     end;
   end;
+  if not done then
+    exit;
+
   sW := Extract('width', s);
   sH := Extract('height', s);
   sVB := Extract('viewBox', s);
@@ -724,15 +740,16 @@ function GetImageInfo(AStream: TStream; out AWidth, AHeight: DWord;
 var
   itr: TImageTypeRecord;  // [i]mage [t]ype [r]ecord
 begin
-  AStream.Position := 0;
   if InRange(AImageType, 0, High(ImageTypeRegistry)) then
   begin
+    AStream.Position := 0;
     if ImageTypeRegistry[AImageType].GetImageSize(AStream, AWidth, AHeight, dpiX, dpiY)
       then Result := AImageType;
   end else
   begin
     for Result := 0 to High(ImageTypeRegistry) do
     begin
+      AStream.Position := 0;
       itr := ImageTypeRegistry[Result];
       if itr.GetImageSize(AStream, AWidth, AHeight, dpiX, dpiY) then
         exit;
@@ -835,45 +852,62 @@ end;
 {                               TsEmbeddedObj                                  }
 {==============================================================================}
 
-constructor TsEmbeddedObj.Create(AName: String);
-var
-  w, h: Double;
-begin
-  inherited Create;
-  FName := AName;
-
-  FStream := TMemoryStream.Create;
-  FStream.LoadFromFile(AName);
-  FImageType := GetImageInfo(FStream, w, h, GetImageTypefromFileName(AName));
-  if FImageType <> itUnknown then
-  begin
-    FWidth := inToMM(w);
-    FHeight := inToMM(h);
-  end else
-  begin
-    FreeAndNil(FStream);
-    abort;
-  end;
-end;
-
 destructor TsEmbeddedObj.Destroy;
 begin
   FreeAndNil(FStream);
   inherited Destroy;
 end;
 
+function TsEmbeddedObj.CheckStream(AImageType: TsImageType): Boolean;
+var
+  w, h: Double;
+begin
+  FImageType := GetImageInfo(FStream, w, h, AImageType);
+  if FImageType <> itUnknown then
+  begin
+    FWidth := inToMM(w);
+    FHeight := inToMM(h);
+    Result := true;
+  end else
+    Result := false;
+end;
+
+function TsEmbeddedObj.LoadFromFile(const AFileName: String): Boolean;
+var
+  s: TStream;
+begin
+  FreeAndNil(FStream);
+  FStream := TMemoryStream.Create;
+  s := TFileStream.Create(AFileName, fmOpenRead + fmShareDenyNone);
+  try
+    FStream.LoadFromStream(s);
+    Result := CheckStream(GetImageTypeFromFileName(AFileName));
+    if Result then FFileName := AFileName;
+  finally
+    s.Free;
+  end;
+end;
+
+function TsEmbeddedObj.LoadFromStream(AStream: TStream): Boolean;
+begin
+  FreeAndNil(FStream);
+  FStream := TMemoryStream.Create;
+  FStream.CopyFrom(AStream, AStream.Size);
+  Result := CheckStream(itUnknown);
+end;
+
 
 
 initialization
 
-  itPNG  := RegisterImageType('image/png',  'png', @GetPNGSize);
+{0}  itPNG  := RegisterImageType('image/png',  'png', @GetPNGSize);
-  itJPEG := RegisterImageType('image/jpeg', 'jpg|jpeg|jfif|jfe', @GetJPGSize);
+{1}  itJPEG := RegisterImageType('image/jpeg', 'jpg|jpeg|jfif|jfe', @GetJPGSize);
-  itTIFF := RegisterImageType('image/tiff', 'tif|tiff', @GetTIFSize);
+{2}  itTIFF := RegisterImageType('image/tiff', 'tif|tiff', @GetTIFSize);
-  itBMP  := RegisterImageType('image/bmp', 'bmp', @GetBMPSize);
+{3}  itBMP  := RegisterImageType('image/bmp', 'bmp', @GetBMPSize);
-  itGIF  := RegisterImageType('image/gif', 'gif', @GetGIFSize);
+{4}  itGIF  := RegisterImageType('image/gif', 'gif', @GetGIFSize);
-  itSVG  := RegisterImageType('image/svg+xml', 'svg', @GetSVGSize);
+{5}  itSVG  := RegisterImageType('image/svg+xml', 'svg', @GetSVGSize);
-  itWMF  := RegisterImageType('application/x-msmetafile', 'wmf', @GetWMFSize);
+{6}  itWMF  := RegisterImageType('application/x-msmetafile', 'wmf', @GetWMFSize);
-  itEMF  := RegisterImageType('image/x-emf', 'emf', @GetEMFSize);
+{7}  itEMF  := RegisterImageType('image/x-emf', 'emf', @GetEMFSize);
-  itPCX  := RegisterImageType('image/pcx', 'pcx', @GetPCXSize);
+{8}  itPCX  := RegisterImageType('image/pcx', 'pcx', @GetPCXSize);
 
 end.

components/fpspreadsheet/fpsopendocument.pas

@@ -6000,6 +6000,7 @@ procedure TsSpreadOpenDocWriter.WriteShapes(AStream: TStream;
 var
   i: Integer;
   img: TsImage;
+  imgType: TsImageType;
   r1,c1,r2,c2: Cardinal;
   roffs1,coffs1, roffs2, coffs2: Double;
   x, y, w, h: Double;
@@ -6013,14 +6014,15 @@ begin
   for i:=0 to ASheet.GetImageCount-1 do
   begin
     img := ASheet.GetImage(i);
-    if not ASheet.CalcImageExtent(i,
+    imgType := FWorkbook.GetEmbeddedObj(img.Index).ImageType;
-                                  r1, c1, r2, c2,
+    if imgType = itUnknown then
-                                  roffs1, coffs1, roffs2, coffs2,  // mm
+      Continue;
-                                  x, y, w, h)                      // mm
+
-    then begin
+    ASheet.CalcImageExtent(i,
-      FWorkbook.AddErrorMsg('Failure reading image "%s"', [FWorkbook.GetEmbeddedObj(img.Index).Name]);
+      r1, c1, r2, c2,
-      continue;
+      roffs1, coffs1, roffs2, coffs2,  // mm
-    end;
+      x, y, w, h);                     // mm
+
     AppendToStream(AStream, Format(
       '<draw:frame draw:z-index="%d" draw:name="Image %d" '+
         'draw:style-name="gr1" draw:text-style-name="P1" '+
@@ -6033,7 +6035,7 @@ begin
       i+1, i+1,
       w, h,
       x, y,
-      img.Index+1, GetImageTypeExt(Workbook.GetEmbeddedObj(img.Index).ImageType)
+      img.Index+1, GetImageTypeExt(imgType)
     ], FPointSeparatorSettings));
   end;
 

components/fpspreadsheet/fpspreadsheet.pas

@@ -490,17 +490,20 @@ type
     procedure UnmergeCells(ARange: String); overload;
 
     { Embedded images }
-    function CalcImageExtent(AIndex: Integer;
+    procedure CalcImageExtent(AIndex: Integer;
       out ARow1, ACol1, ARow2, ACol2: Cardinal;
       out ARowOffs1, AColOffs1, ARowOffs2, AColOffs2: Double;
-      out x, y, AWidth, AHeight: Double): Boolean;
+      out x, y, AWidth, AHeight: Double);
     function GetImage(AIndex: Integer): TsImage;
     function GetImageCount: Integer;
     procedure RemoveAllImages;
     procedure RemoveImage(AIndex: Integer);
     function WriteImage(ARow, ACol: Cardinal; AFileName: String;
       AOffsetX: Double = 0.0; AOffsetY: Double = 0.0;
-      AScaleX: Double = 1.0; AScaleY: Double = 1.0): Integer;
+      AScaleX: Double = 1.0; AScaleY: Double = 1.0): Integer; overload;
+    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;
 
     // Notification of changed cells
     procedure ChangedCell(ARow, ACol: Cardinal);
@@ -765,8 +768,9 @@ type
       ATransposed: Boolean = false);
 
     { Embedded objects }
-    function AddEmbeddedObj(const AName: String): Integer;
+    function AddEmbeddedObj(const AFileName: String): Integer; overload;
-    function FindEmbeddedObj(const AName: String): Integer;
+    function AddEmbeddedObj(AStream: TStream): Integer; overload;
+    function FindEmbeddedObj(const AFileName: String): Integer;
     function GetEmbeddedObj(AIndex: Integer): TsEmbeddedObj;
     function GetEmbeddedObjCount: Integer;
     function HasEmbeddedSheetImages: Boolean;
@@ -3338,12 +3342,11 @@ end;
   @param  y         Absolute coordinate of top edge of image, in mm
   @param  AWidth    Width of the image, in mm
   @param  AHeight   Height of the image, in mm
-  @return FALSE if the image stream cannot be read or the format is unsupported.
 -------------------------------------------------------------------------------}
-function TsWorksheet.CalcImageExtent(AIndex: Integer;
+procedure TsWorksheet.CalcImageExtent(AIndex: Integer;
   out ARow1, ACol1, ARow2, ACol2: Cardinal;
   out ARowOffs1, AColOffs1, ARowOffs2, AColOffs2: Double;
-  out x,y, AWidth, AHeight: Double): Boolean;  // mm
+  out x,y, AWidth, AHeight: Double);  // mm
 var
   img: TsImage;
   obj: TsEmbeddedObj;
@@ -3451,6 +3454,42 @@ begin
   Result := FImages.Add(img);
 end;
 
+{@@ ----------------------------------------------------------------------------
+  Adds an embedded image to the worksheet. The image passed in a stream.
+
+  @param  ARow       Index of the row at which the image begins (top edge)
+  @param  ACol       Index of the column at which the image begins (left edge)
+  @param  AStream    Stream which contains the image data
+  @param  AOffsetX   The image is offset horizontally from the left edge of
+                     the anchor cell. May reach into another cell.
+                     Value is in millimeters.
+  @param  AOffsetY   The image is offset vertically from the top edge of the
+                     anchor cell. May reach into another cell.
+                     Value is in millimeters.
+  @param  AScaleX    Horizontal scaling factor of the image
+  @param  AScaleY    Vertical scaling factor of the image
+  @return Index into the internal image list.
+-------------------------------------------------------------------------------}
+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.
+  idx := Workbook.AddEmbeddedObj(AStream);
+  // An error has occured? Error is already logged. Just exit.
+  if idx = -1 then
+    exit;
+
+  // Everything ok here...
+  New(img);
+  InitImageRecord(img^, ARow, ACol, AOffsetX, AOffsetY, AScaleX, AScaleY);
+  img^.Index := idx;
+  Result := FImages.Add(img);
+end;
+
 {@@ ----------------------------------------------------------------------------
   Removes an image from the internal image list.
   The image is identified by its index.
@@ -8360,43 +8399,59 @@ 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. AName is normally the
+  Embedded streams are used to store embedded images. AFileName is the
   filename of the image. The image will be loaded to the stream later.
 -------------------------------------------------------------------------------}
-function TsWorkbook.AddEmbeddedObj(const AName: String): Integer;
+function TsWorkbook.AddEmbeddedObj(const AFileName: String): Integer;
 var
   obj: TsEmbeddedObj = nil;
   w, h: Double;
-  it: TsImageType;
 begin
-  if not FileExists(AName) then
+  if not FileExists(AFileName) then
   begin
-    AddErrorMsg(rsFileNotFound, [AName]);
+    AddErrorMsg(rsFileNotFound, [AFileName]);
     Result := -1;
     exit;
   end;
 
-  try
+  obj := TsEmbeddedObj.Create;
-    obj := TsEmbeddedObj.Create(AName);
+  if obj.LoadFromFile(AFileName) then
-    Result := FEmbeddedObjList.Add(obj);
+    Result := FEmbeddedObjList.Add(obj)
-  except
+  else
-    AddErrorMsg(rsFileFormatNotSupported, [AName]);
+  begin
+    AddErrorMsg(rsFileFormatNotSupported, [AFileName]);
+    obj.Free;
+    Result := -1;
+  end;
+end;
+
+function TsWorkbook.AddEmbeddedObj(AStream: TStream): Integer;
+var
+  obj: TsEmbeddedObj = nil;
+  w, h: Double;
+begin
+  obj := TsEmbeddedObj.Create;
+  if obj.LoadFromStream(AStream) then
+    Result := FEmbeddedObjList.Add(obj)
+  else begin
+    AddErrorMsg(rsImageFormatNotSupported);
+    obj.Free;
     Result := -1;
   end;
 end;
 
 {@@ ----------------------------------------------------------------------------
-  Checks whether an embedded object with the specified name already exists.
+  Checks whether an embedded object with the specified file name already exists.
   If yes, returns its index in the object list, or -1 if no.
 -------------------------------------------------------------------------------}
-function TsWorkbook.FindEmbeddedObj(const AName: String): Integer;
+function TsWorkbook.FindEmbeddedObj(const AFileName: String): Integer;
 var
   obj: TsEmbeddedObj;
 begin
   for Result:=0 to FEmbeddedObjList.Count-1 do
   begin
     obj := TsEmbeddedObj(FEmbeddedObjList[Result]);
-    if obj.Name = AName then
+    if obj.FileName = AFileName then
       exit;
   end;
   Result := -1;

components/fpspreadsheet/fpsstrings.pas

@@ -62,6 +62,7 @@ resourcestring
   rsCircularReference = 'Circular reference found when calculating worksheet formulas';
   rsFileNotFound = 'File "%s" not found.';
   rsFileFormatNotSupported = 'File format of "%s" not supported.';
+  rsImageFormatNotSupported = 'Image format not supported.';
   rsFileAlreadyExists = 'File "%s" already exists.';
   rsWorksheetNotFound = 'Worksheet "%s" not found.';
   rsWorksheetNotFound1 = 'Worksheet not found.';

components/fpspreadsheet/fpsutils.pas

@@ -157,6 +157,7 @@ function TintedColor(AColor: TsColor; tint: Double): TsColor;
 function AnalyzeCompareStr(AString: String; out ACompareOp: TsCompareOperation): String;
 
 procedure FixLineEndings(var AText: String; var ARichTextParams: TsRichTextParams);
+function RandomString(ALen: Integer): String;
 function SplitStr(const AText: String; ADelimiter: Char): TStringArray;
 function UnquoteStr(AString: String): String;
 
@@ -1968,6 +1969,15 @@ begin
   end;
 end;
 
+function RandomString(ALen: Integer): String;
+var
+  i: Integer;
+begin
+  SetLength(Result, ALen);
+  for i:=1 to ALen do
+    Result[i] := char(Random(26) + ord('a'));
+end;
+
 {@@ ----------------------------------------------------------------------------
   Splits a string at the specified delimiters into individual strings and passes
   them in an array.

components/fpspreadsheet/xlsxooxml.pas

@@ -3262,6 +3262,7 @@ var
   r1, c1, r2, c2: Cardinal;
   roffs1, coffs1, roffs2, coffs2: Double;
   x, y, w, h: Double;
+  descr: String;
 begin
   if AWorksheet.GetImageCount= 0 then
     exit;
@@ -3279,14 +3280,16 @@ begin
   for i:=0 to AWorksheet.GetImageCount - 1 do
   begin
     img := AWorksheet.GetImage(i);
-    if not AWorksheet.CalcImageExtent(i,
+    if FWorkbook.GetEmbeddedObj(img.Index).ImageType = itUnknown then
-                                      r1, c1, r2, c2,
+      Continue;
-                                      roffs1, coffs1, roffs2, coffs2,  // mm
+    AWorksheet.CalcImageExtent(i,
-                                      x, y, w, h)                      // mm
+      r1, c1, r2, c2,
-    then begin
+      roffs1, coffs1, roffs2, coffs2,  // mm
-      FWorkbook.AddErrorMsg('Failure reading image "%s"', [FWorkbook.GetEmbeddedObj(img.Index).Name]);
+      x, y, w, h);                     // mm;
-      continue;
+
-    end;
+    descr := ExtractFileName(FWorkbook.GetEmbeddedObj(img.index).Filename);
+    if descr = '' then descr := 'image';
+
     AppendToStream(FSDrawings[FCurSheetNum],
       '<xdr:twoCellAnchor editAs="oneCell">');
     AppendToStream(FSDrawings[FCurSheetNum], Format(
@@ -3334,7 +3337,7 @@ begin
           '</xdr:spPr>'+
         '</xdr:pic>' +
         '<xdr:clientData/>', [
-        i+2, i+1, ExtractFilename(Workbook.GetEmbeddedObj(img.Index).Name),
+        i+2, i+1, descr,
         i+1,
         mmToEMU(x), mmToEMU(y),
         mmToEMU(w), mmToEMU(h)
@@ -3565,7 +3568,8 @@ procedure TsSpreadOOXMLWriter.WriteVMLDrawings_HeaderFooterImages(
       FWorkbook.AddErrorMsg(rsIncorrectPositionOfImageInHeaderFooter, [AName]);
       exit;
     end;
-    fn := ChangeFileExt(Workbook.GetEmbeddedObj(AImage.Index).Name, '');
+    fn := ChangeFileExt(Workbook.GetEmbeddedObj(AImage.Index).FileName, '');
+    if fn = '' then fn := 'image';
     AppendToStream(AStream, Format(
       ' <v:shape id="%s" o:spid="_x0000_s%d" type="#_x0000_t75"' + LineEnding +
       //    e.g.    "CH"         _x0000_s1025
@@ -3671,12 +3675,12 @@ end;
 procedure TsSpreadOOXMLWriter.WriteVmlDrawingRels(AWorksheet: TsWorksheet);
 var
   fileindex: Integer;
-//  fn: String;
   sec: TsHeaderFooterSectionIndex;
   rId: Integer;
   img: TsHeaderFooterImage;
-  imgIdx: Integer;
+//  imgIdx: Integer;
-  imgName: String;
+//  imgName: String;
+  ext: String;
 begin
   if not AWorksheet.PageLayout.HasHeaderFooterImages then
     exit;
@@ -3704,14 +3708,15 @@ begin
     img := AWorksheet.PageLayout.HeaderImages[sec];
     if img.Index = -1 then
       continue;
-    imgName := FWorkbook.GetEmbeddedObj(img.Index).Name;
+//    imgName := FWorkbook.GetEmbeddedObj(img.Index).Name;
-    imgIdx := img.Index;
+//    imgIdx := img.Index;
+    ext := GetImageTypeExt(FWorkbook.GetEmbeddedObj(img.Index).ImageType);
 //    imgIdx := FWorkbook.FindEmbeddedObj(imgName);
     AppendToStream(FSVmlDrawingsRels[fileIndex], Format(
-      '  <Relationship Id="rId%d" Target="../media/image%d%s" '+
+      '  <Relationship Id="rId%d" Target="../media/image%d.%s" '+
          'Type="' + SCHEMAS_IMAGE + '" />' + LineEnding, [
-      rId,                                  // Id="rID1"
+      rId,                   // Id="rID1"
-      imgIdx + 1, ExtractFileExt(imgName)   // Target="../media/image1.png"
+      img.Index + 1, ext     // Target="../media/image1.png"
     ]));
    inc(rId);
   end;
@@ -3721,15 +3726,16 @@ begin
     img := AWorksheet.PageLayout.FooterImages[sec];
     if img.Index = -1 then
       continue;
-    imgName := FWorkbook.GetEmbeddedObj(img.Index).Name;
+//    imgName := FWorkbook.GetEmbeddedObj(img.Index).Name;
-    imgIdx := img.Index;
+//    imgIdx := img.Index;
 //    imgIdx := FWorkbook.FindEmbeddedObj(imgName);
+    ext := GetImageTypeExt(FWorkbook.GetEmbeddedObj(img.Index).Imagetype);
     AppendToStream(FSVmlDrawingsRels[fileIndex], Format(
-      '  <Relationship Id="rId%d" Target="../media/image%d%s" '+  //
+      '  <Relationship Id="rId%d" Target="../media/image%d.%s" '+  //
          //  e.g.         "rId1"         "..(media/image1.png"
          'Type="' + SCHEMAS_IMAGE + '" />', [
       rId,
-      imgIdx + 1, ExtractFileExt(imgName)
+      img.Index + 1, ext
     ]));
    inc(rId);
   end;