向右键的“新建”菜单中新建一个选项
右键的“新建”菜单中新建一个选项 参考:看到鼠标的右键会连上一些程序,怎么样把目录的参数或者盘符传递给Delphi程序呢?鼠标的右键加入连接程序可以修改注册表完成,但是怎样传递目录或者盘符参数呢?例如点右键会自动打开选定的文件夹 ?我想达到的目的也是非常简单,就是在鼠标的右键上增加一个“显示”按纽,用鼠标右键点到一个文件夹,当点“显示”按纽的时候运行程序,并把目录信息显示在edit1.text上。参考这段代码, D5开发者指南的unit ContMain;interfaceuses Windows, ComObj, ShlObj, ActiveX;typeTContextMenu = 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;implementationuses 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.
Tags:
作者:佚名评论内容只代表网友观点,与本站立场无关!
评论摘要(共 0 条,得分 0 分,平均 0 分)
查看完整评论