注册系统相关

unit regftyp; 
(*************************************************************************** 
This is a unit to handle filetyp-associations in Win95/NT. The unit supports 
 
-Registration of a filetype 
-Adding extra-actions to an entry (Like ‘Edit‘ for Batch-Files) 
-Adding an entry to the ‘New‘-Context-Menu 
-Removing all the stuff that the unit can create.. 
 
Here the description of the procedures: 
 
 
RegisterFileType :   Registers a filetype 
 params: 
       ft   : the file-ext to create an association (.txt) 
       key  : the registry-key-name (not necessary) (txtfile) 
       desc : a description for the file-type       (Text-File) 
       icon : the default-icon (not necessary)      (Application.ExeName+‘,1‘) 
       prg  : the application                       (Application.ExeName 
 
 NOTES: 
       The number in the Icon-parameter describes the Index of the Icon in the 
       given filename. Note that it begins with 0 for the first icon 
 
 Example: 
       registerFileType(‘.rvc‘, 
                        ‘rvconfile‘, 
                        ‘RasInTask Connection‘, 
                        Application.ExeName+‘,1‘, 
                        Application.ExeName); 
 
----------------------- 
 
DeregisterFileType :    Removes the registration of a filetype 
 params: 
       ft   : the file-ext to create an association (.txt) (with point!!) 
 
 NOTES: 
       -This procedure kills all entries for our filetype. Also features like 
        extended actions and entries to the new-context-menu! 
 
 Example: 
       deregisterFileType(‘.tst‘); 
 
------------------------ 
 
FileTAddAction :          Adds an action to the ContextMenu of our filetype 
 params: 
       key     : the same as in the functions above  (txtfile) 
       name    : the name of the action (not necessary) (notepad) 
       display : this is shown in the contextMenu (Edit with Notepad) 
       action  : The Action to do 
 
 NOTES: 
       If you have set up the association with this unit and an empty ‘key‘, 
       please give here the file extension. 
       Other to the RegisterFileTpe-Call, you MUST set the FULL 
       action-parameter: 
       If you wish to open the file, you MUST write the %1 at the end, 
       because I think that there are many possibilities for an entry in the 
       Context-Menu, so I won‘t destroy many of them.. 
 
 Example: 
       FileTAddAction(‘rvconfile‘,‘edit‘,‘Edit‘,Application.ExeName+‘-e "%1"‘); 
 
------------------------ 
 
FileTDelAction :         Removes the created Action 
 params: 
       key     : the same as in the functions above  (txtfile) 
       name    : the name of the action              (notepad) 
 
 NOTES: 
       -If you have set up the association with this unit and an empty ‘key‘, 
        please give here the file extension. 
       -If you left the param ‘name‘ blank when you created the action, you 
        should give here the value of ‘display‘. 
       -Note that you have not to call this procedure if you wish to deregister 
        a filetype. My Procedure is very radical and kills the actions too... 
 
 
 Example: 
       FileTDelAction(‘rvconfile‘,‘edit‘); 
 
procedure FileTAddNew(ft, param: String; newType: TFileNewType); 
 
------------------------ 
 
FileTAddNew :         Adds an entry to the New-context-menu 
 params: 
       ft      : the extension of our file (with point!!) (.txt) 
       param   : for extended information (see NOTES)     (Application.ExeName+‘ -cn‘) 
       newType : the typ of the entry to create           (ftCommand) 
 
 NOTES: 
       -The parameter newType is of the type ‘TFileNewType‘ which must have one 
        of the following values: 
           ftNullFile    If the user clicks on our entry, windows will create 
                         a file with the size 0 bytes. The procedure parameter 
                         ‘param‘ is ignored 
           ftFileName    Windows will copy the File you give to this procedure 
                         in the ‘param‘-parameter. Useful, if your application 
                         reads a fileheader which must exist... 
           ftCommand     Windows launches the program you have given to this 
                         procedure in the ‘param‘-parameter. 
                         This can be used to display a wizzard 
 
       -If you use the ftCommand-type, please note that your Wizzard MUST 
        display a "Save As"-Dialog ore something like this, if you wish to 
        create a file: Windows does not copy or create a file in the folder 
        in which the user has clicked on our entry. 
 
 Example: 
       FileTAddNew(‘.tst‘,‘‘, ftNullFile); 
 
------------------------ 
 
FileTDelNew :         Removes our entry in the ‘New‘-ContextMenu 
 params: 
       ft      : the filetype of our file (with point!!)  (.txt) 
 
 NOTES: 
       -Note that you have not to call this procedure if you wish to deregister 
        a filetype. My Procedure is very radical and kills the actions too... 
 
 
 Example: 
       FileTDelNew(‘.tst‘); 
 
-------------------------------------------------------------------------------- 
 
I have written this unit for my Freeware(!) program RasInTask. It is a 
dialup-dialer with some extra-feature. 
 
For the version 1.1 I am now implementing a feature named "virtual connections", 
and I need to register filetypes. I do not know why Microsoft did not implement 
a "RegisterFiletype"-Function to the API. So the programmer has to do very to 
much of work. 
 
You can use this Unit when- and whereever you wish. It is freeware. 
 
Please visit my Homepage at http://www.mittelschule.ch/pilif/ for other cool 
tools or send an Email to pilit@dataway.ch or pilif@nettaxi.com 
 
Version 1.0 
 
History: none 
 
ToDo-List: 
 
I will add some Errorhandling. Since I did in the past never need to create 
exceptions, I do not know how to do this. I will add some as soon as I know 
how... 
 
*******************************************************************************) 
 
interface 
 
uses windows,registry,dialogs; 
 
type 
     TFileNewType = (ftNullFile, ftFileName, ftCommand); //This is the type of 
                                                        //entry to add to the 
                                                        //new-menu 
 
procedure registerfiletype(ft,key,desc,icon,prg:string); 
procedure deregisterFileType(ft: String); 
procedure FileTAddAction(key, name, display, action: String); 
procedure FileTDelAction(key, name: String); 
procedure FileTAddNew(ft, param: String; newType: TFileNewType); 
procedure FileTDelNew(ft: String); 
 
implementation 
 
procedure FileTDelNew(ft: String); 
var myReg:TRegistry; 
begin 
myReg:=TRegistry.Create; 
myReg.RootKey:=HKEY_CLASSES_ROOT; 
if not myReg.KeyExists(ft) then 
 begin 
 MyReg.Free; 
 Exit; 
 end; 
MyReg.OpenKey(ft, true); 
if MyReg.KeyExists(‘ShellNew‘) then 
 MyReg.DeleteKey(‘ShellNew‘); 
MyReg.CloseKey; 
MyReg.Free; 
end; 
 
procedure FileTAddNew(ft, param: String; newType: TFileNewType); 
var myReg:TRegistry; 
begin 
myReg:=TRegistry.Create; 
myReg.RootKey:=HKEY_CLASSES_ROOT; 
if not myReg.KeyExists(ft) then 
 begin 
 MyReg.Free; 
 Exit; 
 end; 
myReg.OpenKey(ft+‘\ShellNew‘, true); 
case NewType of 
 ftNullFile : MyReg.WriteString(‘NullFile‘, ‘‘); 
 ftFileName : MyReg.WriteString(‘FileName‘, param); 
 ftCommand  : MyReg.WriteString(‘Command‘, param); 
end; 
MyReg.CloseKey; 
MyReg.Free; 
end; 
 
procedure FileTDelAction(key, name: String); 
var myReg: TRegistry; 
begin 
myReg:=TRegistry.Create; 
myReg.RootKey:=HKEY_CLASSES_ROOT; 
 
if key[1] = ‘.‘ then 
 key := copy(key,2,maxint)+‘_auto_file‘; 
 
if key[Length(key)-1] <> ‘\‘ then //Add a \ if necessary 
 key:=key+‘\‘; 
myReg.OpenKey(‘\‘+key+‘shell\‘, true); 
if myReg.KeyExists(name) then 
 myReg.DeleteKey(name); 
myReg.CloseKey; 
myReg.Free; 
end; 
 
procedure FileTAddAction(key, name, display, action: String); 
var 
myReg:TRegistry; 
begin 
myReg:=Tregistry.Create; 
myReg.RootKey:=HKEY_CLASSES_ROOT; 
if name=‘‘ then name:=display; 
 
if key[1] = ‘.‘ then 
 key:= copy(key,2,maxint)+‘_auto_file‘; 
 
if key[Length(key)-1] <> ‘\‘ then //Add a \ if necessary 
 key:=key+‘\‘; 
if name[Length(name)-1] <> ‘\‘ then //dito. For only two calls, I won‘t write a function... 
 name:=name+‘\‘; 
 
myReg.OpenKey(key+‘Shell\‘+name, true); 
myReg.WriteString(‘‘, display); 
MyReg.CloseKey; 
MyReg.OpenKey(key+‘Shell\‘+name+‘Command\‘, true); 
MyReg.WriteString(‘‘, action); 
myReg.Free; 
end; 
 
 
procedure deregisterFileType(ft: String); 
var 
 myreg:TRegistry; 
 key: String; 
begin 
myreg:=TRegistry.Create; 
myReg.RootKey:=HKEY_CLASSES_ROOT; 
myReg.OpenKey(ft, False); 
key:=MyReg.ReadString(‘‘); 
MyReg.CloseKey; 
//showMEssage(key); 
myReg.DeleteKey(ft); 
myReg.DeleteKey(key); 
myReg.Free; 
end; 
 
procedure registerfiletype(ft,key,desc,icon,prg:string); 
var myreg : treginifile; 
    ct : integer; 
begin 
//   RegisterFileType(‘.tst‘, ‘testfile‘, ‘A Testfile‘, ‘‘, 
//                    Application.ExeName); 
 
     // make a correct file-extension 
     ct := pos(‘.‘,ft); 
     while ct > 0 do begin 
           delete(ft,ct,1); 
           ct := pos(‘.‘,ft); 
     end; 
     if (ft = ‘‘) or (prg = ‘‘) then exit; //not a valid file-ext or ass. app 
     ft := ‘.‘+ft; 
     myreg := treginifile.create(‘‘); 
     try 
        myreg.rootkey := hkey_classes_root; // where all file-types are described 
        if key = ‘‘ then key := copy(ft,2,maxint)+‘_auto_file‘; // if no key-name is given, 
                                                             // create one 
        myreg.writestring(ft,‘‘,key); // set a pointer to the description-key 
        myreg.writestring(key,‘‘,desc); // write the description 
        if icon <> ‘‘ then 
           myreg.writestring(key+‘\DefaultIcon‘,‘‘,icon); // write the def-icon if given 
        myreg.writestring(key+‘\shell\open\command‘,‘‘,prg+‘ "%1"‘); //association 
     finally 
            myreg.free; 
     end; 
//     showmessage(‘File-Type ‘+ft+‘ associated with‘#13#10+ 
//     prg+#13#10); 
 
 
 
end; 
end. 







unit Unit1; 
 
interface 
 
uses 
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
  StdCtrls; 
 
type 
  TForm1 = class(TForm) 
    Button1: TButton; 
    Button2: TButton; 
    Button3: TButton; 
    Button4: TButton; 
    Button5: TButton; 
    Button6: TButton; 
    Button7: TButton; 
    Button8: TButton; 
    Label1: TLabel; 
    procedure Button1Click(Sender: TObject); 
    procedure Button2Click(Sender: TObject); 
    procedure Button3Click(Sender: TObject); 
    procedure Button4Click(Sender: TObject); 
    procedure Button5Click(Sender: TObject); 
    procedure Button6Click(Sender: TObject); 
    procedure Button7Click(Sender: TObject); 
    procedure Button8Click(Sender: TObject); 
  private 
    { Private-Deklarationen } 
  public 
    { Public-Deklarationen } 
  end; 
 
var 
  Form1: TForm1; 
 
implementation 
 
uses regftyp; 
 
{$R *.DFM} 
 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
RegisterFileType(‘.tst‘, ‘testfile‘, ‘A Testfile‘, ‘‘, Application.ExeName); 
ShowMessage(‘.tst-Files are now registered under the type ‘‘A Testfile‘‘‘); 
end; 
 
procedure TForm1.Button2Click(Sender: TObject); 
var f:TextFile; 
begin 
 AssignFile(f, ExtractFilePath(Application.ExeName)+‘test.tst‘); 
 Rewrite(f); 
 writeln(f, ‘This is a simple test‘); 
 closeFile(f); 
 ShowMessage(‘File Created: ‘+ExtractFilePath(Application.ExeName)+‘test.tst‘); 
end; 
 
procedure TForm1.Button3Click(Sender: TObject); 
begin 
FileTAddAction(‘testfile‘, ‘edit‘, ‘Edit with Notepad‘, ‘Notepad "%1"‘); 
ShowMessage(‘‘‘Edit with Notepad‘‘ added to the context menu of all .tst-Files!‘); 
end; 
 
procedure TForm1.Button4Click(Sender: TObject); 
begin 
FileTAddNew(‘.tst‘, ‘‘, ftNullFile); 
ShowMessage(‘The entry ‘‘A Testfile‘‘ is now added to the ‘‘New‘‘-contextmenu‘+#13+#13+ 
            ‘Before you test the next 4 Buttons, please have a look at the‘+#13+ 
            ‘directory of this Application (‘+ExtractFilePath(Application.ExeName)+ 
            ‘)‘+#13+‘to see, what you have done while clicking the first 4 buttons!‘); 
            end; 
 
procedure TForm1.Button5Click(Sender: TObject); 
begin 
FileTDelNew(‘.tst‘); 
ShowMessage(‘Entry deleted from the new-context-Menu‘); 
end; 
 
procedure TForm1.Button6Click(Sender: TObject); 
begin 
FileTDelAction(‘testfile‘, ‘edit‘); 
ShowMessage(‘Action deleted from the context-Menu‘); 
 
end; 
 
procedure TForm1.Button7Click(Sender: TObject); 
begin 
DeregisterFileType(‘.tst‘); 
end; 
 
procedure TForm1.Button8Click(Sender: TObject); 
begin 
DeleteFile(ExtractFilePath(Application.ExeName)+‘test.tst‘); 
showMessage(‘File deleted‘); 
end; 
 
end. 

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    procedure WMHotKey(var Msg: TWMHotKey); message WM_HOTKEY;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

var
  HotKeyId: array[0..12] of Integer;  //热键数组, 这里准备定义 13 个热键

procedure TForm1.FormCreate(Sender: TObject);
var
  i: Integer;
begin
  //注册热键
  for i := Low(HotKeyId) to High(HotKeyId) do
    HotKeyId[i] := GlobalAddAtom(PChar(IntToStr(i)));  //热键命名可随意
  RegisterHotKey(Handle,HotKeyId[0],0,VK_F2);                //F2
  RegisterHotKey(Handle,HotKeyId[1],0,VK_UP);                //Up
  RegisterHotKey(Handle,HotKeyId[2],0,VK_DOWN);              //Down
  RegisterHotKey(Handle,HotKeyId[3],0,VK_LEFT);              //Left
  RegisterHotKey(Handle,HotKeyId[4],0,VK_RIGHT);             //Right
  RegisterHotKey(Handle,HotKeyId[5],0,VK_PRIOR);             //PageUp
  RegisterHotKey(Handle,HotKeyId[6],0,VK_NEXT);              //PageDown
  RegisterHotKey(Handle,HotKeyId[7],0,VK_OEM_PLUS);          //+
  RegisterHotKey(Handle,HotKeyId[8],0,VK_OEM_MINUS);         //-
  RegisterHotKey(Handle,HotKeyId[9],0,$31);                  //1
  RegisterHotKey(Handle,HotKeyId[10],0,$41);                 //a
  RegisterHotKey(Handle,HotKeyId[11],0,VK_RETURN);           //Enter
  RegisterHotKey(Handle,HotKeyId[12],MOD_CONTROL,VK_RETURN); //Ctrl+Enter
end;

//热键
procedure TForm1.WMHotKey(var Msg: TWMHotKey);
begin
  if Msg.HotKey = HotKeyId[0] then ShowMessage(‘F2‘);
  if (Msg.HotKey=HotKeyId[1]) then ShowMessage(‘Up‘);
  if (Msg.HotKey=HotKeyId[2]) then ShowMessage(‘Down‘);
  if (Msg.HotKey=HotKeyId[3]) then ShowMessage(‘Left‘);
  if (Msg.HotKey=HotKeyId[4]) then ShowMessage(‘Right‘);
  if Msg.HotKey = HotKeyId[5] then ShowMessage(‘PageUp‘);
  if Msg.HotKey = HotKeyId[6] then ShowMessage(‘PageDown‘);
  if Msg.HotKey = HotKeyId[7] then ShowMessage(‘+‘);
  if Msg.HotKey = HotKeyId[8] then ShowMessage(‘-‘);
  if Msg.HotKey = HotKeyId[9] then ShowMessage(‘1‘);
  if Msg.HotKey = HotKeyId[10] then ShowMessage(‘a‘);
  if Msg.HotKey = HotKeyId[11] then ShowMessage(‘Enter‘);
  if Msg.HotKey = HotKeyId[12] then ShowMessage(‘Ctrl+Enter‘);
end;

procedure TForm1.FormDestroy(Sender: TObject);
var
  i: Integer;
begin
  //注销热键
  for i := Low(HotKeyId) to High(HotKeyId) do
  begin
    UnRegisterHotKey(handle,HotKeyId[i]);
    GlobalDeleteAtom(HotKeyId[i]);
  end;
end;

end.

实现一个热键注册编辑的类
CST（http://blog.csdn.net/mrtechno） 2005-8-19
 
 
1 文档目的... 1
2 热键编程基础... 1
2.1 API函数... 1
2.2 编程方法... 2
3 实现概述... 4
4 实现细节... 4
4.1 XML配置文档结构... 4
4.2 热键编辑控件 ThotKeyEdit5
4.3 热键自定义窗体类TformHotKeyconfig. 6
4.4 主类ThotKeyConfig. 6
4.4.1 解析XML文档... 7
4.4.2 注册注销系统热键... 8
4.4.3 热键编辑窗体... 8
4.4.4 对象唯一性... 8
5 程序源代码... 9
6 小结... 25
6.1 没有解决的一些问题... 25
6.2 程序心得... 26
 
1 文档目的
本文档介绍了在Delphi 7中注册、注销、使用热键（Hot Key）的基本函数和方法，并在此基础上介绍了一个热键控制的类THotKeyConfig。该类可以从指定的xml配置文档中读入热键配置信息，并在程序指定的位置注册、注销、修改热键。
本文将不涉及XML文档的读写方法，也不会详述控件开发的方法。如果您对这些内容不了解，推荐您先略读一下相关的文章。关于xml文档的解析，可以到我的blog找到文章。
 
 
2 热键编程基础
2.1 API函数
在Delphi7中使用热键要用到如下几个函数：
 
//注册热键
BOOL RegisterHotKey(
    HWND hWnd, // 接受热键消息的窗口句柄
    int id, // 热键ID
    UINT fsModifiers, // 按键组合整数
    UINT vk    // 案件虚拟键码VK
   );
 
其中fsModifiers 值如下：
        1:  M_strDisplay:=‘Alt + ‘;
        2:  M_strDisplay:=‘Ctrl + ‘;
        3:  M_strDisplay:=‘Ctrl + Alt + ‘;
        4:  M_strDisplay:=‘Shift + ‘;
        5:  M_strDisplay:=‘Shift + Alt + ‘;
        6:  M_strDisplay:=‘Ctrl + Shift + ‘;
        7:  M_strDisplay:=‘Ctrl + Shift + Alt + ‘;
 
//注销热键
BOOL UnregisterHotKey(
 
HWND hWnd, //接受热键消息的窗口句柄
int id //热键ID
   );
注销时，根据注册时赋予的热键ID进行注销，因此在注册时必须保证ID唯一。
 
关于这两个WIN32 API函数的具体说明可以参考WIN32 SDK文档。
 
2.2 编程方法
基本的热键编程方法是定义2个窗体过程，和一个消息响应函数：
Procedure HotKeyOn;
Procedure HotKeyOff;
procedure HotKeyDown(var Msg: Tmessage); message WM_HOTKEY;
在HotKeyOn过程中调用API函数注册热键，代码可以是这样的：
procedure TfrmMain.HotKeyOn;
begin
    HKStep := 1;
    HKScreen := 2;
    HKComponent := 3;
    HKShowMain := 4;
    HKShowOI := 5;
    if not RegisterHotKey(Handle, HKStep, MOD_CONTROL, Ord(‘C‘)) then
        showmessage(‘can not register the hotkey "Ctrl-C"‘);
    if not RegisterHotKey(Handle, HKScreen, MOD_CONTROL, Ord(‘V‘)) then
        showmessage(‘can not register the hotkey "Ctrl-V"‘);
    if not RegisterHotKey(Handle, HKComponent, MOD_CONTROL, Ord(‘B‘)) then
        showmessage(‘can not register the hotkey "Ctrl-B"‘);
    if not RegisterHotKey(Handle, HKShowMain, MOD_CONTROL, VK_F11) then
        showmessage(‘can not register the hotkey "Ctrl-F11"‘);
    if not RegisterHotKey(Handle, HKShowOI, MOD_CONTROL, VK_F12) then
        showmessage(‘can not register the hotkey "Ctrl-F12"‘);
end;
 
在HotKeyOff过程中调用API函数注销热键，代码可以是这样的：
procedure TfrmMain.HotKeyOff;
begin
    UnRegisterHotKey(handle, HKStep);
    UnRegisterHotKey(handle, HKScreen);
    UnRegisterHotKey(handle, HKComponent);
    UnRegisterHotKey(handle, HKShowMain);
    UnRegisterHotKey(handle, HKShowOI);
end;
 
在HotKeyDown消息处理函数中判断系统消息，根据不同的热键组合执行响应的语句，代码可以是这样的：
procedure TfrmMain.HotKeyDown(var Msg: Tmessage);
begin
    if (Msg.LParamHi = Ord(‘C‘)) and (Msg.LParamLo = MOD_CONTROL) then
    ShowMessage(‘"Ctrl-C"‘)
    else if (Msg.LParamHi = Ord(‘V‘)) and (Msg.LParamLo = MOD_CONTROL) then
ShowMessage(‘"Ctrl-V"‘)
    else if (Msg.LParamHi = Ord(‘B‘)) and (Msg.LParamLo = MOD_CONTROL) then
ShowMessage(‘"Ctrl-B"‘)
    else if (Msg.LParamHi = VK_F11) and (Msg.LParamLo = MOD_CONTROL) then
    ShowMessage(‘"Ctrl-11"‘)
    else if (Msg.LParamHi = VK_F12) and (Msg.LParamLo = MOD_CONTROL) then
    ShowMessage(‘"Ctrl-12"‘)
end;
 
如果系统热键数量少、稳定不变，则适合使用这种方法。如果系统热键较多，而软件需求又要求热键可以由用户设置修改，则需要有一个自动化管理的模块来实现。因此我在学习了如上的方法后实现了一个热键自动管理的类。
 
 
3 实现概述
实现这个热键管理类我定义了1个记录体和3个类。可以将热键配置信息保存在一个独立的xml文档中，也作为子树加入到应用程序的配置文档中。
记录体ThotKeyStatus保存从XML配置树中读入的热键记录，该记录体的数组变量将被整个单元文件内的对象所共享。
类ThotKeyEdit是一个自定义的控件，用于接受用户输入的热键组合，一方面转化为系统可以接受的形式，另一方面也给用户一个即时反馈。
类TformHotkeyConfig是一个窗体类，该窗体类将根据从XML中读入的热键配置动态创建ThotKeyEdit控件，提供用户查看和修改热键。
类ThotKeyConfig是我们要使用和直接访问的类，它提供一个后台操作的功能，用户在引入该类后可以选择在程序指定位置读入XML配置文件、生效热键配置、打开TformHotKeyConfig提供的编辑窗体、保存配置到XML文件。另外该类在编程上为了控制对象的唯一性，采用了类方法MgetInstance来获得唯一对象，关于用类方法控制对象唯一性的方法可以参考我blog中的文章。
 
4 实现细节
4.1 XML配置文档结构
XML配置文档的结构可以如下：
<?xml version="1.0" encoding="UTF-8"?>
<configure>
    <hotkeys>
       <hotkey>
           <caption>添加SCREEN</caption>
           <hkid>101</hkid>
           <mod>2</mod>
           <vk>49</vk>
       </hotkey>
       <hotkey>
           <caption>新建STEP</caption>
           <hkid>102</hkid>
           <mod>2</mod>
           <vk>50</vk>
       </hotkey>
    </hotkeys>
</configure>
其中，<hotkeys>为保存热键配置的节点的子树树根。每个<hotkey>子树记录一个热键配置。
caption为热键名称，将显示在TformHotKeyConfig实例中的ThotKeyEdit对象的标题位置。
Hkid为热键唯一标识，对应上文API函数中的ID值，该值必须局部唯一。
Mod为热键模式，对应上文API函数中的fsModifier值。
Vk为热键虚拟键码，对应上文API函数中的VK值。
 
4.2 热键编辑控件 ThotKeyEdit
该控件的声明如下：
    //---------------------------------------
    //  热键编辑控件
    //---------------------------------------
    THotKeyEdit = class(TLabeledEdit)
    private
        //当前控件接收到的热键组合是否合法
        FKeySetValid:Boolean;
        //组合键
        FModValue:Integer;
        //虚拟键码
        FVirtualKeyValue:Integer;
        //修改合法后显示的颜色
        FValidateColor:TColor;
        //用来覆盖OnExit事件的函数
        procedure LostFocusEvent(Sender:TObject);
        //用来覆盖OnKeyDown事件的函数
        procedure GetHotKeyDownEvent(Sender: TObject; var Key: Word; Shift: TShiftState);
        //将热键数据转换为直观文字
        function  GetDisplayText:string;
        //热键组合合法执行的代码
        procedure ActionOnHotKeyValid;
        //热键组合非法执行的代码
        procedure ActionOnHotKeyInvalid;
    public
        //覆盖构造函数
        constructor Create(AOwner: TComponent); override;
        //外部请求将内部数据表现为直观文字
        procedure DisplayHotKey;
    published
        property HasValidKeySet:boolean read FKeySetValid;
        property VirtualKeyValue:integer read FVirtualKeyValue write FVirtualKeyValue;
        property KeyModValue:integer read FModValue write FModValue;
end;
 
ThotKeyEdit控件继承自TlabeledEdit控件，包含一个显示热键名称的LABEL和一个只读的EDIT区，在该区将显示用户输入的热键组合。控件的OnKeyDown事件被GetHotKeyDownEvent过程重写，在该过程中捕捉用户按下的按键组合，先将捕捉到的键位信息保存到私有字段中，然后调用GetDisplayText函数判断私有字段中的键位是否合法，并且返回由这些信息转换得到的热键字串。合法性将保存在一个私有布尔字段FKeySetValid中。
对于用户提供的热键布局，如果可以接受则控件edit区会变色，如果不能接受则会在失去焦点时清除内容，并恢复默认颜色。
 
 
4.3 热键自定义窗体类TformHotKeyconfig
该窗体类继承自Tform类，并需要UnitHotkeyConfigClass.dfm资源文件的支持。
类的声明代码如下：
    //---------------------------------------
    //  热键设定窗体
    //---------------------------------------
    TFormHotkeyConfig = class(TForm)
        GroupBoxLeft: TGroupBox;
        PanelRight: TPanel;
        ButtonYes: TButton;
        ButtonNo: TButton;
        procedure ButtonYesClick(Sender: TObject);
        procedure ButtonNoClick(Sender: TObject);
    private
        //用来保存动态创建的THotKeyEdit控件的对象列表
        FEditList:TObjectList;
    public
        constructor Create(AOwner: TComponent); override;
    end;
 
该类重写了构造方法，并在构造方法中根据从xml中读入的热键个数动态创建和初始化响应数量的ThotKeyEdit控件，因此需要一个私有成员FeditList来维护控件数组。
 
4.4 主类ThotKeyConfig
ThotKeyConfig的声明如下：
    //---------------------------------------
    //  主类：提供热键注册和编辑功能
    //---------------------------------------
    THotkeyConfig = class (TComponent)
    private
        //如果用户自定义配置文件路径则记录它
        FAssociatedXML : String;
        //配置窗体对象
        FConfigureForm : TFormHotkeyConfig;
        //热键响应窗体引用
        FWindow : TWinControl;
        //定位到保存热键记录的XML子树树根
        function XMLGetKeysetFather(AXML:TXMLDocument):IXMLNode;
        //隐藏的构造函数
        constructor Create(AOwner: TComponent);override;
    public
        //获得对象
        class function MGetInstance(AOwner:TWinControl):THotKeyConfig;
        //读入XML配置文件
        function LoadConfigFromXML(const AXMLFile:string=‘hotkey.xml‘):boolean;
        //保存配置
        function SaveConfigToXML(const AXMLFile:string=‘hotkey.xml‘):boolean;
        //注册所有热键设置
        function EnableAllHotkeys:Boolean;
        //注销热键
        procedure DisableAllHotkeys;
        //打开配置窗口
        procedure OpenConfigWindow;
    published
        property WindowHandlesHotkey : TWinControl write FWindow;
    end;
在该类中主要完成如下几个功能：
1.        读写解析XML配置文件
2.        注册注销系统热键
3.        提供热键修改窗体的入口
4.        通过类方法和类变量，管理类的对象在应用程序中的唯一性
 
4.4.1 解析XML文档
因为XML文档结构相对简单因此使用TXMLDocument类来实现，在LoadConfigFromXML方法中通过XMLGetKeysetFather函数定位到Hotkey节点，这样如果XML结构位置改变，只需要修改XMLGetKeysetFather函数就可以。读出的热键记录将保存到静态变量FkeyInfo和FkeyInfoCount中，他们是ThotKeyStatus的数组和计数器。
 
4.4.2 注册注销系统热键
两个对象方法负责自动完成热键的注册和注销：EnableAllHotkeys和DisableAllHotkeys。
热键注册时从FkeyInfo数组中读入键位信息并调用WIN32 API函数RegisterHotKey注册热键，如果注册成功则返回true。
在RegisterHotKey中需要一个窗体句柄来接受系统消息WM_HOTKEY，因此在调用EnableAllHotkeys之前需要为属性WindowHandlesHotkey赋一个窗体的引用值。或者在MgetInstance方法的参数中传递该窗体的引用。如果没有定义WindowHandlesHotkey会使热键无法注册。
 
4.4.3 热键编辑窗体
执行OpenConfigWindow方法将弹出模式窗体，提供用户编辑热键，该窗体就是TformHotKeyConfig的实例。
在窗体打开之前，为了不在编辑时触发热键消息，需要调用DisableAllHotkeys取消所有热键。
在窗体别关闭后检查静态变量isXMLNeedSave判断用户按下的是确认还是取消。如果是确认，则要保存热键配置到静态变量FkeyInfo和XML文档。最后根据FkeyInfo重新注册热键。
 
4.4.4 对象唯一性
因为一个应用程序中，对于ThotkeyConfig对象通常只需要一个就够了，如果在每个需要用到的地方都重新创建会影响程序执行效率。所以，我使用一个静态变量保存唯一对象的引用，然后公开一个方法MgetInstance让程序员得到ThotKeyConfig的实例对象。具体概念请访问我的blog。
因此类的编程模式如下：
    with THotKeyConfig.MGetInstance(Form1) do begin
        LoadConfigFromXML;
        EnableAllHotkeys ;
       //……
    end;
 
 
5 程序源代码
为了便于使用，我将3个类定义和1个记录体声明写在一个单独的UNIT中，这样会带来一些访问上的安全隐患，但是作为学习只用，程序员在调用时“自觉”一点就可以了 :-P
 
//--------------------------------------------------------------------------
//UNIT: UnitHotkeyConfigClass.pas
//SUMM: 热键控制类
//AUTH: CST
//DATE: 2005-8-15
//DESC: 本单元文件定义了一个保存热键项目的记录体、后台控制类、一个设定窗口类
//      以及一个需要用到的自定义控件THotKeyEdit。
//REFE: HotKeyConfig类使用到了自定义控件HotKeyEdit
//BUGS: No checking for duplicated hotkey sets
//      No checking for duplicated hotkey_id in xml
//       
//USES: 用户只需使用THotKeyConfig类，该类不能创建实例。
//      请使用THotKeyConfig.MGetInstance(Owner)方法来访问对象。
//--------------------------------------------------------------------------
unit UnitHotkeyConfigClass;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Buttons, StrUtils, Contnrs, xmldom, XMLIntf,
  msxmldom, XMLDoc;
 
type
    //---------------------------------------
    //  热键组合
    //---------------------------------------
    THotKeyStatus = record
        FCaption:String[20];    //热键标题
        FHKID   :Integer;       //唯一ID
        FMod    :Integer;       //组合键
        FVK     :Integer;       //虚拟键码
    end;
 
 
 
    //---------------------------------------
    //  热键编辑控件
    //---------------------------------------
    THotKeyEdit = class(TLabeledEdit)
    private
        //当前控件接收到的热键组合是否合法
        FKeySetValid:Boolean;
        //组合键
        FModValue:Integer;
        //虚拟键码
        FVirtualKeyValue:Integer;
        //修改合法后显示的颜色
        FValidateColor:TColor;
        //用来覆盖OnExit事件的函数
        procedure LostFocusEvent(Sender:TObject);
        //用来覆盖OnKeyDown事件的函数
        procedure GetHotKeyDownEvent(Sender: TObject; var Key: Word; Shift: TShiftState);
        //将热键数据转换为直观文字
        function  GetDisplayText:string;
        //热键组合合法执行的代码
        procedure ActionOnHotKeyValid;
        //热键组合非法执行的代码
        procedure ActionOnHotKeyInvalid;
    public
        //覆盖构造函数
        constructor Create(AOwner: TComponent); override;
        //外部请求将内部数据表现为直观文字
        procedure DisplayHotKey;
    published
        property HasValidKeySet:boolean read FKeySetValid;
        property VirtualKeyValue:integer read FVirtualKeyValue write FVirtualKeyValue;
        property KeyModValue:integer read FModValue write FModValue;
    end;
 
 
 
    //---------------------------------------
    //  热键设定窗体
    //---------------------------------------
    TFormHotkeyConfig = class(TForm)
        GroupBoxLeft: TGroupBox;
        PanelRight: TPanel;
        ButtonYes: TButton;
        ButtonNo: TButton;
        procedure ButtonYesClick(Sender: TObject);
        procedure ButtonNoClick(Sender: TObject);
    private
        //用来保存动态创建的THotKeyEdit控件的对象列表
        FEditList:TObjectList;
    public
        constructor Create(AOwner: TComponent); override;
    end;
 
 
   
 
    //---------------------------------------
    //  主类：提供热键注册和编辑功能
    //---------------------------------------
    THotkeyConfig = class (TComponent)
    private
        //如果用户自定义配置文件路径则记录它
        FAssociatedXML : String;
        //配置窗体对象
        FConfigureForm : TFormHotkeyConfig;
        //热键响应窗体引用
        FWindow : TWinControl;
        //定位到保存热键记录的XML子树树根
        function XMLGetKeysetFather(AXML:TXMLDocument):IXMLNode;
        //隐藏的构造函数
        constructor Create(AOwner: TComponent);override;
    public
        //获得对象
        class function MGetInstance(AOwner:TWinControl):THotKeyConfig;
        //读入XML配置文件
        function LoadConfigFromXML(const AXMLFile:string=‘hotkey.xml‘):boolean;
        //保存配置
        function SaveConfigToXML(const AXMLFile:string=‘hotkey.xml‘):boolean;
        //注册所有热键设置
        function EnableAllHotkeys:Boolean;
        //注销热键
        procedure DisableAllHotkeys;
        //打开配置窗口
        procedure OpenConfigWindow;
    published
        property WindowHandlesHotkey : TWinControl write FWindow;
    end;
 
 
procedure Register;
 
implementation
 
{$R *.dfm}
 
//-----------------------------------------------------------------------
//  单元内全局变量
//-----------------------------------------------------------------------
var
    //共享从XML中读入的热键配置信息
    FKeyInfo : array of THotKeyStatus;
    //读入的热键记录个数
    FKeyInfoCount: Integer;
    //是否需要保存到XML中
    isXMLNeedSave:Boolean;
    //实体
    HK_Instance:THotkeyConfig;
 
 
//-----------------------------------------------------------------------
//  自定义控件可以被注册
//-----------------------------------------------------------------------
procedure Register;
begin
  RegisterComponents(‘CST‘, [THotKeyEdit]);
end;
 
 
 
{********************************************************
*********************************************************
*******************  THotkeyConfig  *********************
*********************************************************
********************************************************}
 
//-----------------------------------------------------------------------
//  构造函数
//-----------------------------------------------------------------------
constructor THotKeyConfig.Create (AOwner: TComponent);
begin
    inherited;
end;
 
 
//-----------------------------------------------------------------------
//NAME: MGetInstance
//SUMM: 获得类的唯一实例
//PARA: AOwner
//RETN: 唯一实例
//AUTH: CST
//DATE: 2005-8-18
//DESC: 类方法实现对象唯一性控制
//-----------------------------------------------------------------------
class function THotKeyConfig.MGetInstance(AOwner:TWinControl):THotKeyConfig;
begin
    if HK_Instance = nil then begin
        HK_Instance:=Create(AOwner);
        HK_Instance.WindowHandlesHotkey := AOwner;
    end;
    Result:=HK_Instance;
end;
 
 
//-----------------------------------------------------------------------
//NAME: EnableAllHotkeys
//SUMM: 注册所有热键
//PARA: N/A
//RETN: TRUE-成功
//AUTH: CST
//DATE: 2005-8-15
//DESC: 在应用程序加载时由用户显式调用。热键配置修改后被类自动调用重新注册
//      先判断热键Listener窗体是否赋值，然后调用WIN32 API注册
//-----------------------------------------------------------------------
function THotkeyConfig.EnableAllHotkeys:Boolean;
var
    M_Index:integer;
    M_ErrText:string;
begin
    Result:=True;
 
    //CHECK HOTKEY HANDLE WINDOW DEFINED
    if FWindow=nil then begin
        ShowMessage(‘热键处理窗体未定义。‘+#13+‘请使用WindowHandlesHotkey方法。‘);
        result:=false;
        exit;
    end;
 
    //REGISTER BY LOOP
    for M_Index := 0 to FKeyInfoCount - 1 do begin
        //SKIP UNDEFINED HOTKEY EVENTS
        if FKeyInfo[M_Index].FMod < 1 then continue;
        if FKeyInfo[M_Index].FVK  < 1 then continue;
        //START TO REGISTER HOTKEY
        if not RegisterHotKey( FWindow.Handle,
                               FKeyInfo[M_Index].FHKID,
                               FKeyInfo[M_Index].FMod ,
                               FKeyInfo[M_Index].FVK  ) then begin
            //REGISTER FAILURE PROCEDURE                              
            Result:=False;
            M_ErrText:=Format(‘无法注册名为%s的热键。‘,[FKeyInfo[M_Index].FCaption]);
            //ShowMessage(M_ErrText);
        end;    //end of if
    end;    //end of for
end;
 
//-----------------------------------------------------------------------
//NAME: DisableAllHotkeys
//SUMM: 注销所有热键
//PARA: N/A
//RETN: TRUE-成功
//AUTH: CST
//DATE: 2005-8-15
//DESC: 在进入热键编辑之前要调用此方法注销热键。
//-----------------------------------------------------------------------
procedure THotkeyConfig.DisableAllHotkeys;
var
    M_Index:integer;
begin
    for M_Index := 0 to FKeyInfoCount - 1 do
        UnRegisterHotKey( FWindow.Handle, FKeyInfo[M_Index].FHKID);
end;
 
 
//-----------------------------------------------------------------------
//NAME: XMLGetKeysetFather
//SUMM: 定位到保存热键记录的XML子树树根
//PARA: AXML-XML文档
//RETN: 树根节点
//AUTH: CST
//DATE: 2005-8-18
//DESC: 定位到保存热键记录的XML子树树根。
//      如果要改变XML结构，则只要修改这里的定位语句。
//-----------------------------------------------------------------------
function THotkeyConfig.XMLGetKeysetFather(AXML:TXMLDocument):IXMLNode;
var
    M_SearchNode:IXMLNode;
begin
    //NAVIGATE THROUGH XML CONFIGURE FILE
    M_SearchNode:=AXML.Node;
    M_SearchNode:=M_SearchNode.ChildNodes.Nodes[‘configure‘];
    M_SearchNode:=M_SearchNode.ChildNodes.Nodes[‘hotkeys‘];
    Result:= M_SearchNode;
end;
 
 
 
//-----------------------------------------------------------------------
//NAME: LoadConfigFromXML
//SUMM: 从XML文档中读取热键设置，并注册生效
//PARA: AXMLFile-XML文档路径，默认为EXE同根的hotkey.xml
//RETN: TRUE-成功
//AUTH: CST
//DATE: 2005-8-15
//DESC: 使用TXMLDocuement对象解析配置文档，将读取的记录保存到类变量中
//      FKeyInfo数组记录读入的热键组合，FKeyInfoCount记录动态数组大小
//-----------------------------------------------------------------------
function THotkeyConfig.LoadConfigFromXML(const AXMLFile:string=‘hotkey.xml‘):boolean;
var
    M_ConfigXML:TXMLDocument;
    M_SearchNode, M_PropNode:IXMLNODE;
    M_Index :integer;
begin
    result:=False;
 
    //Q:为何构造方法参数为nil就会无法解析节点？
    M_ConfigXML:=TXMLDocument.Create(Self);
    try
        //OPEN XML CONFIGURE FILE
        with M_ConfigXML do begin
            LoadFromFile(AXMLFile);
            Options := [];
            Active := True;
        end;
 
        //RECORD ASSOCIATED XML CONFIGURATION FILE
        FAssociatedXML := AXMLFile;
 
        //GET THE ROOT WE WANT
        M_SearchNode:=XMLGetKeysetFather(M_ConfigXML);
 
        //GET COUNT FOR HOTKEY SETS
        FKeyInfoCount:=M_SearchNode.ChildNodes.Count ;
        SetLength(FKeyInfo, FKeyInfoCount);
 
        //LOOP TO READ EVERY KEYSET
        for M_Index := 0 to FKeyInfoCount - 1 do begin
            M_PropNode:=M_SearchNode.ChildNodes.Nodes[M_Index];
            with FKeyInfo[M_Index] do begin
                FCaption := M_PropNode.ChildValues[‘caption‘];
                FHKID  := M_PropNode.ChildValues[‘hkid‘];
                FMod  := M_PropNode.ChildValues[‘mod‘];
                FVK  := M_PropNode.ChildValues[‘vk‘];
            end;  //end of with
        end;  //end of for
    finally
        M_ConfigXML.Active := False;
        FreeAndNil(M_ConfigXML);
    end;
end;
 
 
//-----------------------------------------------------------------------
//NAME: SaveConfigToXML
//SUMM: 保存修改的热键配置到XML文档
//PARA: AXMLFile-XML文档路径
//RETN: TRUE-成功
//AUTH: CST
//DATE: 2005-8-15
//DESC: 配置窗口确认关闭后调用
//-----------------------------------------------------------------------
function THotkeyConfig.SaveConfigToXML(const AXMLFile:string=‘hotkey.xml‘):boolean;
var
    M_ConfigXML:TXMLDocument;
    M_SearchNode, M_PropNode:IXMLNODE;
    M_Index :integer;
begin
    result:=False;
 
    M_ConfigXML:=TXMLDocument.Create(Self );
    try
        //OPEN XML CONFIGURE FILE
        with M_ConfigXML do begin
            LoadFromFile(AXMLFile);
            Options := [];
            Active := True;
        end;
 
        //GET THE ROOT WE WANT
        M_SearchNode:=XMLGetKeysetFather(M_ConfigXML);
 
        //LOOP TO READ EVERY KEYSET
        for M_Index := 0 to FKeyInfoCount - 1 do begin
            M_PropNode:=M_SearchNode.ChildNodes.Nodes[M_Index];
            with FKeyInfo[M_Index] do begin
                M_PropNode.ChildValues[‘caption‘]:=FCaption;
                M_PropNode.ChildValues[‘hkid‘]:=FHKID;
                M_PropNode.ChildValues[‘mod‘]:=FMod;
                M_PropNode.ChildValues[‘vk‘]:=FVK;
            end;  //end of with
        end;  //end of for
 
        //SAVE CHANGES
        M_ConfigXML.SaveToFile(AXMLFile);
    finally
        M_ConfigXML.Active := False;
        FreeAndNil(M_ConfigXML);
    end;
 
end;
 
 
 
//-----------------------------------------------------------------------
//NAME: OpenConfigWindow
//SUMM: 打开配置窗口
//PARA: N/A
//RETN: N/A
//AUTH: CST
//DATE: 2005-8-15
//DESC: 窗体对象为 FConfigureForm 成员
//-----------------------------------------------------------------------
procedure THotKeyConfig.OpenConfigWindow ;
var
    M_ErrMsg:String;
begin
    if FConfigureForm = nil then FConfigureForm:=TFormHotkeyConfig.Create(nil);
    try
        //默认是不要保存修改
        isXMLNeedSave:=False;
 
        //设置之前先注销所有热键
        DisableAllHotkeys ;
 
        //打开设置窗口
        FConfigureForm.ShowModal;
 
        if isXMLNeedSave then begin
            //修改后按下『确认』生效并保存
            if EnableAllHotkeys then
                begin
                    //新设置热键注册成功
                    MessageBox(Application.Handle, ‘所有热键都成功注册。‘+#13+‘点击确认保存所有热键设置。‘, ‘提示‘, MB_OK + MB_ICONINFORMATION);
                    SaveConfigToXML(FAssociatedXML);
                end     //end of if
            else
                begin
                    //新设置热键有冲突
                    M_ErrMsg:=‘您设置的热键组合中有一项或多项没有注册成功。‘ + #13 +
                              ‘也许是和其他应用程序产生了冲突，您可以尝试更换其他按键组合。‘ + #13 +
                              ‘请问是否仍然要保存这次的设置，如果保存请按“是”，我们将在下次软件启动的时候‘+
                              ‘再次尝试注册您的热键配置，您可以在这之前注销或修改其他应用程序的冲突设置。‘;
                    if MessageBox(Application.Handle, PChar(M_ErrMsg), ‘提示‘,MB_YESNO+MB_ICONQUESTION)=IDYES then SaveConfigToXML(FAssociatedXML);
                end;
        end
        else begin
            //按下『取消』按钮，但是还是要恢复原先的热键
            EnableAllHotkeys;
        end;
       
    finally
        FreeAndNil(FConfigureForm);
    end;
end;
 
 
{********************************************************
*********************************************************
****************  TFormHotkeyConfig  ********************
*********************************************************
********************************************************}
 
//-----------------------------------------------------------------------
//NAME: Create
//SUMM: TFormHotkeyConfig的构造函数
//AUTH: CST
//DATE: 2005-8-15
//DESC: 继承TForm的构造函数，动态创建THotKeyEdit控件。
//      将窗体上的热键接受控件的OnKeyDown事件改写。
//-----------------------------------------------------------------------
constructor TFormHotkeyConfig.Create(AOwner: TComponent);
var
    M_Index, M_Top:integer;
    HKEdit:THotkeyEdit;
const
    MLEFT = 10;
    MWIDTH = 200;
    MHEIGHT = 21;
    MMARGIN = 30;
begin
    inherited;
 
    //HOTKEYEDITORS
    FEditList := TObjectList.Create ;
    M_Top := 0;
    for M_Index := 0 to FKeyInfoCount - 1 do begin
        //计算控件位置，纵向排列
        M_Top:= MMARGIN + M_Index * (MHEIGHT+MMARGIN);
        //根据读入的XML节点动态创建热键编辑控件
        HKEdit:=THotKeyEdit.Create(Self);
        with HKEdit do begin
            //定义样式
            Parent:=Self.GroupBoxLeft;
            SetBounds(MLEFT,M_Top,MWIDTH,MHEIGHT);
            LabelPosition := lpAbove ;
            EditLabel.Caption := FKeyInfo[M_Index].FCaption;
            EditLabel.Width := MWIDTH;
            //定义初始数据
            VirtualKeyValue := FKeyInfo[M_Index].FVK;
            KeyModValue := FKeyInfo[M_Index].FMod;
            //按照定义的数据显示热键组合
            DisplayHotKey;
        end;    //end of with
        //保存组件到对象列表
        FEditList.Add(HKEdit);
    end;    //end of for
 
    Height:= M_Top + MHEIGHT + MMARGIN;
end;
 
 
//------------------------------------------------------------
//  确定
//------------------------------------------------------------
procedure TFormHotkeyConfig.ButtonYesClick(Sender: TObject);
var
    M_Index:integer;
begin
    //CONVERT HK_EDITOR DATA TO HOTKEY INFO ARRAY
    for M_Index := 0 to FKeyInfoCount - 1 do begin
        FKeyInfo[M_Index].FMod := (FEditList.Items[M_Index] as THotKeyEdit).KeyModValue ;
        FKeyInfo[M_Index].FVK := (FEditList.Items[M_Index] as THotKeyEdit).VirtualKeyValue;
    end;
    //END OF CONVERT
   
    Close;
    isXMLNeedSave:=True;
end;
 
 
//------------------------------------------------------------
//  取消
//------------------------------------------------------------
procedure TFormHotkeyConfig.ButtonNoClick(Sender: TObject);
begin
    if MessageBox(Self.Handle,‘是否要放弃修改并关闭窗口？‘,‘提示‘,MB_YESNO+mb_iconinformation) = IDYES then
    begin
        Close;
        isXMLNeedSave:=False;
    end;
end;
 
 
 
 
{********************************************************
*********************************************************
*********************  THotKeyEdit  *********************
*********************************************************
********************************************************}
 
 
 
//-----------------------------------------------------------------------
//  HotKeyEdit控件构造函数
//-----------------------------------------------------------------------
constructor THotKeyEdit.Create(AOwner: TComponent);
begin
    inherited;
    ReadOnly := True;
    OnKeyDown := GetHotKeyDownEvent;
    OnExit := LostFocusEvent;
    FValidateColor := clSkyBlue;
end;
 
 
//-----------------------------------------------------------------------
//NAME: GetDisplayText
//SUMM: 将热键信息转换为显示字串
//PARA: N/A
//RETN: 热键转换的显示结果
//AUTH: CST
//DATE: 2005-8-15
//DESC: 型如："Ctrl + Alt + Shift + A "为正确
//      数据来源 FVirtualKeyValue, FModValue
//      判断组合是否合法，记录在FKeySetValid中
//-----------------------------------------------------------------------
function THotKeyEdit.GetDisplayText:string;
var
    M_strDisplay:String;
const
    SPLUS = ‘ + ‘;
begin
    FKeySetValid := True;
 
    //处理按键组合
    case FModValue of
        1:  M_strDisplay:=‘Alt + ‘;
        2:  M_strDisplay:=‘Ctrl + ‘;
        3:  M_strDisplay:=‘Ctrl + Alt + ‘;
        4:  M_strDisplay:=‘Shift + ‘;
        5:  M_strDisplay:=‘Shift + Alt + ‘;
        6:  M_strDisplay:=‘Ctrl + Shift + ‘;
        7:  M_strDisplay:=‘Ctrl + Shift + Alt + ‘;
    else
        begin
            M_strDisplay := ‘‘;
            FKeySetValid := False;
        end;
    end;
 
    //处理键码
    case FVirtualKeyValue of
    VK_F1..VK_F12:
        M_strDisplay := M_strDisplay + ‘F‘+IntToStr(FVirtualKeyValue - VK_F1 + 1);
    Ord(‘A‘)..Ord(‘Z‘), Ord(‘0‘)..Ord(‘9‘):
        M_strDisplay := M_strDisplay + Chr(FVirtualKeyValue);
    else
        begin
            M_strDisplay := M_strDisplay ;
            FKeySetValid := False;
        end;
    end;
 
    result:=M_strDisplay;
end;
 
 
 
//-----------------------------------------------------------------------
//NAME: LostFocusEvent
//SUMM: 控件失去焦点时检查热键合法性
//PARA: Sender-控件
//RETN: N/A
//AUTH: CST
//DATE: 2005-8-15
//DESC: 此函数将用来覆盖4个TLabelEdit的OnExit事件
//-----------------------------------------------------------------------
procedure THotKeyEdit.LostFocusEvent(Sender:TObject);
begin
    if not FKeySetValid then begin
        Text:=‘‘;
        FModValue := 0;
        FVirtualKeyValue := 0;
    end;
end;
 
 
 
//-----------------------------------------------------------------------
//NAME: GetHotKeyDownEvent
//SUMM: 接受用户输入的热键并判断是否合法的时间函数
//PARA: Sender-控件  Key-虚拟键码 Shift-辅助键信息
//RETN: N/A
//AUTH: CST
//DATE: 2005-8-15
//DESC: 此函数将用来覆盖OnKeyDown事件
//
//-----------------------------------------------------------------------
procedure THotKeyEdit.GetHotKeyDownEvent(Sender: TObject; var Key: Word; Shift: TShiftState);
var
    M_StrDisplay:String;
begin
    //READ HOTKEY SET MODE
    FModValue := 0;
    if (ssCtrl in Shift)  then FModValue := FModValue + 2;
    if (ssAlt  in Shift)  then FModValue := FModValue + 1;
    if (ssShift in Shift) then FModValue := FModValue + 4;
 
    //READ HOTKEY SET VIRTUAL KEY
    FVirtualKeyValue  := Key;
 
    //GET DISPLAY TEXT AND JUDGE WHETHER KEYSET IS VALIDATE
    M_StrDisplay := GetDisplayText;
 
    //REFLECTION
    if FKeySetValid then
        ActionOnHotKeyValid
    else
        ActionOnHotKeyInvalid ;
    Text := M_StrDisplay;
end;
 
//---------------------------------------
//  在动态创建时显示组合键
//---------------------------------------
procedure THotKeyEdit.DisplayHotKey;
begin
    Text := GetDisplayText ;
end;
 
 
//---------------------------------------
//  热键组合合法执行的代码
//---------------------------------------
procedure THotKeyEdit.ActionOnHotKeyValid;
begin
    Color:=FValidateColor;
end;
 
//---------------------------------------
//  热键组合非法执行的代码
//---------------------------------------
procedure THotKeyEdit.ActionOnHotKeyInvalid;
begin
    Color := clWhite;
end;
 
 
 
end.
 
6 小结
6.1 没有解决的一些问题
TXMLDocument的对象在创建时如果Owner参数为nil则无法解析到节点，如果使用带文档路径参数的重载的构造函数也会如此，因为在TXMLDocument的源码中重载的版本Owner也是nil。为了规避这个问题，我牺牲了效率而将Owner置为Application并手动释放了文档对象。考虑到如果使用self可能会因为释放两次而产生错误，而Application的释放影响不会很大。
 
没有实现对于XML文档合法性的检验，仅过滤了超出范围的MOD和VK值，对于HKID是否唯一没有做检查。
 
没有实现对于用户定义的热键之间的冲突，在TformHotKeyConfig中没有判断是否设置的了相同的热键。
 
热键编辑控件可以注册到Pallete中，ThotKeyConfig类尚未控件化，如果控件化可能需要改变对象调用方式，公开构造函数允许创建多个实例。取消MgetInstance方法。
 
6.2 程序心得
虽然Delphi中对于热键的使用也不繁琐，但是使用本方法可以利用流行的xml记录热键是挺诱人的，只要稍加修改就可以继承到应用程序中。而且这样自由度比较高，热键数量、名称、布局都是可以自定义的。
 
在组件化上，我只封装了ThotKeyEdit控件，而没有将ThotKeyConfig类严格封装。因此只能通过代码手动创建和调用。热键编辑窗口是一个挺方便的设计，可以让使用该类的用户不必关心热键编辑的实现。
 
在不断的OO开发中，我也在摸索，程序中难免会有一些不如意之处，我诚心希望各位给我提出意见，我也很高兴能在相关的问题上和大家一起讨论讨论。
 
本程序的相关代码和测试示例可以在我的YAHOO公文包上下载。

library HookMsg;
 
uses
  SysUtils, Windows, Messages;
 
{$R *.res}
 
var
  hHook: Integer;
 
function HookProc(iCode: Integer;
wParam: WPARAM;
lParam: LPARAM): LRESULT; stdcall; export;
begin
   Result := 0;
     try
       if iCode < 0 then
         Result := CallNextHookEx(hHook, iCode, WParam, LParam)
       else
       if (GetKeyState(VK_CONTROL) and $8000 <> 0) then
       case  wParam of
         WM_LBUTTONUP: WinExec(‘Notepad.exe‘, SW_SHOW);  //Ctrl+左键 打开记事本
         WM_RBUTTONUP: WinExec(‘Calc.exe‘, SW_SHOW);     //Ctrl+右键 打开计算器
       end;
    except
    end;
end;
 
procedure LoadDestroyWndHook;    //设置系统挂钩
begin
  hHook:=SetWindowsHookEx(WH_MOUSE,HookProc,Hinstance,0);
end;
 
procedure UnLoadDestroyWndHook; //注销系统挂钩
begin
  UnHookWindowsHookEx(hHook);
  hHook := 0;
end;
 
exports 
  LoadDestroyWndHook,
  UnLoadDestroyWndHook;
end.


  function LoadDestroyWndHook: BOOL;   external ‘HookMsg.dll‘;
  function UnLoadDestroyWndHook: BOOL; external ‘HookMsg.dll‘;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  LoadDestroyWndHook;
end;
 
procedure TForm1.Button2Click(Sender: TObject);
begin
  UnLoadDestroyWndHook;
end;