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 < SL.Count)
and (I < 3)
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
Sign Up
