用户登录  |  用户注册
首 页商业源码原创产品编程论坛
当前位置:PB创新网文章中心编程技巧Delphi

向右键的“新建”菜单中新建一个选项

减小字体 增大字体 作者:佚名  来源:本站整理  发布时间:2009-03-16 20:20:11
右键的“新建”菜单中新建一个选项 参考:看到鼠标的右键会连上一些程序,怎么样把目录的参数或者盘符传递给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 分) 查看完整评论
PB创新网ourmis.com】Copyright © 2000-2009 . All Rights Reserved .
页面执行时间:7,218.75000 毫秒
Email:ourmis@126.com QQ:2322888 蜀ICP备05006790号