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

@@ -17,19 +17,19 @@ function GetImageSize(AStream: TStream; AFileType: String;
 implementation
 
 uses
-//  laz2_xmlread, laz2_DOM,
+  SysUtils, Strings, math,
-  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;