pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

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

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4552 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2016-03-14 22:04:00 +00:00
parent bfcc831505
commit e76a0394d3
4 changed files with 224 additions and 37 deletions
Download Patch File Download Diff File Expand all files Collapse all files

205
components/fpspreadsheet/fpsimages.pas
View File

@ -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.

24
components/fpspreadsheet/fpsopendocument.pas
View File

@ -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);
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(
'<manifest:file-entry manifest:media-type="image/%s" manifest:full-path="Pictures/%d.%s" />',
[ext, i+1, ext]
'<manifest:file-entry manifest:media-type="%s" manifest:full-path="Pictures/%d%s" />',
[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:x="%.2gmm" svg:y="%.2gmm">' +
'svg:width="%.2fmm" svg:height="%.2fmm" '+
'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>' +

6
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -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);

26
components/fpspreadsheet/fpsutils.pas
View File

@ -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
-------------------------------------------------------------------------------}