Delphi知识中心
www.delphi.ee
提供Delphi技术知识
与Delphi程序员共同进步


在线服务QQ:99923144 随时恭候您的光临
首页 基础知识 WIN系统 组件使用 组件开发 数据库 ACTIVEX 多媒体技术 网络技术 关于
文章类别:ACTIVEX    你尚未登陆,会员功能无法使用,请从 网站首页 登陆。
  向右键的“新建”菜单中新建一个选项  
 
向右键的“新建”菜单中新建一个选项

右键的“新建”菜单中新建一个选项
参考:
看到鼠标的右键会连上一些程序,怎么样把目录的参数或者盘符传递给Delphi程序呢?

鼠标的右键加入连接程序可以修改注册表完成,但是怎样传递目录或者盘符参数呢?

例如点右键会自动打开选定的文件夹 ?

我想达到的目的也是非常简单,就是在鼠标的右键上增加一个“显示”按纽,
用鼠标右键点到一个文件夹,当点“显示”按纽的时候运行程序,并把目录信息显示在edit1.text上。


参考这段代码, D5开发者指南的

unit ContMain;

interface

uses Windows, ComObj, ShlObj, ActiveX;

type
TContextMenu = class(TComObject, IContextMenu, IShellExtInit)
private
FFileName: array[0..MAX_PATH] of char;
FMenuIdx: UINT;
protected
// IContextMenu methods
function QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst, idCmdLast,uFlags: UINT): HResult;
stdcall;
function InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult; stdcall;
function GetCommandString(idCmd, uType: UINT; pwReserved: PUINT;pszName: LPSTR; cchMax: UINT):
HResult; stdcall;
// IShellExtInit method
function Initialize(pidlFolder: PItemIDList; lpdobj: IDataObject;hKeyProgID: HKEY): HResult;
reintroduce; stdcall;
end;

TContextMenuFactory = class(TComObjectFactory)
protected
function GetProgID: string; override;
procedure ApproveShellExtension(Register: Boolean; const ClsID: string);
virtual;
public
procedure UpdateRegistry(Register: Boolean); override;
end;

implementation

uses ComServ, SysUtils, ShellAPI, Registry;

procedure ExecutePackInfoApp(const FileName: string; ParentWnd: HWND);
const
SPackInfoApp = '%sPackInfo.exe';
SCmdLine = '"%s" %s';
SErrorStr = 'Failed to execute PackInfo:'#13#10#13#10;
var
PI: TProcessInformation;
SI: TStartupInfo;
ExeName, ExeCmdLine: string;
Buffer: array[0..MAX_PATH] of char;
begin
// Get directory of this DLL. Assume EXE being executed is in same dir.
GetModuleFileName(HInstance, Buffer, SizeOf(Buffer));
ExeName := Format(SPackInfoApp, [ExtractFilePath(Buffer)]);
ExeCmdLine := Format(SCmdLine, [ExeName, FileName]);
FillChar(SI, SizeOf(SI), 0);
SI.cb := SizeOf(SI);
if not CreateProcess(PChar(ExeName), PChar(ExeCmdLine), nil, nil, False,0, nil, nil, SI, PI)
then
MessageBox(ParentWnd, PChar(SErrorStr + SysErrorMessage(GetLastError)),'Error', MB_OK or
MB_ICONERROR);
end;

{ TContextMenu }

{ TContextMenu.IContextMenu }

function TContextMenu.QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst,idCmdLast, uFlags:
UINT): HResult;
begin
FMenuIdx := indexMenu;
// Add one menu item to context menu
InsertMenu (Menu, FMenuIdx, MF_STRING or MF_BYPOSITION, idCmdFirst,'Package Info...');
// Return index of last inserted item + 1
Result := FMenuIdx + 1;
end;

function TContextMenu.InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult;
begin
Result := S_OK;
try
// Make sure we are not being called by an application
if HiWord(Integer(lpici.lpVerb)) <> 0 then
begin
Result := E_FAIL;
Exit;
end;
// Execute the command specified by lpici.lpVerb.
// Return E_INVALIDARG if we are passed an invalid argument number.
if LoWord(lpici.lpVerb) = FMenuIdx then
ExecutePackInfoApp(FFileName, lpici.hwnd)
else
Result := E_INVALIDARG;
except
MessageBox(lpici.hwnd, 'Error obtaining package information.', 'Error',MB_OK or MB_ICONERROR);
Result := E_FAIL;
end;
end;

function TContextMenu.GetCommandString(idCmd, uType: UINT; pwReserved: PUINT;pszName: LPSTR;
cchMax: UINT): HRESULT;
begin
Result := S_OK;
try
// make sure menu index is correct, and shell is asking for help string
if (idCmd = FMenuIdx) and ((uType and GCS_HELPTEXT) <> 0) then
// return help string for menu item
StrLCopy(pszName, 'Get information for the selected package.', cchMax)
else
Result := E_INVALIDARG;
except
Result := E_UNEXPECTED;
end;
end;

{ TContextMenu.IShellExtInit }

function TContextMenu.Initialize(pidlFolder: PItemIDList; lpdobj: IDataObject;
hKeyProgID: HKEY): HResult;
var
Medium: TStgMedium;
FE: TFormatEtc;
begin
try
// Fail the call if lpdobj is nil.
if lpdobj = nil then
begin
Result := E_FAIL;
Exit;
end;
with FE do
begin
cfFormat := CF_HDROP;
ptd := nil;
dwAspect := DVASPECT_CONTENT;
lindex := -1;
tymed := TYMED_HGLOBAL;
end;
// Render the data referenced by the IDataObject pointer to an HGLOBAL
// storage medium in CF_HDROP format.
Result := lpdobj.GetData(FE, Medium);
if Failed(Result) then
Exit;
try
// If only one file is selected, retrieve the file name and store it in
// szFile. Otherwise fail the call.
if DragQueryFile(Medium.hGlobal, $FFFFFFFF, nil, 0) = 1 then
begin
DragQueryFile(Medium.hGlobal, 0, FFileName, SizeOf(FFileName));
Result := NOERROR;
end
else
Result := E_FAIL;
finally
ReleaseStgMedium(medium);
end;
except
Result := E_UNEXPECTED;
end;
end;

{ TContextMenuFactory }

function TContextMenuFactory.GetProgID: string;
begin
// ProgID not required for context menu shell extension
Result := '';
end;

procedure TContextMenuFactory.UpdateRegistry(Register: Boolean);
var
ClsID: string;
begin
ClsID := GUIDToString(ClassID);
inherited
UpdateRegistry(Register);
ApproveShellExtension(Register, ClsID);
if Register then
begin
// must register .bpl as a file type
CreateRegKey('.bpl', '', 'BorlandPackageLibrary');
// register this DLL as a context menu handler for .bpl files
CreateRegKey('BorlandPackageLibrary\shellex\ContextMenuHandlers\'+ClassName, '', ClsID);
end
else begin
DeleteRegKey('.bpl');
DeleteRegKey('BorlandPackageLibrary\shellex\ContextMenuHandlers\' +
ClassName);
end;
end;

procedure TContextMenuFactory.ApproveShellExtension(Register: Boolean;const ClsID: string);
// This registry entry is required in order for the extension to
// operate correctly under Windows NT.
const
SApproveKey = 'SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved';
begin
with TRegistry.Create do
try
RootKey := HKEY_LOCAL_MACHINE;
if not OpenKey(SApproveKey, True) then
Exit;
if Register then
WriteString(ClsID, Description)
else
DeleteValue(ClsID);
finally
Free;
end;
end;

const
CLSID_CopyHook: TGUID = '{7C5E74A0-D5E0-11D0-A9BF-E886A83B9BE5}';

initialization
TContextMenuFactory.Create(ComServer, TContextMenu, CLSID_CopyHook,'D4DG_ContextMenu', 'D4DG
Context Menu Shell Extension Example',ciMultiInstance, tmApartment);
end.


 

在线服务QQ:99923144 Delphi程序员QQ群(139442)
Delphi知识中心 www.delphi.ee 最专业的Delphi技术资料网站