，实现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: Booleanread GetIsEnabled;
property OnDisc: Boolean read GetWorkOnDisc;
property OnRemote: Boolean read GetWorkOnRemote;
property FileName: Stringread FFileName;
property FileLocked: Boolean read GetIsFileLocked;
property Error: Booleanread FFileErrorwrite FFileError;
property ErrorThumb: String readGetThumbError;
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