2004. november 22., hétfő

Creating a simple Icon Handler for the Windows Explorer


Problem/Question/Abstract:

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 < 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.


Component Download: http://www.gatenetwork.com/delphi-samples/iconhandler.zip

Nincsenek megjegyzések:

Megjegyzés küldése