轉載，實現IExtractImage介面

Whenever you use the thumbnail view in the shell, the shell will display a small preview of the file; in order to produce the preview the shell uses the IExtractImage interface wich is declared as follows:

  IExtractImage = interface(IUnknown)
    ['{BB2E617C-0920-11d1-9A0B-00C04FC2D6C1}']
    function GetLocation(Buffer: PWideChar; BufferSize: DWORD;
                         Priority: PDWORD; const Size: TSize;
                         ColorDepth: DWORD; Flags: PDWORD ): HResult; stdcall;
    function Extract(var BmpImage: HBITMAP): HResult; stdcall;
  end;

  IExtractImage2 = interface(IExtractImage)
    ['{953BB1EE-93B4-11d1-98A3-00C04FB687DA}']
    function GetDateStamp(var DateStamp : TFILETIME) : hresult; stdcall;
  end;

Source: http://www.whirlingdervishes.com/nselib/delphi/samples/source.php

In order to implement IExtractImage you need to implement IPersistFile, IExtractImage2 is implemented if you are going to use the shell built-in cache features, more on that later

Lets begin the with a simple yet, open IExtractImage implementation:

unit Thumbnails;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  Windows, ActiveX, Classes, ComObj, cbTools, Graphics;

type
  TCustomThumbnail = class(TComObject, IPersist, IPersistFile, IExtractImage)
  private
    FFileName: String;
    FFileError: Boolean;
    FPic: TPicture;

    function GetIsEnabled: Boolean; virtual;
    function GetWorkOnDisc: Boolean;
    function GetWorkOnRemote: Boolean;
    function GetIsFileLocked: Boolean;
    function GetThumbError: String;
  protected
     procedure LogWrite(const Data: String; Level: TLoggerLevel); virtual; abstract;
     procedure ExtractThumb; virtual; abstract;
    {IPersistFile}
    function GetClassID(out classID: TGUID): HRESULT; stdcall;
    function GetCurFile(out pszFileName: PWideChar): HRESULT; stdcall;
    function IsDirty: HRESULT; stdcall;
    function Load(pszFileName: PWideChar; dwMode: Integer): HRESULT; stdcall;
    function Save(pszFileName: PWideChar; fRemember: LongBool): HRESULT; stdcall;
    function SaveCompleted(pszFileName: PWideChar): HRESULT; stdcall;
    {IExtractImage}
    function Extract(var BmpImage: HBITMAP): HRESULT; stdcall;
    function GetLocation(Buffer: PWideChar; BufferSize: Cardinal;
      Priority: PDWORD; const Size: TSIZE; ColorDepth: Cardinal;
      Flags: PDWORD): HRESULT; stdcall;
  public
    property Enabled: Boolean  read   GetIsEnabled;
    property OnDisc: Boolean   read   GetWorkOnDisc;
    property OnRemote: Boolean read   GetWorkOnRemote;
    property FileName: String  read   FFileName;
    property FileLocked: Boolean read GetIsFileLocked;
    property Error: Boolean    read   FFileError          write FFileError;
    property ErrorThumb: String read  GetThumbError;
    property Picture: TPicture read   FPic;
  end;

implementation

uses ComServ, GraphicEx, SysUtils;

function IsInCD(Const FileName: String; Flags: Cardinal): Boolean;
begin
  Result := GetDriveType( PChar( ExtractFileDrive( FileName ) ) ) = Flags;
end;

procedure MakeThumbnail(Image: TPicture; SizeX, SizeY: Integer);
var
  ABitmap: Graphics.TBitmap;
begin
  ABitmap := Graphics.TBitmap.Create;

  if not (Image.Graphic is Graphics.TBitmap) then
  begin
    with ABitmap do
    begin
      PixelFormat := pf24Bit;
      Width := Image.Width;
      Height := Image.Height;
      Canvas.Draw(0, 0, Image.Graphic);
    end;
    Image.Bitmap.Assign( ABitmap );
  end;

  ABitmap.PixelFormat := pf24bit;
  ABitmap.Width := SizeX;
  ABitmap.Height := SizeY;
  ABitmap.Palette := Image.Bitmap.Palette;

  SetStretchBltMode(ABitmap.Canvas.Handle, COLORONCOLOR);
  StretchBlt(ABitmap.Canvas.Handle, 0, 0, SizeX, SizeY, Image.Bitmap.Canvas.Handle, 0, 0,
    Image.Bitmap.Width, Image.Bitmap.Height, SRCCOPY);
  Image.Bitmap.Assign( ABitmap );

  ABitmap.Free;
end;

{ TCustomThumbnail }

function TCustomThumbnail.GetThumbError: String;
begin
  Result := '';
end;

function TCustomThumbnail.GetIsEnabled: Boolean;
begin
  Result := False;
end;

function TCustomThumbnail.GetIsFileLocked: Boolean;
var
  hFile: THandle;
begin
  hFile := CreateFile ( PChar(FFileName), GENERIC_READ, FILE_SHARE_READ, nil,
             OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0 );
  Result := hFile = INVALID_HANDLE_VALUE;
  CloseHandle( hFile );
end;

function TCustomThumbnail.GetWorkOnDisc: Boolean;
begin
  Result := True;
end;

function TCustomThumbnail.GetWorkOnRemote: Boolean;
begin
  Result := True;
end;

function TCustomThumbnail.GetLocation(Buffer: PWideChar; BufferSize: Cardinal;
  Priority: PDWORD; const Size: TSIZE; ColorDepth: Cardinal; Flags: PDWORD): HRESULT;
var
  Tmp: String;
begin
  if (Priority<>nil) then
     Priority^:=IEI_PRIORITY_NORMAL;

  Result := NOERROR;
  if (Flags<>nil) then //more on flags later
  begin
    if (Flags^ and IEIFLAG_ASYNC) <> 0 then
      Result := E_PENDING;
    Flags^ := Flags^ + IEIFLAG_CACHE + IEIFLAG_REFRESH;
  end;

  FPic := TPicture.Create;
  if not FFileError then
    ExtractThumb;

  if FFileError then
  begin
    Tmp := GetThumbError;
    if FileExists( Tmp ) then
    begin
      try
        FPic.Graphic.LoadFromFile( Tmp );
      except
        FPic.Free;
        FPic := nil;
        Result := E_FAIL;
      end;
    end else begin
      Result := E_FAIL;
      Exit;
    end;
  end;

  if Assigned( FPic ) then
    MakeThumbnail( FPic, Size.cx, Size.cy );
end;

function TCustomThumbnail.Extract(var BmpImage: HBITMAP): HRESULT;
begin
  try
    BmpImage := CopyImage(FPic.Bitmap.Handle, IMAGE_BITMAP, 0,0,0);
    Result := S_OK;
  finally
    if Assigned( FPic ) then
      FPic.Free;
    FPic := nil;
  end;
end;

function TCustomThumbnail.GetClassID(out classID: TGUID): HRESULT;
begin
  Result := E_NOTIMPL;
end;

function TCustomThumbnail.GetCurFile(out pszFileName: PWideChar): HRESULT;
begin
  Result := E_NOTIMPL;
end;

function TCustomThumbnail.IsDirty: HRESULT;
begin
  Result := E_NOTIMPL;
end;

function TCustomThumbnail.Load(pszFileName: PWideChar; dwMode: Integer): HRESULT;
begin
  FFileName := pszFileName;
  Result := S_OK;

  FFileError := GetIsFileLocked;

  if not Enabled then
  begin
    Result := E_FAIL;
    Exit;
  end;

  if IsInCD( FFileName, DRIVE_CDROM ) then
  begin
    if GetWorkOnDisc then
    begin
      Result := E_FAIL;
      Exit;
    end;
  end;

  if IsInCD( FFileName, DRIVE_REMOTE ) then
  begin
    if GetWorkOnRemote then
    begin
      Result := E_FAIL;
      Exit;
    end;
  end;
end;

function TCustomThumbnail.Save(pszFileName: PWideChar; fRemember: LongBool): HRESULT;
begin
  Result := E_NOTIMPL;
end;

function TCustomThumbnail.SaveCompleted(pszFileName: PWideChar): HRESULT;
begin
  Result := E_NOTIMPL;
end;

end.

As you see IPersistFile.Load is the only method of IPersistFile wich needs implementation, so a very basic implementation is used, also note that in order to compile you will need graphicex library by mike lischke (at http://delphi-gems.com/)

Now on the IExtractImage.GetLocation method flags, those flags can be:

Const
  IEIFLAG_ASYNC      = $0001;      
  IEIFLAG_CACHE      = $0002;      
  IEIFLAG_ASPECT     = $0004;      
  IEIFLAG_OFFLINE    = $0008;      
  IEIFLAG_GLEAM      = $0010;      
  IEIFLAG_SCREEN     = $0020;      
  IEIFLAG_ORIGSIZE   = $0040;      
  IEIFLAG_NOSTAMP    = $0080;      
  IEIFLAG_NOBORDER   = $0100;      
  IEIFLAG_QUALITY    = $0200;      
  IEIFLAG_REFRESH    = $0400;      

IEIFLAG_ASYNC is set if the object is free-threaded or the extraction is performed in the background, if the extension is supports that, it should result E_PENDING in GetLocation

IEIFLAG_CACHE is set if you desire to let the shell cache the resulting images, if you set this flag, it is recommended that you provide IExtractImage2 interface so that the shell can tell when the thumbnail last was updated

IEIFLAG_REFRESH is set if you desire the shell to provide a “Refresh thumbnail” option

IEIFLAG_OFFLINE is set to indicate that internet explorer should not connect if there are remote items

More on the flags can be obtained on MSDN

Also note that I have provided a empty extension, fill it to preview images of any type, also note that the shell is instructed to cache the images however it will not check the cache since we aren’t implementing IExtractImage2 in order to register the extension you will need a class factory such as the following:

type

  TThumbnailFactory = class( TComObjectFactory )

  public

    procedure UpdateRegistry(Register: Boolean); override;

  end;

{ TCBZThumbnailFactory }

procedure RegisterWin32NT(Const ClassID, Description: String; Register: Boolean);

begin

  if (Win32Platform = VER_PLATFORM_WIN32_NT) then

    with TRegistry.Create do

      try

        RootKey := HKEY_LOCAL_MACHINE;

        OpenKey('SOFTWARE/Microsoft/Windows/CurrentVersion/Shell Extensions', True);

        OpenKey('Approved', True);

        if Register then

          WriteString(ClassID, Description)

        else

          DeleteValue(ClassID)

      finally

         Free;

      end;

end;

procedure TCBRThumbnailFactory.UpdateRegistry(Register: Boolean);

var

  ClassID: String;

begin

  ClassID := GUIDToString( Class_CBRThumbnails );

  if Register then

  begin

    inherited UpdateRegistry( Register );

    CreateRegKey('EXTENSION/shellex/{BB2E617C-0920-11d1-9A0B-00C04FC2D6C1}','',

        ClassID);

    RegisterWin32NT(ClassID, Description, Register);

  end else begin

    DeleteRegKey('EXTENSION/shellex/{BB2E617C-0920-11d1-9A0B-00C04FC2D6C1}');

    RegisterWin32NT( ClassID, Description, Register);

    inherited UpdateRegistry( Register )

  end;

end;

Where EXTENSION is the file extension you are desire to preview