unit fpsImages;

{$mode objfpc}{$H+}

interface

uses
  Classes;

type
  TGetImageSizeFunc = function (AStream: TStream;
    out AWidth, AHeight: DWord; out dpiX, dpiY: Double): Boolean;

  TsImageType = integer;

const
  {@@ Identifier for unknown image type }
  itUnknown = -1;

var
  {@@ Identifier for the PNG image type (value 0) }
  itPNG: TsImageType;
  {@@ Identifier for the JPEG image type (value 1) }
  itJPEG: TsImageType;
  {@@ Identifier for the TIFF image type (value 2) }
  itTIFF: TsImageType;
  {@@ Identifier for the BMP image type (value 3) }
  itBMP: TsImageType;
  {@@ Identifier for the GIF image type (value 4) }
  itGIF: TsImageType;
  {@@ Identifier for the SVG image type (value 5) }
  itSVG: TsImageType;
  {@@ Identifier for the WMF image type (value 6) }
  itWMF: TsImageType;
  {@@ Identifier for the EMF image type (value 7) }
  itEMF: TsImageType;
  {@@ Identifier for the PCX image type (value 8) }
  itPCX: TsImageType;

type
  { TsEmbeddedObj }
  TsEmbeddedObj = class
  private
    FFileName: String;
    FStream: TMemoryStream;
    FImageType: TsImageType;  // image type, see itXXXX
    FWidth: Double;           // image width, in mm
    FHeight: Double;          // image height, in mm
  protected
    function CheckStream(AImageType: TsImageType): Boolean;
  public
    destructor Destroy; override;
    function LoadFromFile(const AFileName: String): Boolean;
    function LoadFromStream(AStream: TStream; AName: String;
      ASize: Int64 = -1): Boolean;
    property FileName: String read FFileName;
    property ImageType: TsImagetype read FImageType;
    property ImageWidth: Double read FWidth write FWidth;
    property ImageHeight: Double read FHeight write FHeight;
    property Stream: TMemoryStream read FStream;
  end;


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 GetImageTypeExt(AImageType: TsImageType): String;
function GetImageTypeFromFileName(const AFilename: String): TsImageType;

function RegisterImageType(AMimeType, AExt: String; AGetImageSize: TGetImageSizeFunc): TsImageType;


implementation

uses
  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
  Result := IfThen(AByteOrder = boLE, LEToN(w), BEToN(w));
end;

{ 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));
end;

function GetTIFSize(AStream: TStream; out AWidth, AHeight: DWord;
  out dpiX, dpiY: Double): Boolean; forward;


{ BMP files }

function GetBMPSize(AStream: TStream; out AWidth, AHeight: DWord;
  out dpiX, dpiY: Double): Boolean;
// stackoverflow.com/questions/15209076/how-to-get-dimensions-of-image-file-in-delphi
type
  TBitMapFileHeader = packed record
     bfType: word;
     bfSize: longint;
     bfReserved: longint;
     bfOffset: longint;
  end;
  TBitMapInfoHeader = packed record
     Size: longint;
     Width: longint;
     Height: longint;
     Planes: word;
     BitCount: word;
     Compression: longint;
     SizeImage: longint;
     XPelsPerMeter: Longint;
     YPelsPerMeter: Longint;
     ClrUsed: longint;
     ClrImportant: longint;
  end;
const
  BMP_MAGIC_WORD = ord('M') shl 8 or ord('B');
var
  header: TBitmapFileHeader;
  info: TBitmapInfoHeader;
begin
  result := False;
  dpiX := 0;
  dpiY := 0;
  if AStream.Read(header{%H-}, SizeOf(header)) <> SizeOf(header) then Exit;
  if LEToN(header.bfType) <> BMP_MAGIC_WORD then Exit;
  if AStream.Read(info{%H-}, SizeOf(info)) <> SizeOf(info) then Exit;
  AWidth := LEToN(info.Width);
  AHeight := abs(LEToN(info.Height));  // can be negative in case of "top-down" image
  if info.Size >= 40 then
  begin
    dpiX := LEToN(info.XPelsPerMeter) * 0.0254;
    dpiY := LEToN(info.YPelsPerMeter) * 0.0254;
  end;
  if dpiX = 0 then dpiX := 72;
  if dpiY = 0 then dpiY := 72;
  Result := true;
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{%H-}, 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;
  out dpiX, dpiY: Double): Boolean;
type
  TGifHeader = packed record
    Sig: array[0..5] of char;
    ScreenWidth, ScreenHeight: word;
    Flags, Background, Aspect: byte;
  end;
  TGifImageBlock = packed record
    Left, Top, Width, Height: word;
    Flags: byte;
  end;
var
  header: TGifHeader;
  imageBlock: TGifImageBlock;
  nResult: integer;
  x: integer;
  c: char;
begin
  Result := false;

  // Read header and ensure valid file
  nResult := AStream.Read(header{%H-}, SizeOf(TGifHeader));
  if (nResult <> SizeOf(TGifHeader)) then exit;  // invalid file
  if (strlicomp(PChar(header.Sig), 'GIF87a', 6) <> 0) and
     (strlicomp(PChar(header.Sig), 'GIF89a', 6) <> 0) then exit;

  // Skip color map, if there is one
  if (header.Flags and $80) > 0 then
  begin
    x := 3 * (1 SHL ((header.Flags and 7) + 1));
    AStream.Position := x;
    if AStream.Position > AStream.Size then exit; // Color map thrashed
  end;
  // Step through blocks
  while (AStream.Position < AStream.Size) do
  begin
    c := char(AStream.ReadByte);
    if c = ',' then
    begin
      // Image found
      nResult := AStream.Read(imageBlock{%H-}, SizeOf(TGIFImageBlock));
      if nResult <> SizeOf(TGIFImageBlock) then exit; // Invalid image block encountered
      AWidth := LEToN(imageBlock.Width);
      AHeight := LEToN(imageBlock.Height);
      break;
    end;
  end;
  dpiX := 96;   // not stored in file, use default screen dpi
  dpiY := 96;
  Result := true;
end;


{ JPG files }

function GetJPGSize(AStream: TStream; out AWidth, AHeight: DWord;
  out dpiX, dpiY: Double): boolean;
type
  TJPGHeader = array[0..1] of Byte; //FFD8 = StartOfImage (SOI)
  TJPGRecord = packed record
    Marker: Byte;
    RecType: Byte;
    RecSize: Word;
  end;
  TAPP0Record = packed record
    JFIF: Array[0..4] of AnsiChar;  // zero-terminated "JFIF" string
    Version: Word;     // JFIF format revision
    Units: Byte;       // Units used for resolution: 1->inch, 2->cm, 0-> aspect ratio (1, 1)
    XDensity: Word;    // Horizontal resolution
    YDensity: Word;    // Vertical resolution
    // thumbnail follows
  end;
var
  n: integer;
  hdr: TJPGHeader;
  rec: TJPGRecord = (Marker: $FF; RecType: 0; RecSize: 0);
  app0: TAPP0Record;
  u: Integer;
  p: Int64;
  exifSig: Array[0..5] of AnsiChar;
  imgW, imgH: DWord;
begin
  Result := false;

  AWidth := 0;
  AHeight := 0;
  dpiX := -1;
  dpiY := -1;
  u := -1;  // units of pixel density

  // Check for SOI (start of image) record
  n := AStream.Read(hdr{%H-}, SizeOf(hdr));
  if (n < SizeOf(hdr)) or (hdr[0] <> $FF) or (hdr[1] <> $D8) then
    exit;

  while (AStream.Position < AStream.Size) and (rec.Marker = $FF) do begin
    if AStream.Read(rec, SizeOf(rec)) < SizeOf(rec) then exit;
    rec.RecSize := BEToN(rec.RecSize);
    p := AStream.Position - 2;
    case rec.RecType of
      $E0:  // APP0 record
        if (rec.RecSize >= SizeOf(TAPP0Record)) then
        begin
          AStream.Read(app0{%H-}, SizeOf(app0));
          if stricomp(pchar(app0.JFIF), 'JFIF') <> 0 then break;
          dpiX := BEToN(app0.XDensity);
          dpiY := BEToN(app0.YDensity);
          u := app0.Units;
        end else
          exit;
      $E1:   // APP1 record (EXIF)
        begin
          AStream.Read(exifSig{%H-}, Sizeof(exifSig));
          if not GetTIFSize(AStream, imgW, imgH, dpiX, dpiY) then exit;
        end;
      $C0..$C3:
        if (rec.RecSize >= 4) then // Start of frame markers
        begin
          AStream.Seek(1, soFromCurrent);  // Skip "bits per sample"
          AHeight := BEToN(AStream.ReadWord);
          AWidth := BEToN(AStream.ReadWord);
        end else
          exit;
      $D9:  // end of image;
        break;
    end;
    AStream.Position := p + rec.RecSize;
  end;

  if (dpiX = -1) or (u = 0) then dpiX := 96;
  if (dpiY = -1) or (u = 0) then dpiY := 96;
  if u = 2 then begin
    dpiX := dpiX * 2.54;
    dpiY := dpiY * 2.54;
  end;

  Result := true;
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{%H-}, 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;
  out dpiX, dpiY: Double): Boolean;
// https://www.w3.org/TR/PNG/
type
  TPngSig = array[0..7] of byte;
  TPngChunk = packed record
    chLength: LongInt;
    chType: array[0..3] of AnsiChar;
  end;
const
  ValidSig: TPNGSig = (137, 80, 78, 71, 13, 10, 26, 10);
var
  Sig: TPNGSig;
  x: integer;
  chunk: TPngChunk;
  xdpm: LongInt;
  ydpm: LongInt;
  units: Byte;
  p: Int64;
begin
  Result := false;
  dpiX := 96;
  dpiY := 96;

  FillChar(Sig{%H-}, SizeOf(Sig), #0);
  AStream.Read(Sig[0], SizeOf(Sig));
  for x := Low(Sig) to High(Sig) do
    if Sig[x] <> ValidSig[x] then
      exit;
  AStream.Seek(18, 0);
  AWidth := BEToN(AStream.ReadWord);
  AStream.Seek(22, 0);
  AHeight := BEToN(AStream.ReadWord);
  AStream.Position := SizeOf(TPngSig);
  while AStream.Position < AStream.Size do
  begin
    AStream.Read(chunk{%H-}, SizeOf(TPngChunk));
    chunk.chLength := BEToN(chunk.chLength);
    p := AStream.Position;
    if strlcomp(PChar(chunk.chType), 'pHYs', 4) = 0 then
    begin
      xdpm := BEToN(AStream.ReadDWord);  // pixels per meter
      ydpm := BEToN(AStream.ReadDWord);
      units := AStream.ReadByte;
      if units = 1 then
      begin
        dpiX := xdpm * 0.0254;
        dpiY := ydpm * 0.0254;
      end;
      break;
    end;
    AStream.Position := p + chunk.chLength + 4;
  end;
  Result := true;
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;
  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;
  if not done then
    exit;

  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;
  out dpiX, dpiY: Double): Boolean;
type
  TTifHeader = packed record
     BOM: word;     // 'II' for little endian, 'MM' for big endian
     Sig: word;     // Signature (42)
     IFD: DWORD;    // Offset where image data begin
  end;
  TIFD_Field = packed record
    Tag: word;
    FieldType: word;
    ValCount: DWord;
    ValOffset: DWord;
  end;
var
  header: TTifHeader = (BOM:0; Sig:0; IFD:0);
  dirEntries: Word;
  field: TIFD_Field = (Tag:0; FieldType:0; ValCount:0; ValOffset:0);
  i: Integer;
  bo: TByteOrder;
  num, denom: LongInt;
  units: Word;
  p, pStart: Int64;
begin
  Result := false;
  AWidth := 0;
  AHeight := 0;
  dpiX := 0;
  dpiY := 0;
  units := 0;

  // Remember current stream position because procedure is called also from
  // jpeg Exif block.
  pStart := AStream.Position;

  if AStream.Read(header, SizeOf(TTifHeader)) < SizeOf(TTifHeader) then exit;
  if not ((header.BOM = $4949) or (header.BOM = $4D4D)) then exit;
  if header.BOM = $4949 then bo := boLE else bo := boBE; // 'II' --> little endian, 'MM' --> big endian
  if FixByteOrder(header.Sig, bo) <> 42 then exit;

  AStream.Position := pStart + FixByteOrder(header.IFD, bo);
  dirEntries := FixByteOrder(AStream.ReadWord, bo);
  for i := 1 to dirEntries do
  begin
    AStream.Read(field, SizeOf(field));
    field.Tag := FixByteOrder(field.Tag, bo);
    field.ValOffset := FixByteOrder(field.ValOffset, bo);
    field.FieldType := FixByteOrder(field.FieldType, bo);
    p := AStream.Position;
    case field.Tag OF
      $0100 : AWidth := field.ValOffset;
      $0101 : AHeight := field.ValOffset;
      $011A : begin    // XResolution as RATIONAL value
                AStream.Position := pStart + field.ValOffset;
                num := FixByteOrder(AStream.ReadDWord, bo);
                denom := FixByteOrder(AStream.ReadDWord, bo);
                dpiX := num/denom;
              end;
      $011B : begin    // YResolution as RATIONAL value
                AStream.Position := pStart + field.ValOffset;
                num := FixByteOrder(AStream.ReadDWord, bo);
                denom := FixByteOrder(AStream.ReadDWord, bo);
                dpiY := num/denom;
              end;
      $0128 : begin
                units := field.ValOffset;   // 1: non-square 2: inches, 3: cm
              end;
    end;
    if (AWidth > 0) and (AHeight > 0) and (dpiX > 0) and (dpiY > 0) and (units > 0)
    then
      break;
    AStream.Position := p;
  end;

  case units of
    1: begin dpiX := 96; dpiY := 96; end;
    2: ;  // is already inches, nothing to do
    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;
var
  hdr: TWMFSpecialHeader;
  n: Int64;
begin
  Result := false;

  n := AStream.Read(hdr{%H-}, 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                                   }
{==============================================================================}

{@@ ----------------------------------------------------------------------------
  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  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 := 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
  if InRange(AImageType, 0, High(ImageTypeRegistry)) then
  begin
    AStream.Position := 0;
    if ImageTypeRegistry[AImageType].GetImageSize(AStream, AWidth, AHeight, dpiX, dpiY)
      then Result := AImageType;
  end else
  begin
    for Result := 0 to High(ImageTypeRegistry) do
    begin
      AStream.Position := 0;
      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;

{@@ ----------------------------------------------------------------------------
  Returns the file extension belonging the specified image type. If there
  are several extensions the first one is selected. The extension is returned
  without a leading period.
-------------------------------------------------------------------------------}
function GetImageTypeExt(AImageType: TsImageType): String;
var
  p: Integer;
begin
  if InRange(AImageType, 0, High(ImageTypeRegistry)) then
  begin
    Result := ImageTypeRegistry[AImageType].Ext;
    p := pos('|', Result);
    if p > 0 then
      Result := copy(Result, 1, p-1);
    if Result[1] = '.' then Delete(Result, 1, 1);
  end 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;


{==============================================================================}
{                               TsEmbeddedObj                                  }
{==============================================================================}

destructor TsEmbeddedObj.Destroy;
begin
  FreeAndNil(FStream);
  inherited Destroy;
end;

function TsEmbeddedObj.CheckStream(AImageType: TsImageType): Boolean;
begin
  FImageType := GetImageInfo(FStream, FWidth, FHeight, AImageType);
  // FWidth and FHeight are in inches here.
  Result := FImageType <> itUnknown;
end;

function TsEmbeddedObj.LoadFromFile(const AFileName: String): Boolean;
var
  s: TStream;
begin
  FreeAndNil(FStream);
  FStream := TMemoryStream.Create;
  s := TFileStream.Create(AFileName, fmOpenRead + fmShareDenyNone);
  try
    FStream.LoadFromStream(s);
    Result := CheckStream(GetImageTypeFromFileName(AFileName));
    if Result then FFileName := AFileName;
  finally
    s.Free;
  end;
end;

function TsEmbeddedObj.LoadFromStream(AStream: TStream; AName: String;
  ASize: Int64 = -1): Boolean;
begin
  FreeAndNil(FStream);
  FStream := TMemoryStream.Create;
  if ASize = -1 then begin
    ASize := AStream.Size;
    AStream.Position := 0;
  end;
  FStream.CopyFrom(AStream, ASize);
  Result := CheckStream(itUnknown);
  if Result then FFileName := AName;
end;



initialization

{0}  itPNG  := RegisterImageType('image/png',  'png', @GetPNGSize);
{1}  itJPEG := RegisterImageType('image/jpeg', 'jpg|jpeg|jfif|jfe', @GetJPGSize);
{2}  itTIFF := RegisterImageType('image/tiff', 'tif|tiff', @GetTIFSize);
{3}  itBMP  := RegisterImageType('image/bmp', 'bmp|dib', @GetBMPSize);
{4}  itGIF  := RegisterImageType('image/gif', 'gif', @GetGIFSize);
{5}  itSVG  := RegisterImageType('image/svg+xml', 'svg', @GetSVGSize);
{6}  itWMF  := RegisterImageType('application/x-msmetafile', 'wmf', @GetWMFSize);
{7}  itEMF  := RegisterImageType('image/x-emf', 'emf', @GetEMFSize);
{8}  itPCX  := RegisterImageType('image/pcx', 'pcx', @GetPCXSize);

end.
