filename));
filelist.add(ffilename);
result := noerror;
end;
releasestgmedium(stgmedium);
end;
function tcontextmenu.querycontextmenu(menu: hmenu; indexmenu, idcmdfirst,
idcmdlast, uflags: uint): hresult;
begin
result := 0;
if ((uflags and $0000000f) = cmf_normal) or
((uflags and cmf_explore) <> 0) then begin
// 往context menu中加入一个菜单项 ,菜单项的标题为察看位图文件
insertmenu(menu, indexmenu, mf_string or mf_byposition, idcmdfirst,
pchar(''文件操作''));
// 返回增加菜单项的个数
result := 1;
end;
end;
function tcontextmenu.invokecommand(var lpici: tcminvokecommandinfo): hresult;
var
frmop:tform1;
begin
// 首先确定该过程是被系统而不是被一个
程序所调用
if (hiword(integer(lpici.lpverb)) <> 0) then
begin
result := e_fail;
exit;
end;
// 确定传递的参数的有效性
if (loword(lpici.lpverb) <> 0) then begin
result := e_invalidarg;
exit;
end;
file://建立文件操作窗口
frmop:=tform1.create(nil);
file://将所有的文件列表添加到文件操作窗口的列表中
frmop.listbox1.items := filelist;
result := noerror;
end;
function tcontextmenu.getcommandstring(idcmd, utype: uint; pwreserved: puint;
pszname: lpstr; cchmax: uint): hresult;
begin
if (idcmd = 0) then begin
if (utype = gcs_helptext) then
{返回该菜单项的帮助信息,此帮助信息将在用户把鼠标
移动到该菜单项时出现在状态条上。}
strcopy(pszname, pchar(''点击该菜单项将执行文件操作''));
result := noerror;
end
else
result := e_invalidarg;
end;
type
tcontextmenufactory = class(tcomobjectfactory)
public
procedure updateregistry(register: boolean); override;
end;
procedure tcontextmenufactory.updateregistry(register: boolean);
var
classid: string;
begin
if register then begin
inherited updateregistry(register);
classid := guidtostring(class_contextmenu);
file://当注册扩展库文件时,添加库到注册表中
createregkey(''*\shellex'', '''', '''');
createregkey(''*\shellex\contextmenuhandlers'', '''', '''');
createregkey(''*\shellex\contextmenuhandlers\fileopreation'', '''', classid);
file://如果操作系统为windows nt的话
if (win32platform = ver_platform_win32_nt) then
with tregistry.create do
try
rootkey := hkey_local_machine;
openkey(''software\microsoft\windows\currentversion\shell extensions'', true);
openkey(''approved'', true);
writestring(classid, ''context menu shell extension'');
finally
free;
end;
end
else begin
deleteregkey(''*\shellex\contextmenuhandlers\fileopreation'');
inherited updateregistry(register);
end;
end;
initialization
tcontextmenufactory.create(comserver, tcontextmenu, class_contextmenu,
'''', ''context menu shell extension'', cimultiinstance,tmapartment);
end.
在opwindow窗口中加入一个tlistbox控件和两个tbutton控件,opwindows.pas的
程序清单如下:
unit opwindow;
interface
uses
windows, messages, sysutils, classes, graphics, controls, forms, dialogs,
extctrls, stdctrls,shlobj,shellapi,activex;
type
tform1 = class(tform)
listbox1: tlistbox;
button1: tbutton;
button2: tbutton;
procedure formcreate(sender: tobject);
procedure formclose(sender: tobject; var action: tcloseaction);
procedure button1click(sender: