fpspreadsheet: User-provided registration of image formats. Automatic detection of image format from file header.

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

components/fpspreadsheet/fpsimages.pas

@@ -7,22 +7,56 @@ interface
 uses
   Classes;
 
-function GetImageSize(AStream: TStream; AFileType: String;
+type
-  out AWidthInches, AHeightInches: double): Boolean; overload;
+  TGetImageSizeFunc = function (AStream: TStream;
+    out AWidth, AHeight: DWord; out dpiX, dpiY: Double): Boolean;
 
-function GetImageSize(AStream: TStream; AFileType: String;
+  TsImageType = integer;
-  out AWidth, AHeight: DWord; out dpiX, dpiY: double): Boolean; overload;
+
+const
+  itUnknown = -1;
+
+var
+  itPNG: TsImageType;
+  itJPEG: TsImageType;
+  itTIFF: TsImageType;
+  itBMP: TsImageType;
+  itGIF: TsImageType;
+  itSVG: TsImageType;
+  itWMF: TsImageType;
+  itEMF: TsImageType;
+  itPCX: TsImageType;
+
+function GetImageInfo(AStream: TStream; out AWidthInches, AHeightInches: Double;
+  AImagetype: TsImageType = itUnknown): TsImageType; overload;
+
+function GetImageInfo(AStream: TStream; out AWidth, AHeight: DWord;
+  out dpiX, dpiY: Double; AImageType: TsImageType = itUnknown): TsImageType; overload;
+
+function GetImageMimeType(AImageType: TsImageType): String;
+function GetImageTypeFromFileName(const AFilename: String): TsImageType;
+
+function RegisterImageType(AMimeType, AExt: String; AGetImageSize: TGetImageSizeFunc): TsImageType;
 
 
 implementation
 
 uses
-  SysUtils, Strings, math,
+  SysUtils, Strings, Math,
   fpsUtils;
 
 type
   TByteOrder = (boLE, boBE);  // little edian, or big endian
 
+  TImageTypeRecord = record
+    Ext: String;
+    MimeType: String;
+    GetImageSize: TGetImageSizeFunc;
+  end;
+
+var
+  ImageTypeRegistry: array of TImageTypeRecord;
+
 { Makes sure that the byte order of w is as specified by the parameter }
 function FixByteOrder(w: Word; AByteOrder: TByteOrder): Word; overload;
 begin
@@ -621,38 +655,151 @@ end;
 {                           Public functions                                   }
 {==============================================================================}
 
-function GetImageSize(AStream: TStream; AFileType: String;
+{@@ ----------------------------------------------------------------------------
-  out AWidth, AHeight: DWord; out dpiX, dpiY: Double): Boolean;
+  Returns the width and height of the image loaded into the specified stream.
-begin
-  AFileType := Lowercase(AFileType);
-  if AFileType[1] = '.' then Delete(AFileType, 1, 1);
-  AStream.Position := 0;
-  case AFileType of
-    'bmp'         : Result := GetBMPSize(AStream, AWidth, AHeight, dpiX, dpiY);
-    'emf'         : Result := GetEMFSize(AStream, AWidth, AHeight, dpiX, dpiY);
-    'gif'         : Result := GetGIFSize(AStream, AWidth, AHeight, dpiX, dpiY);
-    'jpg', 'jpeg' : Result := GetJPGSize(AStream, AWidth, AHeight, dpiX, dpiY);
-    'pcx'         : Result := GetPCXSize(AStream, AWidth, AHeight, dpiX, dpiY);
-    'png'         : Result := GetPNGSize(AStream, AWidth, AHeight, dpiX, dpiY);
-    'svg'         : Result := GetSVGSize(AStream, AWidth, AHeight, dpiX, dpiY);
-    'tif', 'tiff' : Result := GetTIFSize(AStream, AWidth, AHeight, dpiX, dpiY);
-    'wmf'         : Result := GetWMFSize(AStream, AWidth, AHeight, dpiX, dpiY);
-    else            Result := false;
-  end;
-end;
 
-function GetImageSize(AStream: TStream; AFileType: String;
+  @param  AStream       Stream containing the image to be analyzed. It is
-  out AWidthInches, AHeightInches: double): Boolean;
+                        assumed that the image begins at stream start.
+  @param  AWidthInches  Image width, in inches
+  @param  AHeightInches Image height, in inches
+  @param  AImageType    Type of the image to be assumed. If this parameter is
+                        missing or itUnknown then the image type is determined
+                        from the file header.
+
+  @return Image type code found from the file header.
+  @see RegisterImageType
+-------------------------------------------------------------------------------}
+function GetImageInfo(AStream: TStream; out AWidthInches, AHeightInches: Double;
+  AImagetype: TsImageType = itUnknown): TsImageType;
 var
   w, h: DWord;
   xdpi, ydpi: Double;
 begin
-  Result := GetImageSize(AStream, AFileType, w, h, xdpi, ydpi);
+  Result := GetImageInfo(AStream, w, h, xdpi, ydpi, AImageType);
-  if Result then
+  if Result <> itUnknown then begin
-  begin
     AWidthInches := w / xdpi;
     AHeightInches := h / ydpi;
   end;
 end;
 
+{@@ ----------------------------------------------------------------------------
+  Returns the width and height of the image loaded into the specified stream.
+
+  @param  AStream       Stream containing the image to be analyzed. It is
+                        assumed that the image begins at stream start.
+  @param  AWidth        Image width, in pixels
+  @param  AHeight       Image height, in pixels
+  @param  dpiX          Pixel density in x direction, per inch
+  @param  dpiY          Pixel density in y direction, per inch
+  @param  AImageType    Type of the image to be assumed. If this parameter is
+                        missing or itUnknown then the image type is determined
+                        from the file header.
+
+  @return Image type code found from the file header.
+  @see RegisterImageType
+-------------------------------------------------------------------------------}
+function GetImageInfo(AStream: TStream; out AWidth, AHeight: DWord;
+  out dpiX, dpiY: Double; AImageType: TsImageType = itUnknown): TsImageType;
+var
+  itr: TImageTypeRecord;  // [i]mage [t]ype [r]ecord
+begin
+  AStream.Position := 0;
+  if InRange(AImageType, 0, High(ImageTypeRegistry)) then
+  begin
+    if ImageTypeRegistry[AImageType].GetImageSize(AStream, AWidth, AHeight, dpiX, dpiY)
+      then Result := AImageType;
+  end else
+  begin
+    for Result := 0 to High(ImageTypeRegistry) do
+    begin
+      itr := ImageTypeRegistry[Result];
+      if itr.GetImageSize(AStream, AWidth, AHeight, dpiX, dpiY) then
+        exit;
+    end;
+    Result := itUnknown;
+  end;
+end;
+
+{@@ ----------------------------------------------------------------------------
+  Returns the MimeType of the specified image type
+
+  @param   AImageType    Format code of the image type as returned from the
+                         image registration procedure
+  @return  MimeType of the file format
+-------------------------------------------------------------------------------}
+function GetImageMimeType(AImageType: TsImageType): String;
+begin
+  if InRange(AImageType, 0, High(ImageTypeRegistry)) then
+    Result := ImageTypeRegistry[AImageType].MimeType
+  else
+    Result := '';
+end;
+
+{@@ ----------------------------------------------------------------------------
+  Extracts the image file type identifier from the extension of the specified
+  file name.
+
+  @param  AFileName    Name of the file to be analyzed
+  @return Format code value as returned from the image registration procedure
+  @see    RegisterImageType, itXXXX values.
+-------------------------------------------------------------------------------}
+function GetImageTypeFromFileName(const AFilename: String): TsImageType;
+var
+  ext: String;
+  i,j: Integer;
+  itr: TImageTypeRecord;
+  regext: TStringArray;
+begin
+  ext := Lowercase(ExtractFileExt(AFilename));
+  Delete(ext, 1, 1);
+  for j := 0 to High(ImageTypeRegistry) do
+  begin
+    itr := ImageTypeRegistry[j];
+    regext := SplitStr(itr.Ext, '|');
+    for i := 0 to High(regext) do
+      if regext[i] = ext then
+      begin
+        Result := TsImageType(j);
+        exit;
+      end;
+  end;
+  Result := itUnknown;
+end;
+
+{@@ ----------------------------------------------------------------------------
+  Registers an image type for usage in fpspreadsheet
+
+  @param  AExt            Extension(s) of the file format. Separate by "|" if a
+                          file format can use several extensions.
+  @param  AMimeType       MimeType of the file format, for usage by ods
+  @param  AGetImageSize   Function which can extract the image size and
+                          pixel density. It should only read the file header.
+  @return  Identifier of the image type (consecutive number)
+-------------------------------------------------------------------------------}
+function RegisterImageType(AMimeType, AExt: String;
+  AGetImageSize: TGetImageSizeFunc): TsImageType;
+begin
+  Result := Length(ImageTypeRegistry);
+  SetLength(ImageTypeRegistry, Result + 1);
+  with ImageTypeRegistry[Result] do
+  begin
+    MimeType := AMimeType;
+    Ext := AExt;
+    GetImageSize := AGetImageSize;
+  end;
+end;
+
+
+initialization
+
+  itPNG  := RegisterImageType('image/png',  'png', @GetPNGSize);
+  itJPEG := RegisterImageType('image/jpeg', 'jpg|jpeg|jfif|jfe', @GetJPGSize);
+  itTIFF := RegisterImageType('image/tiff', 'tif|tiff', @GetTIFSize);
+  itBMP  := RegisterImageType('image/bmp', 'bmp', @GetBMPSize);
+  itGIF  := RegisterImageType('image/gif', 'gif', @GetGIFSize);
+  itSVG  := RegisterImageType('image/svg+xml', 'svg', @GetSVGSize);
+  itWMF  := RegisterImageType('application/x-msmetafile', 'wmf', @GetWMFSize);
+  itEMF  := RegisterImageType('image/x-emf', 'emf', @GetEMFSize);
+  itPCX  := RegisterImageType('image/pcx', 'pcx', @GetPCXSize);
+
 end.

components/fpspreadsheet/fpsopendocument.pas

@@ -261,7 +261,8 @@ uses
  {$IFDEF FPS_VARISBOOL}
   fpsPatches,
  {$ENDIF}
-  fpsStrings, fpsStreams, fpsClasses, fpsExprParser, fpsRegFileFormats;
+  fpsStrings, fpsStreams, fpsClasses, fpsExprParser,
+  fpsRegFileFormats, fpsImages;
 
 const
   { OpenDocument general XML constants }
@@ -283,6 +284,7 @@ const
   SCHEMAS_XMLNS          = 'http://schemas.openxmlformats.org/officeDocument/2006/extended-properties';
   SCHEMAS_XMLNS_CONFIG   = 'urn:oasis:names:tc:opendocument:xmlns:config:1.0';
   SCHEMAS_XMLNS_OOO      = 'http://openoffice.org/2004/office';
+  SCHEMAS_XMLNS_DRAW     = 'urn:oasis:names:tc:opendocument:xmlns:drawing:1.0';
   SCHEMAS_XMLNS_MANIFEST = 'urn:oasis:names:tc:opendocument:xmlns:manifest:1.0';
   SCHEMAS_XMLNS_FO       = 'urn:oasis:names:tc:opendocument:xmlns:xsl-fo-compatible:1.0';
   SCHEMAS_XMLNS_STYLE    = 'urn:oasis:names:tc:opendocument:xmlns:style:1.0';
@@ -4293,6 +4295,9 @@ procedure TsSpreadOpenDocWriter.WriteMetaInfManifest;
 var
   i: Integer;
   ext: String;
+  mime: String;
+  imgtype: Integer;
+  embStream: TsEmbeddedStream;
 begin
   AppendToStream(FSMetaInfManifest,
     '<manifest:manifest xmlns:manifest="' + SCHEMAS_XMLNS_MANIFEST + '">');
@@ -4308,11 +4313,15 @@ begin
       '<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);
+    embstream := FWorkbook.GetEmbeddedStream(i);
-    Delete(ext, 1, 1);
+    imgtype := GetImageTypeFromFileName(embStream.Name);
+    if imgtype = itUnknown then
+      continue;
+    mime := GetImageMimeType(imgtype);
+    ext := ExtractFileExt(embStream.Name);
     AppendToStream(FSMetaInfManifest, Format(
-      '<manifest:file-entry manifest:media-type="image/%s" manifest:full-path="Pictures/%d.%s" />',
+      '<manifest:file-entry manifest:media-type="%s" manifest:full-path="Pictures/%d%s" />',
-      [ext, i+1, ext]
+      [mime, i+1, ext]
     ));
   end;
   AppendToStream(FSMetaInfManifest,
@@ -4426,6 +4435,7 @@ begin
       '" xmlns:table="' + SCHEMAS_XMLNS_TABLE +
       '" xmlns:text="' + SCHEMAS_XMLNS_TEXT +
       '" xmlns:xlink="' + SCHEMAS_XMLNS_XLINK +
+      '" xmlns:draw="' + SCHEMAS_XMLNS_DRAW +
       '" xmlns:v="' + SCHEMAS_XMLNS_V + '">');
 
   AppendToStream(FSStyles,
@@ -6009,8 +6019,8 @@ begin
     AppendToStream(AStream, Format(
       '<draw:frame draw:z-index="%d" draw:name="Image %d" '+
         'draw:style-name="gr1" draw:text-style-name="P1" '+
-        'svg:width="%.2gmm" svg:height="%.2gmm" '+
+        'svg:width="%.2fmm" svg:height="%.2fmm" '+
-        'svg:x="%.2gmm" svg:y="%.2gmm">' +
+        '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>' +

components/fpspreadsheet/fpspreadsheet.pas

@@ -3351,6 +3351,7 @@ var
   totH, totW: Double;
   r, c: Integer;
   factor: Double;
+  imgtype: Integer;
 begin
   img := GetImage(AIndex);
 
@@ -3360,7 +3361,10 @@ begin
   AColOffs1 := img.OffsetY;
 
   stream := FWorkbook.GetEmbeddedStream(img.Index);
-  Result := GetImageSize(stream, ExtractFileExt(stream.Name), AWidth, AHeight); // in inches!
+  imgtype := GetImageTypeFromFileName(stream.Name);
+  if GetImageInfo(stream, AWidth, AHeight, imgtype) = itUnknown then  // in inches
+    exit(false);
+
   AWidth := inToMM(AWidth*img.ScaleX);    // in millimeters now
   AHeight := inToMM(AHeight*img.ScaleY);
 

components/fpspreadsheet/fpsutils.pas

@@ -32,6 +32,9 @@ type
   {@@ Set of ansi characters }
   TAnsiCharSet = set of ansichar;
 
+  {@@ Array of strings }
+  TStringArray = array of string;
+
 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 }
@@ -154,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 SplitStr(const AText: String; ADelimiter: Char): TStringArray;
 function UnquoteStr(AString: String): String;
 
 function InitSortParams(ASortByCols: Boolean = true; ANumSortKeys: Integer = 1;
@@ -1964,6 +1968,28 @@ begin
   end;
 end;
 
+{@@ ----------------------------------------------------------------------------
+  Splits a string at the specified delimiters into individual strings and passes
+  them in an array.
+-------------------------------------------------------------------------------}
+function SplitStr(const AText: String; ADelimiter: Char): TStringArray;
+var
+  L: TStringList;
+  i: Integer;
+begin
+  L := TStringList.Create;
+  try
+    L.Delimiter := ADelimiter;
+    L.StrictDelimiter := true;
+    L.DelimitedText := AText;
+    SetLength(Result, L.Count);
+    for i:=0 to High(Result) do
+      Result[i] := L[i];
+  finally
+    L.Free;
+  end;
+end;
+
 {@@ ----------------------------------------------------------------------------
   Removes quotation characters which enclose a string
 -------------------------------------------------------------------------------}