You've already forked lazarus-ccr
fpspreadsheet: Support .svg, .pcx, .wmf and .emf image formats for embedding into worksheets (in addition to .jpg, .bmp, .tiff, .gif, .png).
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4529 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
@ -17,19 +17,19 @@ function GetImageSize(AStream: TStream; AFileType: String;
|
||||
implementation
|
||||
|
||||
uses
|
||||
// laz2_xmlread, laz2_DOM,
|
||||
Strings, math;
|
||||
SysUtils, Strings, math,
|
||||
fpsUtils;
|
||||
|
||||
type
|
||||
TByteOrder = (boLE, boBE); // little edian, or big endian
|
||||
|
||||
{ Makes sure that the byte order of w the same as specified by the parameter }
|
||||
{ Makes sure that the byte order of w is as specified by the parameter }
|
||||
function FixByteOrder(w: Word; AByteOrder: TByteOrder): Word; overload;
|
||||
begin
|
||||
Result := IfThen(AByteOrder = boLE, LEToN(w), BEToN(w));
|
||||
end;
|
||||
|
||||
{ Makes sure that the byte order of dw the same as specified by the parameter }
|
||||
{ Makes sure that the byte order of dw is as specified by the parameter }
|
||||
function FixByteOrder(dw: DWord; AByteOrder: TByteOrder): DWord; overload;
|
||||
begin
|
||||
Result := IfThen(AByteOrder = boLE, LEToN(dw), BEToN(dw));
|
||||
@ -82,6 +82,49 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
{ EMF files }
|
||||
|
||||
function GetEMFSize(AStream: TStream; out AWidth, AHeight: DWord;
|
||||
out dpiX, dpiY: Double): Boolean;
|
||||
// https://msdn.microsoft.com/de-de/library/windows/desktop/dd162607%28v=vs.85%29.aspx
|
||||
type
|
||||
TEnhMetaHeader = packed record
|
||||
iType: DWord;
|
||||
nSize: DWord;
|
||||
rclBounds: TRect;
|
||||
rclFrame: TRect;
|
||||
dSignature: DWord; // must be $464D4520
|
||||
nVersion: DWord;
|
||||
nBytes: DWord;
|
||||
nRecords: DWord;
|
||||
nHandles: Word;
|
||||
sReserved: Word;
|
||||
nDescription: DWord;
|
||||
offDescription: DWord;
|
||||
nPalEntries: DWord;
|
||||
szlDevice: TPoint;
|
||||
szlMillimeters: TPoint;
|
||||
// more to follow
|
||||
end;
|
||||
var
|
||||
hdr: TEnhMetaHeader;
|
||||
n: Int64;
|
||||
begin
|
||||
Result := false;
|
||||
|
||||
n := AStream.Read(hdr, SizeOf(hdr));
|
||||
if n < SizeOf(hdr) then exit;
|
||||
if hdr.dSignature <> $464D4520 then exit;
|
||||
|
||||
AWidth := (hdr.rclFrame.Right - hdr.rclFrame.Left); // in 0.01 mm
|
||||
AHeight := (hdr.rclFrame.Bottom - hdr.rclFrame.Top);
|
||||
dpiX := 100*25.4;
|
||||
dpiY := 100*25.4;
|
||||
|
||||
Result := true;
|
||||
end;
|
||||
|
||||
|
||||
{ GIF files }
|
||||
|
||||
function GetGIFSize(AStream: TStream; out AWidth, AHeight: DWord;
|
||||
@ -225,6 +268,48 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
{ PCX files }
|
||||
|
||||
function GetPCXSize(AStream: TStream; out AWidth, AHeight: DWord;
|
||||
out dpiX, dpiY: Double): Boolean;
|
||||
type
|
||||
TPCXHeader = packed record
|
||||
FileID: Byte; // $0A for PCX files, $CD for SCR files
|
||||
Version: Byte; // 0: version 2.5; 2: 2.8 with palette; 3: 2.8 w/o palette; 5: version 3
|
||||
Encoding: Byte; // 0: uncompressed; 1: RLE encoded
|
||||
BitsPerPixel: Byte;
|
||||
XMin,
|
||||
YMin,
|
||||
XMax,
|
||||
YMax, // coordinates of the corners of the image
|
||||
HRes, // horizontal resolution in dpi
|
||||
VRes: Word; // vertical resolution in dpi
|
||||
ColorMap: array[0..15*3] of byte; // color table
|
||||
Reserved,
|
||||
ColorPlanes: Byte; // color planes (at most 4)
|
||||
BytesPerLine, // number of bytes of one line of one plane
|
||||
PaletteType: Word; // 1: color or b&w; 2: gray scale
|
||||
Fill: array[0..57] of Byte;
|
||||
end;
|
||||
var
|
||||
hdr: TPCXHeader;
|
||||
n: Int64;
|
||||
begin
|
||||
Result := false;
|
||||
|
||||
n := AStream.Read(hdr, SizeOf(hdr));
|
||||
if n < SizeOf(hdr) then exit;
|
||||
if not (hdr.FileID in [$0A, $CD]) then exit;
|
||||
|
||||
AWidth := hdr.XMax - hdr.XMin + 1;
|
||||
AHeight := hdr.YMax - hdr.YMin + 1;
|
||||
dpiX := hdr.HRes;
|
||||
dpiY := hdr.VRes;
|
||||
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
|
||||
{ PNG files }
|
||||
|
||||
function GetPNGSize(AStream: TStream; out AWidth, AHeight: DWord;
|
||||
@ -284,6 +369,136 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
{ SVG files }
|
||||
|
||||
function GetSVGSize(AStream: TStream; out AWidth, AHeight: DWord;
|
||||
out dpiX, dpiY: Double): Boolean;
|
||||
var
|
||||
fs: TFormatSettings;
|
||||
|
||||
function Extract(AName, AText: String): String;
|
||||
var
|
||||
p: Integer;
|
||||
begin
|
||||
Result := '';
|
||||
p := pos(lowercase(AName), lowercase(AText));
|
||||
if p > 0 then
|
||||
begin
|
||||
inc(p, Length(AName));
|
||||
while (p <= Length(AText)) and (AText[p] in [' ', '"', '=']) do
|
||||
inc(p);
|
||||
while (p <= Length(AText)) and (AText[p] <> '"') do
|
||||
begin
|
||||
Result := Result + AText[p];
|
||||
inc(p);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function ToInches(AText: String): Double;
|
||||
begin
|
||||
if AText[Length(AText)] in ['0'..'9'] then
|
||||
Result := mmToIn(StrToFloat(AText, fs))
|
||||
else
|
||||
Result := PtsToIn(HTMLLengthStrToPts(AText));
|
||||
end;
|
||||
|
||||
// Split the 4 viewbox values. If values don't have attached units assume mm.
|
||||
// Return viewbox width and height in inches.
|
||||
function AnalyzeViewbox(AText: String; out w, h: Double): Boolean;
|
||||
var
|
||||
L: TStringList;
|
||||
val1, val2: Double;
|
||||
s: String;
|
||||
code: Integer;
|
||||
begin
|
||||
L := TStringList.Create;
|
||||
try
|
||||
L.Delimiter := ' ';
|
||||
L.StrictDelimiter := true;
|
||||
L.DelimitedText := AText;
|
||||
if L.Count <> 4 then exit(false);
|
||||
|
||||
w := ToInches(L[2]) - ToInches(L[0]);
|
||||
h := ToInches(L[3]) - ToInches(L[1]);
|
||||
|
||||
Result := true;
|
||||
finally
|
||||
L.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
var
|
||||
ch: AnsiChar;
|
||||
s: String;
|
||||
done: Boolean;
|
||||
sW, sH, sVB: String;
|
||||
w, h: Double;
|
||||
begin
|
||||
Result := false;
|
||||
AWidth := 0;
|
||||
AHeight := 0;
|
||||
|
||||
fs := DefaultFormatSettings;
|
||||
fs.DecimalSeparator := '.';
|
||||
|
||||
// Assume 100 dpi --> Multiply the inches by 100
|
||||
dpiX := 100;
|
||||
dpiY := 100;
|
||||
|
||||
done := false;
|
||||
while (not done) and (AStream.Position < AStream.Size) do
|
||||
begin
|
||||
ch := char(AStream.ReadByte);
|
||||
if ch = '<' then begin
|
||||
ch := char(AStream.ReadByte);
|
||||
if ch <> 's' then continue;
|
||||
ch := char(AStream.ReadByte);
|
||||
if ch <> 'v' then continue;
|
||||
ch := char(AStream.ReadByte);
|
||||
if ch <> 'g' then continue;
|
||||
ch := char(AStream.ReadByte);
|
||||
if ch <> ' ' then continue;
|
||||
s := '';
|
||||
while (not done) and (AStream.Position < AStream.Size) do
|
||||
begin
|
||||
ch := char(AStream.Readbyte);
|
||||
if ch = '>' then
|
||||
done := true
|
||||
else
|
||||
s := s + ch;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
sW := Extract('width', s);
|
||||
sH := Extract('height', s);
|
||||
sVB := Extract('viewBox', s);
|
||||
|
||||
// If "viewBox" exists, ignore "Width" and "Height" except for percentage
|
||||
if (sVB <> '') and AnalyzeViewBox(sVB, w, h) then
|
||||
begin
|
||||
if (sW <> '') and (sW[Length(sw)] = '%') then begin
|
||||
SetLength(sW, Length(sW)-1);
|
||||
AWidth := round(w * StrToFloat(sW, fs) / 100 * dpiX);
|
||||
end else
|
||||
AWidth := round(w * dpiX);
|
||||
if (sH <> '') and (sH[Length(sH)] = '%') then begin
|
||||
SetLength(sH, Length(sH)-1);
|
||||
AHeight := round(h * StrToFloat(sH, fs) / 100 * dpiY);
|
||||
end else
|
||||
AHeight := round(h * dpiY);
|
||||
end else
|
||||
begin
|
||||
if sw <> '' then
|
||||
AWidth := round(HTMLLengthStrToPts(sW) * 72 * dpiX);
|
||||
if sh <> '' then
|
||||
AHeight := round(HTMLLengthStrToPts(sH) * 72 * dpiY);
|
||||
end;
|
||||
|
||||
Result := true;
|
||||
end;
|
||||
|
||||
|
||||
{ TIF files }
|
||||
|
||||
function GetTIFSize(AStream: TStream; out AWidth, AHeight: DWord;
|
||||
@ -363,13 +578,50 @@ begin
|
||||
case units of
|
||||
1: begin dpiX := 96; dpiY := 96; end;
|
||||
2: ; // is already inches, nothing to do
|
||||
3: begin dpiX := dpiX*25.4; dpiY := dpiY * 25.4; end;
|
||||
3: begin dpiX := dpiX*2.54; dpiY := dpiY * 2.54; end;
|
||||
end;
|
||||
|
||||
Result := true;
|
||||
end;
|
||||
|
||||
|
||||
{ WMF files }
|
||||
|
||||
function GetWMFSize(AStream: TStream; out AWidth, AHeight: DWord;
|
||||
out dpiX, dpiY: Double): Boolean;
|
||||
type
|
||||
TWMFSpecialHeader = packed record
|
||||
Key: DWord; // Magic number (always $9AC6CDD7)
|
||||
Handle: Word; // Metafile HANDLE number (always 0)
|
||||
Left: SmallInt; // Left coordinate in metafile units (twips)
|
||||
Top: SmallInt; // Top coordinate in metafile units
|
||||
Right: SmallInt; // Right coordinate in metafile units
|
||||
Bottom: SmallInt; // Bottom coordinate in metafile units
|
||||
Inch: Word; // Number of metafile units per inch
|
||||
Reserved: DWord; // Reserved (always 0)
|
||||
Checksum: Word; // Checksum value for previous 10 words
|
||||
end;
|
||||
const
|
||||
TWIPS = 20 * 72;
|
||||
var
|
||||
hdr: TWMFSpecialHeader;
|
||||
n: Int64;
|
||||
begin
|
||||
Result := false;
|
||||
|
||||
n := AStream.Read(hdr, SizeOf(hdr));
|
||||
if n < SizeOf(hdr) then exit;
|
||||
if hdr.Key <> $9AC6CDD7 then exit;
|
||||
|
||||
AWidth := (hdr.Right - hdr.Left);
|
||||
AHeight := (hdr.Bottom - hdr.Top);
|
||||
dpiX := hdr.Inch;
|
||||
dpiY := hdr.Inch;
|
||||
|
||||
Result := true;
|
||||
end;
|
||||
|
||||
|
||||
{==============================================================================}
|
||||
{ Public functions }
|
||||
{==============================================================================}
|
||||
@ -382,10 +634,14 @@ begin
|
||||
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;
|
||||
|
||||
Reference in New Issue
Block a user