Use the IExtractImage interface to get image thumbnails from Windows

Problem/Question/Abstract:

I need to get image thumbnails (not icons) from Windows, using IExtractImage. How can I do that?

Answer:

Very few namespaces actually implement this interface.

{Encapsulates IExtractImage, ASCI and Unicode}

  TExtractImage = class
  private
    FFlags: Longword;  {Sets how the image is to be handled see IEIFLAG_xxxx}
    FPriority: Longword;  {Returns from GetLocation call the priority
                                                                                                        if IEIFLAG_ASYNC is used above}
    FHeight: Longword;  {Desired image height}
    FWidth: Longword;  {Desired image width}
    FColorDepth: Longword;  {Desired color depth}
    FExtractImageInterface: IExtractImage;  {The interface}
    FExtractImage2Interface: IExtractImage2;  {The interface for image2}
    FOwner: TNamespace;  {The Owner namespace}
    FPathExtracted: Boolean;
    function GetImage: TBitmap;
    function GetImagePath: WideString;
    function GetExtractImageInterface: IExtractImage;
    function GetExtractImageInterface2: IExtractImage2;
  protected
    property PathExtracted: Boolean read FPathExtracted write FPathExtracted;
  public
    constructor Create;
    property ColorDepth: Longword read FColorDepth write FColorDepth;
    property ImagePath: WideString read GetImagePath;
    property Image: TBitmap read GetImage;
    property ExtractImageInterface: IExtractImage read GetExtractImageInterface;
    property ExtractImage2Interface: IExtractImage2 read GetExtractImageInterface2;
    property Flags: Longword read FFlags write FFlags;
    property Height: Longword read FHeight write FHeight;
    property Owner: TNamespace read FOwner write FOwner;
    property Priority: Longword read FPriority;
    property Width: Longword read FWidth write FWidth;
  end;

{TExtractImage}

{Encapsulation of IExtractImage and IExtractImage2}
constructor TExtractImage.Create;
begin
  FWidth := 200;
  FHeight := 200;
  FColorDepth := 32;
  FFlags := IEIFLAG_SCREEN;
end;


function TExtractImage.GetImage: TBitmap;
var
  Bits: HBITMAP;
begin
  Bits := 0;
  Result := nil;
  if Assigned(ExtractImageInterface) then
    if ExtractImageInterface.Extract(Bits) = NOERROR then
    begin
      Result := TBitmap.Create;
      Result.Handle := Bits;
    end
end;


function TExtractImage.GetExtractImageInterface2: IExtractImage2;
var
  Found: Boolean;
begin
  if not Assigned(FExtractImage2Interface) then
  begin
    Found := False;
    if Assigned(ExtractImageInterface) then
      Found := ExtractImageInterface.QueryInterface(IID_IExtractImage2,
                       Pointer(FExtractImage2Interface)) <> E_NOINTERFACE;
    if not Found then
      FExtractImage2Interface := nil
  end;
  Result := FExtractImage2Interface
end;


function TExtractImage.GetExtractImageInterface: IExtractImage;
var
  Found: Boolean;
begin
  if not Assigned(FExtractImageInterface) then
  begin
    Found := False;
    if Assigned(Owner.ParentShellFolder) then
    begin
      Found := Owner.ParentShellFolder.GetUIObjectOf(0, 1, Owner.FRelativePIDL,
                       IExtractImage, nil, Pointer(FExtractImageInterface)) = NOERROR;
    end;
    if not Found and Assigned(Owner.ShellFolder) then
    begin
      Found := Owner.ShellFolder.CreateViewObject(0, IExtractImage,
                       Pointer(FExtractImageInterface)) = NOERROR;
    end;
    if not Found then
      FExtractImageInterface := nil
  end;
  Result := FExtractImageInterface
end;


function TExtractImage.GetImagePath: WideString;
var
  Size: TSize;
  Buffer: PWideChar;
begin
  if Assigned(ExtractImageInterface) then
  begin
    GetMem(Buffer, MAX_PATH * 4);
    try
      try
        Size.cx := Width;
        Size.cy := Height;
        if ExtractImageInterface.GetLocation(Buffer, MAX_PATH, FPriority, Size,
              ColorDepth, FFlags) = NOERROR then
        begin
          Result := Buffer;
          PathExtracted := True
        end
        else
          Result := '';
      finally
        FreeMem(Buffer);
      end
    except
      Result := ''
    end;
  end;
end;