注册文件类型
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+'shellopencommand','',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公文包上下载。
实现全局快捷键 Ctrl+鼠标右键
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;
