From e76a0394d3b156880ccdcabd01ed34b92012757e Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Mon, 14 Mar 2016 22:04:00 +0000 Subject: [PATCH] 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 | 205 ++++++++++++++++--- components/fpspreadsheet/fpsopendocument.pas | 24 ++- components/fpspreadsheet/fpspreadsheet.pas | 6 +- components/fpspreadsheet/fpsutils.pas | 26 +++ 4 files changed, 224 insertions(+), 37 deletions(-) diff --git a/components/fpspreadsheet/fpsimages.pas b/components/fpspreadsheet/fpsimages.pas index 46f566a68..cda30d0a7 100644 --- a/components/fpspreadsheet/fpsimages.pas +++ b/components/fpspreadsheet/fpsimages.pas @@ -7,22 +7,56 @@ interface uses Classes; -function GetImageSize(AStream: TStream; AFileType: String; - out AWidthInches, AHeightInches: double): Boolean; overload; +type + TGetImageSizeFunc = function (AStream: TStream; + out AWidth, AHeight: DWord; out dpiX, dpiY: Double): Boolean; -function GetImageSize(AStream: TStream; AFileType: String; - out AWidth, AHeight: DWord; out dpiX, dpiY: double): Boolean; overload; + TsImageType = integer; + +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; -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; +{@@ ---------------------------------------------------------------------------- + Returns the width and height of the image loaded into the specified stream. -function GetImageSize(AStream: TStream; AFileType: String; - out AWidthInches, AHeightInches: double): Boolean; + @param AStream Stream containing the image to be analyzed. It is + 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); - if Result then - begin + Result := GetImageInfo(AStream, w, h, xdpi, ydpi, AImageType); + if Result <> itUnknown then 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. diff --git a/components/fpspreadsheet/fpsopendocument.pas b/components/fpspreadsheet/fpsopendocument.pas index 29fd07cab..7ab31d6f9 100755 --- a/components/fpspreadsheet/fpsopendocument.pas +++ b/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, ''); @@ -4308,11 +4313,15 @@ begin ''); for i:=0 to FWorkbook.GetEmbeddedStreamCount-1 do begin - ext := ExtractFileExt(FWorkbook.GetEmbeddedStream(i).Name); - Delete(ext, 1, 1); + embstream := FWorkbook.GetEmbeddedStream(i); + imgtype := GetImageTypeFromFileName(embStream.Name); + if imgtype = itUnknown then + continue; + mime := GetImageMimeType(imgtype); + ext := ExtractFileExt(embStream.Name); AppendToStream(FSMetaInfManifest, Format( - '', - [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( '' + + 'svg:width="%.2fmm" svg:height="%.2fmm" '+ + 'svg:x="%.2fmm" svg:y="%.2fmm">' + '' + '' + '' + diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas index 1d905f3b0..05aa8def0 100755 --- a/components/fpspreadsheet/fpspreadsheet.pas +++ b/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); diff --git a/components/fpspreadsheet/fpsutils.pas b/components/fpspreadsheet/fpsutils.pas index 87d3b2f86..a5c58ee23 100644 --- a/components/fpspreadsheet/fpsutils.pas +++ b/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 -------------------------------------------------------------------------------}