unit F_PE_FreeImage;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls,
  FreeBitmap,
  U_PreviewEngine;

type
  TfrmPEFreeImage = class(TCustomPreviewEngineForm)
    pbxPreview: TPaintBox;
    procedure pbxPreviewPaint(Sender: TObject);
  private
    { Private declarations }
    FMulti: TFreeMultiBitmap;
    FBitmap: TFreeWinBitmap;
    procedure SetFreeBitmap(const Value: TFreeWinBitmap);
  protected
    function GetRenderers: TRendererList; override;
  public
    destructor Destroy; override;

    { Public declarations }
    procedure Clear; override;

    property FreeBitmap: TFreeWinBitmap read FBitmap  write SetFreeBitmap;
  end;

var
  frmPEFreeImage: TfrmPEFreeImage;

implementation

uses
  FreeImage;

{$R *.dfm}

type
  { ------------------------------------------------------------------------------------------------ }
  TFreeImageRenderer = class(TRenderer)
  public
    constructor Create(const Parent: TCustomPreviewEngineForm);
    function  CouldShowFile(const FileName: string): boolean; override;
    function  TryShowFile(const FileName: string): boolean; override;
    function  SummarizeInfo: string; override;
    procedure PopulateInfo(const Lines: IInfoLineDisplayer); override;
  end {TFreeImageRenderer};

  { ------------------------------------------------------------------------------------------------ }
  TFreeImageMultiRenderer = class(TFreeImageRenderer)
  public
    function  CouldShowFile(const FileName: string): boolean; override;
//    function  TryShowFile(const FileName: string): boolean; override;
//    function  SummarizeInfo: string; override;
//    procedure PopulateInfo(const Lines: IInfoLineDisplayer); override;
  end {TFreeImageRenderer};



{ ================================================================================================ }
{ TFreeImageRenderer }

{ ------------------------------------------------------------------------------------------------ }
constructor TFreeImageRenderer.Create(const Parent: TCustomPreviewEngineForm);
begin
  inherited Create(Parent, TFreeBitmap.ClassName);
end {TFreeImageRenderer.Create};

{ ------------------------------------------------------------------------------------------------ }
function TFreeImageRenderer.CouldShowFile(const FileName: string): boolean;
var
  fif: FREE_IMAGE_FORMAT;
begin
  fif := FreeImage_GetFIFFromFilenameU(PWideChar(FileName));
  Result := (fif <> FIF_UNKNOWN) and FreeImage_FIFSupportsReading(FIF);
  {$MESSAGE HINT 'TODO: check if FreeImage recognizes the file type from the stream?'}
end {TFreeImageRenderer.CouldShowFile};

{ ------------------------------------------------------------------------------------------------ }
function TFreeImageRenderer.TryShowFile(const FileName: string): boolean;
var
  FIB: TFreeWinBitmap;
begin
  {$MESSAGE WARN 'TFreeImageRenderer.TryShowFile'}
  FIB := TFreeWinBitmap.Create;
  Result := FIB.LoadU(FileName);
  if Result then begin
    TfrmPEFreeImage(Self.Form).FreeBitmap := FIB;
  end;
end {TFreeImageRenderer.TryShowFile};

{ ------------------------------------------------------------------------------------------------ }
function TFreeImageRenderer.SummarizeInfo: string;
var
  FIB: TFreeWinBitmap;
begin
  Result := '';
  FIB := TfrmPEFreeImage(Self.Form).FreeBitmap;
  if Assigned(FIB) and FIB.IsValid then begin
    Result := Format('%d x %d', [FIB.GetWidth, FIB.GetHeight]);
  end;
end {TFreeImageRenderer.SummarizeInfo};

{ ------------------------------------------------------------------------------------------------ }
procedure TFreeImageRenderer.PopulateInfo(const Lines: IInfoLineDisplayer);
const
  scColorType: array[FIC_MINISWHITE..FIC_CMYK] of string =
              ( 'min value is white'                  // FIC_MINISWHITE
              , 'min value is black'                  // FIC_MINISBLACK
              , 'RGB color model'                     // FIC_RGB
              , 'color map indexed'                   // FIC_PALETTE
              , 'RGB color model with alpha channel'  // FIC_RGBALPHA
              , 'CMYK color model'                    // FIC_CMYK
              );
  scImageType: array[FIT_UNKNOWN..FIT_RGBAF] of string =
              ( 'UNKNOWN' // unknown type
              , 'BITMAP' // standard image: 1-, 4-, 8-, 16-, 24-, 32-bit
              , 'UINT16' // array of unsigned short: unsigned 16-bit
              , 'INT16' // array of short: signed 16-bit
              , 'UINT32' // array of unsigned long: unsigned 32-bit
              , 'INT32' // array of long: signed 32-bit
              , 'FLOAT' // array of float: 32-bit IEEE floating point
              , 'DOUBLE' // array of double: 64-bit IEEE floating point
              , 'COMPLEX' // array of FICOMPLEX: 2 x 64-bit IEEE floating point
              , 'RGB16' // 48-bit RGB image: 3 x 16-bit
              , 'RGBA16' // 64-bit RGBA image: 4 x 16-bit
              , 'RGBF' // 96-bit RGB float image: 3 x 32-bit IEEE floating point
              , 'RGBAF' // 128-bit RGBA float image: 4 x 32-bit IEEE floating point
              );
  scMetadataModel: array[FIMD_COMMENTS..FIMD_EXIF_RAW] of string =
              ( 'single comment or keywords'                    // FIMD_COMMENTS
              , 'Exif-TIFF metadata'                            // FIMD_EXIF_MAIN
              , 'Exif-specific metadata'                        // FIMD_EXIF_EXIF
              , 'Exif GPS metadata'                             // FIMD_EXIF_GPS
              , 'Exif maker note metadata'                      // FIMD_EXIF_MAKERNOTE
              , 'Exif interoperability metadata'                // FIMD_EXIF_INTEROP
              , 'IPTC/NAA metadata'                             // FIMD_IPTC
              , 'Adobe XMP metadata'                            // FIMD_XMP
              , 'GeoTIFF metadata (to be implemented)'          // FIMD_GEOTIFF
              , 'Animation metadata'                            // FIMD_ANIMATION
              , 'Used to attach other metadata types to a dib'  // FIMD_CUSTOM
              , 'Exif metadata as a raw buffer'                 // FIMD_EXIF_RAW
              );
  scDataType: array[FIDT_NOTYPE..FIDT_IFD8] of string =
              ( 'NOTYPE'
              , 'BYTE'
              , 'ASCII'
              , 'SHORT'
              , 'LONG'
              , 'RATIONAL'
              , 'SBYTE'
              , 'UNDEFINED'
              , 'SSHORT'
              , 'SLONG'
              , 'SRATIONAL'
              , 'FLOAT'
              , 'DOUBLE'
              , 'IFD'
              , 'PALETTE'
              , '?'
              , 'LONG8'
              , 'SLONG8'
              , 'IFD8'
              );
  scDataTypeDescription: array[FIDT_NOTYPE..FIDT_IFD8] of string =
              ( 'placeholder'                       // FIDT_NOTYPE
              , '8-bit unsigned integer'            // FIDT_BYTE
              , '8-bit bytes w/ last byte null'     // FIDT_ASCII
              , '16-bit unsigned integer'           // FIDT_SHORT
              , '32-bit unsigned integer'           // FIDT_LONG
              , '64-bit unsigned fraction'          // FIDT_RATIONAL
              , '8-bit signed integer'              // FIDT_SBYTE
              , '8-bit untyped data'                // FIDT_UNDEFINED
              , '16-bit signed integer'             // FIDT_SSHORT
              , '32-bit signed integer'             // FIDT_SLONG
              , '64-bit signed fraction'            // FIDT_SRATIONAL
              , '32-bit IEEE floating point'        // FIDT_FLOAT
              , '64-bit IEEE floating point'        // FIDT_DOUBLE
              , '32-bit unsigned integer (offset)'  // FIDT_IFD
              , '32-bit RGBQUAD'                    // FIDT_PALETTE
              , ''
              , '64-bit unsigned integer'           // FIDT_LONG8
              , '64-bit signed integer'             // FIDT_SLONG8
              , '64-bit unsigned integer (offset)'  // FIDT_IFD8
              );
var
  FIB: TFreeBitmap;
  Group: string;
  mdi: integer;
  Tag: TFreeTag;
  FindHandle: PFIMETADATA;
begin
  FIB := TfrmPEFreeImage(Self.Form).FreeBitmap;
  if FIB.IsValid then begin
    Group := 'Image';
    Lines.Add(Group, 'Width', 'px', FIB.GetWidth);
    Lines.Add(Group, 'Height', 'px', FIB.GetHeight);
    Lines.Add(Group, 'Image type', FIB.GetImageType, scImageType);
    Lines.Add(Group, 'Color type', FIB.GetColorType, scColorType);
    if FIB.GetPaletteSize > 0 then
      Lines.Add(Group, 'Palette size', FIB.GetPaletteSize);
    if FIB.GetColorsUsed > 0 then
      Lines.Add(Group, 'Colors used', FIB.GetColorsUsed);

    for mdi := FIMD_COMMENTS to FIMD_EXIF_RAW do begin
      if (not TThread.CurrentThread.ExternalThread) and TThread.CheckTerminated then
        Exit;
      Group := scMetadataModel[mdi];
      Tag := TFreeTag.Create;
      try
        FindHandle := FIB.FindFirstMetadata(mdi, Tag);
        if FindHandle <> nil then begin
          try
            repeat
              if Tag.IsValid then begin
                Lines.Add(Group, string(Tag.Key),
                          Format('%dx %s', [Tag.Count, scDataType[Tag.TagType]]),
                          Format('%s', [Tag.ToString(mdi)]));
              end;
            until not FIB.FindNextMetadata(FindHandle, Tag);
          finally
            FIB.FindCloseMetadata(FindHandle);
          end;
        end;
      finally
        Tag.Free;
      end;
    end {for};
  end;
end {TFreeImageRenderer.PopulateInfo};



{ ================================================================================================ }
{ TfrmPEFreeImage }

{ ------------------------------------------------------------------------------------------------ }
destructor TfrmPEFreeImage.Destroy;
begin
  try
    FBitmap.Free;
  finally
    inherited;
  end;
end {TfrmPEFreeImage.Destroy};

{ ------------------------------------------------------------------------------------------------ }
procedure TfrmPEFreeImage.Clear;
begin
  inherited;
  FreeAndNil(FBitmap);
end {TfrmPEFreeImage.Clear};

{ ------------------------------------------------------------------------------------------------ }
function TfrmPEFreeImage.GetRenderers: TRendererList;
var
  Renderer: TRenderer;
begin
  Result := inherited;
  if Result.Count = 0 then begin
    Renderer := TFreeImageMultiRenderer.Create(Self);
    Renderer.DisplayName := 'Multipage bitmap';
    Result.Add(Renderer);
    Renderer := TFreeImageRenderer.Create(Self);
    Renderer.DisplayName := 'Single bitmap';
    Result.Add(Renderer);
  end;
end {TfrmPEFreeImage.GetRenderers};

{ ------------------------------------------------------------------------------------------------ }
procedure TfrmPEFreeImage.SetFreeBitmap(const Value: TFreeWinBitmap);
begin
  if Assigned(FBitmap) then
    FreeAndNil(FBitmap);
  FBitmap := Value;
end {TfrmPEFreeImage.SetFreeBitmap};

{ ------------------------------------------------------------------------------------------------ }
procedure TfrmPEFreeImage.pbxPreviewPaint(Sender: TObject);
var
  W, H: integer;
  R: TRect;
begin
  if not (Assigned(FBitmap) and FBitmap.IsValid) then
    Exit;

  R := pbxPreview.ClientRect;
  W := FBitmap.GetWidth;
  H := FBitmap.GetHeight;
  if (W >= R.Width) or (H >= R.Height) then begin
    // Adjust R so the picture’s aspect ratio is respected
    if (W / H) > (R.Width / R.Height) then begin
      R.Height := MulDiv(R.Width, H, W);
    end else begin
      R.Width := MulDiv(R.Height, W, H);
    end;
  end else begin
    R.Width := W;
    R.Height := H;
  end;
  // center the image in the ClientRect
  if R.Width < pbxPreview.ClientWidth then
    R.Offset((pbxPreview.ClientWidth - R.Width) div 2, 0);
  if R.Height < pbxPreview.ClientHeight then
    R.Offset(0, (pbxPreview.ClientHeight - R.Height) div 2);

  pbxPreview.Canvas.Lock;
  try
    FBitmap.Draw(pbxPreview.Canvas.Handle, R);
  finally
    pbxPreview.Canvas.Unlock;
  end;
end {TfrmPEFreeImage.pbxPreviewPaint};


{ ================================================================================================ }
{ TFreeImageMultiRenderer }

{ ------------------------------------------------------------------------------------------------ }
function TFreeImageMultiRenderer.CouldShowFile(const FileName: string): boolean;
var
  fif: FREE_IMAGE_FORMAT;
begin
  fif := FreeImage_GetFIFFromFilenameU(PWideChar(FileName));
  Result := (fif in [FIF_TIFF, FIF_ICO, FIF_GIF]) and FreeImage_FIFSupportsReading(FIF);
end {TFreeImageMultiRenderer.CouldShowFile};




////////////////////////////////////////////////////////////////////////////////////////////////////
initialization
  TCustomPreviewEngineForm.RegisterForm(TfrmPEFreeImage);

end.
