From e3ee61aec51c0a17196866c4c52c73b297aaced1 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Thu, 3 Mar 2016 22:17:12 +0000 Subject: [PATCH] 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 --- components/fpspreadsheet/fpsimages.pas | 266 ++++++++++++++++++++++++- 1 file changed, 261 insertions(+), 5 deletions(-) diff --git a/components/fpspreadsheet/fpsimages.pas b/components/fpspreadsheet/fpsimages.pas index 5d9dcac0e..d96e58418 100644 --- a/components/fpspreadsheet/fpsimages.pas +++ b/components/fpspreadsheet/fpsimages.pas @@ -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;