Use the IExtractImage interface to get image thumbnails from Windows (Views: 29)
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; |