unit U_ShellItemImage;

interface
uses
  Winapi.Windows, Vcl.Graphics;

function GetFileImage(const AFilePath: string; const AWidth, AHeight: integer;
                      const AFlags: integer; out hBmp: HBITMAP): HRESULT;
function GetFileThumbnail(const AFilePath: string;
                          const AWidth: integer = 256; const AHeight: integer = 256): TBitmap;
function GetFileIcon(const AFilePath: string;
                     const AWidth: integer = 256; const AHeight: integer = 256): TBitmap;


implementation

uses
  Winapi.ActiveX, Winapi.ShlObj, System.Win.ComObj;

type
  {$EXTERNALSYM SIIGBF}
  SIIGBF = Integer;

  {$EXTERNALSYM IShellItemImageFactory}
  IShellItemImageFactory = interface(IUnknown)
    ['{BCC18B79-BA16-442F-80C4-8A59C30C463B}']
    function GetImage(size: TSize; flags: SIIGBF; out phbm: HBITMAP): HRESULT; stdcall;
  end;

const
  SIIGBF_RESIZETOFIT = $00000000;
  SIIGBF_BIGGERSIZEOK = $00000001;
  SIIGBF_MEMORYONLY = $00000002;
  SIIGBF_ICONONLY = $00000004;
  SIIGBF_THUMBNAILONLY = $00000008;
  SIIGBF_INCACHEONLY = $00000010;

{ ------------------------------------------------------------------------------------------------ }
function GetFileImage(const AFilePath: string; const AWidth, AHeight: integer;
                      const AFlags: integer; out hBmp: HBITMAP): HRESULT;
var
  fileShellItemImage: IShellItemImageFactory;
  s: TSize;
begin
  Result := CoInitializeEx(nil, COINIT_APARTMENTTHREADED or COINIT_DISABLE_OLE1DDE);
  if Succeeded(Result) then begin
    Result := SHCreateItemFromParsingName(PChar(AFilePath), nil, IShellItemImageFactory, fileShellItemImage);
    if Succeeded(Result) then begin
      s.cx := AWidth;
      s.cy := AHeight;
      Result := fileShellItemImage.GetImage(s, AFlags, hBmp);
    end;
    CoUninitialize;
  end;
end {GetFileImage};

{ ------------------------------------------------------------------------------------------------ }
function GetFileThumbnail(const AFilePath: string;
                          const AWidth, AHeight: integer): TBitmap;
var
  hBmp: HBITMAP;
begin
  Result := TBitmap.Create;
  Result.TransparentMode := tmAuto;
  Result.AlphaFormat := afDefined;
  if Succeeded(GetFileImage(AFilePath, AWidth, AHeight, SIIGBF_THUMBNAILONLY or SIIGBF_BIGGERSIZEOK, hBmp)) then
    Result.Handle := hBmp;
end {GetFileThumbnail};

{ ------------------------------------------------------------------------------------------------ }
function GetFileIcon(const AFilePath: string; const AWidth, AHeight: integer): TBitmap;
var
  hBmp: HBITMAP;
begin
  Result := TBitmap.Create;
  Result.TransparentMode := tmAuto;
  Result.AlphaFormat := afDefined;
  OleCheck(GetFileImage(AFilePath, AWidth, AHeight, SIIGBF_ICONONLY, hBmp));
  Result.Handle := hBmp;
end {GetFileThumbnail};

end.
