设计一款小巧图标库浏览程序

[返回]
计算机世界2000年第34期

设计一款小巧图标库浏览程序

浙江巨化集团公司物资装备分公司胡小文

　　有一张光盘提供了5000多个256色的各种各样的图标的压缩文件，解压后按动物、人物、计算机、网络等门类分类放置在一个个图标库（icon library）文件中（后缀为ICL），使用起来相当不方便。笔者利用Delphi3.0开发了一个这样的程序，它可以浏览这些图标库中所有的图标，并且把自己所需要的图标以Icon的文件格式保存起来，支持直接从文件夹图标库文件到程序的拖放，自动建立ICL文件的关联，以后你只要双击ICL文件就可以打开。具体实现过程如下。

　　文件夹图标库文件到程序的拖放
　　要使一个程序可以支持从文件夹的直接拖放，在程序初始化时要运行Windows API函数：dragacceptFiles(handle,true); 其中handle是接受文件拖放的窗口句柄，true表示为接受，false表示拒绝接受。一旦你设置为接受后，程序运行时如果有文件拖放到该窗口，系统将把消息WM_DROPFiles发送到你的程序。程序中必须对该消息做出处理，可用的Windows API函数是DragQueryFile和DragFinish，其中 DragQueryFile是获取拖放过来的文件名，DragFinish是告诉系统该拖放操作完成。这两个函数和WM_DropFiles消息的详细资料请查阅Windows API手册。
　　ICL文件关联的建立
　　Windows文件关联的建立实际是对注册表进行一些操作。在HKEY_CLASSES_ROOT中建立一系列的键和设置相关的键值。具体步骤如下：

在HKEY_CLASSES_ROOT中建立“．ICL”键，并且默认的键值设置为 “ICL_Auto_File”；

在HKEY_CLASSES_ROOT中建立“ICL_Auto_File”键，并且默认的键值设置为“图标库关联文件程序”；

在HKEY_CLASSES_ROOT中“ICL_Auto_File”键下设立三级子键：shellopen command；

为command这级子键默认的键值设置为：“<程序名称>” 1％。其中程序名包含程序的绝对路径。

　　图标库图标的获得
　　在Windows API中有许多获取图标的函数，但能从图标库ICL文件中获取图标的函数是ExtractIconEx，它的格式和参数如下：
　　Uint ExtractIconExA(lpszFile: PAnsiChar; 
　　nIconIndex: Integer; 
　　var phiconLarge, phiconSmall: HICON;
　　nIcons:  UINT);
　　lpszFile:图标库的文件名；
Niconindex: 要读取的图标在图标库中
         的次序（从0开始编号）；
PhiconLarge、Phiconsmall:
     如果读取成功时图标的句柄值；
　　Nicons:要读取的图标个数，通常设置为1；
　　该函数返回的值如果是0，表示读取失败。
　　要枚举一个图标库中的所有图标，只要利用以上函数读取序号0图标、序号1图标....直到函数返回值为0。
　　图标库图标的显示
　　图标库的图标的显示方法有很多，在Delphi中提供了列表框，用户通过自己绘制列表项来列表实现非文字显示。方法是：

把列表框的风格(Style)设置为用户自己绘制的lbOwnerDrawVariable模式；

重载OnDrawItem和OnMeasureItem事件，OnMeasureItem事件计算列表项显示所需要的方框尺寸高度，OnDrawItem绘制列表项。两个事件都有Index参数，它是对应列表框的列表项次序（从0开始编号）。笔者是把图标库图标序号作为列表框的列表项，也就是列表框中的列表项是一组序号，然后通过序号来进行图标的显示处理工作。

　　图标库图标的保存
　　把图标库中喜欢的图标保存下来，只要利用Ticon类的方法SaveToFile。笔者在程序中设置了Tpopupmenu控件popupmenu1和TsaveDialog控件 Savedialog1，把Listbox1的popupmenu属性设置为Popupmenu1，这样当在Listbox1控件右击时弹出Popupmenu1菜单，选择SaveAs菜单项后就可以保存到用户指定的一个文件中。
　　程序清单
　　unit iconlibreadsource;
　　interface
　　uses
　　  Windows, Messages, SysUtils, Classes, Graphics,
       Controls, Forms, Dialogs,StdCtrls, Menus;
　　type
　　  TForm1 = class(TForm)
　　    ListBox1: TListBox;
　　    SaveDialog1: TSaveDialog;
　　    PopupMenu1: TPopupMenu;
　　    Save1: TMenuItem;
　　    N1: TMenuItem;
　　    eXit1: TMenuItem;
　　   procedure ListBox1DrawItem(Control:
       TWinControl; Index: Integer;Rect: TRect;
         State: TOwnerDrawState);
　　   procedure ListBox1MeasureItem
        (Control: TWinControl; Index: Integer;var Height: Integer);
　　    procedure FormCreate(Sender: TObject);
　　    procedure eXit1Click(Sender: TObject);
　　    procedure Save1Click(Sender: TObject);
　　   procedure FormClose(Sender: 
          TObject; var Action: TCloseAction);
private
　　    iconlibname:string；//当前图标库文件名
　　    Icon:TIcon;  
　　    Procedure handlemsg 
         (var Msg: TMsg; var Handled: Boolean);   
　　  end;
　　var
　　  Form1: TForm1;
　　implementation
　　uses shellapi,registry;
　　{＄R ＊.DFM}
　　var
　　  smallicon,largeicon  :Hicon;
　　  iconindex            :Uint;
　　//处理WM_DropFile消息
Procedure TForm1.handlemsg 
 (var Msg: TMsg; var Handled: Boolean);
　　 var
　　    Fname  :pchar;
　　 begin
　　   if msg.message=wm_DropFiles then
　　      begin
　　        getmem(Fname,250);
dragqueryFile(msg.wParam,0,fname,250);
      //取拖放到程序的文件名
    dragFinish(msg.wParam);
    //重新形成列表框的列表
    listbox1.Items.Clear;
　　iconlibname:=string(Fname);
　　iconindex:=0;
while Extracticonex(pchar(iconlibname),
 iconindex,smallicon,largeicon,1)>0 do
　　begin
　　listbox1.items.add(intTostr(iconindex));
　　inc(iconindex);
　　end;
　　if listbox1.Items.count>0
　　then listbox1.PopupMenu:=popupmenu1
　　else listbox1.popupmenu:=nil;
　　freemem(Fname,250);
　　handled:=true;
　　end;
　　end;
//以下是重载OnDrawItem和OnMeasureItem
 事件实现图标在列表框中的显示
procedure TForm1.ListBox1DrawItem
(Control: TWinControl; Index: Integer；
Rect: TRect; State: TOwnerDrawState);
　　begin
　　   Extracticonex(pchar(iconlibname),
          index,smallicon,largeicon,1);
　　   Icon.handle:=Smallicon;
　　   with listbox1.canvas do
　　    begin
　　      FillRect(Rect);
　　      draw(rect.left＋1,Rect.top＋1,Icon);
　　    end;
　　end;
procedure TForm1.ListBox1MeasureItem
 (Control: TWinControl; Index: Integer;var Height: Integer);
　　begin
　　  Extracticonex(pchar(iconlibname),index,smallicon,largeicon,1);
　　  Icon.handle:=Smallicon;
　　  with listbox1.canvas do height:=icon.height＋2;
　　end;
    //以下是程序初始化并且自动建立ICL的文件关联
　　procedure TForm1.FormCreate(Sender: TObject);
　　var
    regICL   :TRegistry;
    begin
    regICL:=TRegistry.Create;
　　regICL.RootKey:=HkEY_CLASSES_ROOT;
if not(regICL.keyexists(‘。ICL')) then   
  //如果没有建立关联
    begin
　　regICL.openkey(‘。ICL',true); 
    regICL.writestring(“,‘icl_auto_file');
    regICL.openkey(‘cl_auto_file',true);
    regICL.writestring(‘’,‘图标库的关联程序');
　　regICL.openkey(‘\icl_auto_file\shell\open\command',true);
regICL.WriteString(‘’，‘ “’
 ＋application.exename＋‘" ％1');
　　end;
    regICL.free;
　　if paramcount<1 then halt(1);
　　icon:=Ticon.create;
　　//利用getcommandline取得命令行参数 
　　iconlibname:=getcommandline;
//注意在Windows的命令行中主程序是全路径
//并且用双引号括起
　　delete(iconlibname,1,length(application.exename)＋2); 
　　iconlibname:=trim(iconlibname);
　　//形成列表框项
　　iconindex:=0;
while Extracticonex(pchar(iconlibname),
 iconindex,smallicon,largeicon,1)>0 do
　　begin
　　listbox1.items.add(intTostr(iconindex));
　　inc(iconindex);
　　end;
　　if listbox1.Items.count>0 then
　　listbox1.PopupMenu:=popupmenu1;
　　dragacceptFiles(handle,true);   //允许程序接受拖放文件
application.onmessage:=handlemsg;
  //指定处理WM_DropFiles的函数
　　end;
　　//保存指定图标
　　procedure TForm1.Save1Click(Sender: TObject);
　　begin
　　if savedialog1.Execute then
　　begin
 savedialog1.filename:=changeFileex(savedialog1.filename,‘.ico');
　　if listbox1.ItemIndex=－1 
    then listbox1.itemindex:=0;
Extracticonex(pchar(iconlibname),
 listbox1.itemindex,smallicon,largeicon,1);
　　icon.handle:=smallicon;
　　icon.SaveToFile(savedialog1.Filename);
　　end;
　　end;
　　procedure TForm1.eXit1Click(Sender: TObject);
　　begin  
　　close;  
　　end;
procedure TForm1.FormClose
 (Sender: TObject; var Action: TCloseAction);
　　begin  
　　icon.free;  
　　end;
　　end.
　　这样一个图标库浏览程序就建立好了，你可以把图标库直接拖放到程序中，也可以双击这些图标库文件，可以看到丰富多彩的图标！

作者邮箱：hxw999@china.com 　