Mega Code Archive
Creating a simple Icon Handler for the Windows Explorer
<![CDATA[
Title: Creating a simple Icon Handler for the Windows Explorer
Question: Some of you might have wondered how automatically every Icon file automatically displays its own icon in the windows explorer. Especially some design and paint applications use this possibility to show the content of a file rather than the same icon for all of them.
Answer:
Getting across the point
This article shows you how to create a simple icon handler for windows text (*.txt) files that will display the first characters rather than the default icon.
Default view
Text icons using Icon Handler
The sample given here will only show you the outline of such a project, but this should be sufficient to get you started on your journey. The Icon handler will create large icons only, so the explorer will shrink them rather ugly. However, it is rather simple to extend the functionality.
Getting started
We'll have to create an in-process server DLL that will export the interfaces IExtractIcon and IPersistFile. Most of the methods we need to declare do not need to be actually implemented, because they are never used. We will simply return E_NOTIMPL for these methods. All we have to do is to provide handling for three of the methods.
Load
The Windows Explorer will pass along the file name of the file we have to create the icon for. We'll simple save the name in a variable.
GetIconLocation
We'll tell the Windows Explorer that it must call yet another procedure, because we must create the icon from scratch. Further we set some flags for caching and similar handling.
Extract
That's were we actually create the Icon. First we extract the desired size of the icon. Next, we create the bitmaps for the AND mask and the XOR mask. On the XOR mask we will write up to the first 3 lines of text from the text file. This does not really give a preview, however it shows the point for custom icons.
Last we are going to tell windows to create the icon desired and return it to the explorer. And we are done.
Registering the Icon Handler
First we will have to access the Registry. Assuming that your Text files will point to the entry HKCR\txtfile we will first back-up the old icon handler (key: DefaultIcon) and then set the new one. Further we register the IconHandler (Key: ShellEx\IconHandler). That's it.
To simplify the task of registering/deregistering the icon handler I have created a new class that is derived from TTypedComObjectFactory. There I'll simple override the method UpdateRegistry and we are done.
You can either register the DLL directly from Delphi or simply use Windows RegSvr32 utility.
Create your project
Create a new ACTIVE X library, add a type library to it and create a COM Object and name it TxtIcon. Finally paste the code below into the TxtIcon unit and compile it.
Note You may have to restart the computer (or the Windows Explorer using the Task Manager) to see the changes take effect.
You can simply download the code using this link.
THE CODE
unit TxtIcon;
interface
uses
Windows, ActiveX, Classes, ComObj, TxtViewer_TLB, StdVcl, ShlObj;
type
TTxtIcon = class(TTypedComObject, ITxtIcon, IExtractIcon, IPersistFile)
private
FCurrFile: WideString;
protected
{Declare ITxtIcon methods here}
// IExtractIcon
function GetIconLocation(uFlags: UINT; szIconFile: PAnsiChar; cchMax: UINT;
out piIndex: Integer; out pwFlags: UINT): HResult; stdcall;
function Extract(pszFile: PAnsiChar; nIconIndex: UINT;
out phiconLarge, phiconSmall: HICON; nIconSize: UINT): HResult; stdcall;
// IPersist
function GetClassID(out classID: TCLSID): HResult; stdcall;
// IPersistFile
function IsDirty: HResult; stdcall;
function Load(pszFileName: POleStr; dwMode: Longint): HResult;
stdcall;
function Save(pszFileName: POleStr; fRemember: BOOL): HResult;
stdcall;
function SaveCompleted(pszFileName: POleStr): HResult;
stdcall;
function GetCurFile(out pszFileName: POleStr): HResult;
stdcall;
end;
TIconHandlerFactory = class(TTypedComObjectFactory)
protected
public
procedure UpdateRegistry(Register: Boolean); override;
end;
implementation
uses
SysUtils, ComServ, Graphics, Registry;
{ TTxtIcon }
function TTxtIcon.Extract(pszFile: PAnsiChar; nIconIndex: UINT;
out phiconLarge, phiconSmall: HICON; nIconSize: UINT): HResult;
var
IconSize, I: Integer;
MaskAnd, MaskXor: TBitmap;
IconInfo: TIconInfo;
SL: TStringList;
begin
// draw the large icon
IconSize := Lo(nIconSize);
// create and prepare AND mask
MaskAnd := TBitmap.Create; try
MaskAnd.Monochrome := true;
MaskAnd.Width := IconSize;
MaskAnd.Height := IconSize;
MaskAnd.Canvas.Brush.Color := clBlack;
MaskAnd.Canvas.FillRect(Rect(0, 0, IconSize, IconSize));
// create and prepare XOR mask
MaskXor := TBitmap.Create; try
MaskXor.Width := IconSize;
MaskXor.Height := IconSize;
MaskXor.Canvas.Brush.Color := clWhite;
MaskXor.Canvas.FillRect(Rect(0, 0, IconSize, IconSize));
MaskXor.Canvas.Font.Color := clNavy;
// load file
SL := TStringList.Create; try
try
SL.LoadFromFile(FCurrFile);
I := 0;
// paint up to three lines of text onto the canvas
while (I and (I do
begin
MaskXor.Canvas.TextOut(0, I * 15, SL.Strings[I]);
Inc(I);
end;
except
// user may not have access rights
MaskXor.Canvas.TextOut(0, 0, '???');
end;
finally SL.Free; end;
// create icon for explorer
IconInfo.fIcon := true;
IconInfo.xHotspot := 0;
IconInfo.yHotspot := 0;
IconInfo.hbmMask := MaskAnd.Handle;
IconInfo.hbmColor := MaskXor.Handle;
// return large icon
phiconLarge := CreateIconIndirect(IconInfo);
// signal success
Result := S_OK;
finally MaskAnd.Free; end;
finally MaskXor.Free; end;
end;
function TTxtIcon.GetClassID(out classID: TCLSID): HResult;
begin
classID := CLASS_TxtIcon;
Result := S_OK;
end;
function TTxtIcon.GetCurFile(out pszFileName: POleStr): HResult;
begin
Result := E_NOTIMPL;
end;
function TTxtIcon.GetIconLocation(uFlags: UINT; szIconFile: PAnsiChar;
cchMax: UINT; out piIndex: Integer; out pwFlags: UINT): HResult;
begin
piIndex := 0;
pwFlags := GIL_DONTCACHE or GIL_NOTFILENAME or GIL_PERINSTANCE;
Result := S_OK;
end;
function TTxtIcon.IsDirty: HResult;
begin
Result := E_NOTIMPL;
end;
function TTxtIcon.Load(pszFileName: POleStr; dwMode: Integer): HResult;
begin
FCurrFile := pszFileName;
Result := S_OK;
end;
function TTxtIcon.Save(pszFileName: POleStr; fRemember: BOOL): HResult;
begin
Result := E_NOTIMPL;
end;
function TTxtIcon.SaveCompleted(pszFileName: POleStr): HResult;
begin
Result := E_NOTIMPL;
end;
{ TIconHandlerFactory }
procedure TIconHandlerFactory.UpdateRegistry(Register: Boolean);
var
ClsID: string;
begin
ClsID := GUIDToString(ClassID);
inherited UpdateRegistry(Register);
if Register then
begin
with TRegistry.Create do
try
RootKey := HKEY_CLASSES_ROOT;
if OpenKey('txtfile\DefaultIcon', True) then
try
WriteString('backup', ReadString(''));
WriteString('', '%1');
finally
CloseKey;
end;
if OpenKey('txtfile\shellex\IconHandler', True) then
try
WriteString('', ClsID);
finally
CloseKey;
end;
finally
Free;
end;
end else begin
with TRegistry.Create do
try
RootKey := HKEY_CLASSES_ROOT;
if OpenKey('txtfile\DefaultIcon', True) then
try
if ValueExists('backup') then
begin
WriteString('', ReadString('backup'));
DeleteValue('backup');
end;
finally
CloseKey;
end;
if OpenKey('txtfile\shellex', True) then
try
if KeyExists('IconHandler') then
DeleteKey('IconHandler');
finally
CloseKey;
end;
finally
Free;
end;
end;
end;
initialization
TIconHandlerFactory.Create(
ComServer, TTxtIcon, Class_TxtIcon, ciMultiInstance, tmApartment
);
end.
This sample is brought to you by the German Delphi Forum!
Daniel Wischnewski
]]>