Reprinted to implement the iextractimage Interface

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 bmp image: 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 bmp image: 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_1__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 bmp image: hbitmap): hresult;
Begin
Try
BMP image: = copyimage (FPIC. bitmap. Handle, image_bitmap, 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 already med in the background, if the extension is supports that, It shoshould 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 shocould 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 being ucted 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 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 extension', true );

Openkey ('apache', 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