home *** CD-ROM | disk | FTP | other *** search
/ DOS/V Power Report 1997 August / VPR9708A.ISO / D3TRIAL / INSTALL / DATA.Z / CONTEXTM.PAS < prev    next >
Pascal/Delphi Source File  |  1997-05-12  |  4KB  |  141 lines
  1. unit ContextM;
  2.  
  3.  
  4. interface
  5. uses
  6.     Windows, ComObj, ComServ, ShlObj, ActiveX, ShellApi, SysUtils, Registry;
  7.  
  8. Const
  9.    CLSID_ContextMenuShellExtension: TGUID = (
  10.     D1:$8e3e0f0a; D2:$0fcc; D3:$11ce; D4:($bc, $b0, $b3, $fd, $0e, $25, $38, $1a));
  11.  
  12. type
  13.     TContextMenu = class(TComObject, IShellExtInit, IContextMenu)
  14.     private
  15.       szFile: array[0..MAX_PATH] of Char;
  16.     public
  17.       function QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst, idCmdLast,
  18.         uFlags: UINT): HResult; stdcall;
  19.       function InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult; stdcall;
  20.       function GetCommandString(idCmd, uType: UINT; pwReserved: PUINT;
  21.         pszName: LPSTR; cchMax: UINT): HResult; stdcall;
  22.       function Initialize(pidlFolder: PItemIDList; lpdobj: IDataObject;
  23.         hKeyProgID: HKEY): HResult; stdcall;
  24.     end;
  25.  
  26.  
  27.  
  28. implementation
  29.  
  30. function GetCompilerPath: string;
  31. // Returns string containing path to Delphi command line compiler
  32. var
  33.   Reg: TRegistry;
  34. begin
  35.   Reg := TRegistry.Create;
  36.   try
  37.     with Reg do
  38.     begin
  39.       RootKey := HKEY_LOCAL_MACHINE;
  40.       OpenKey('\SOFTWARE\Borland\Delphi\3.0', False);
  41.       Result := ReadString('RootDir');
  42.     end;
  43.     Result := Result + '\bin\dcc32.exe "%s"';
  44.   finally
  45.     Reg.Free;
  46.   end;
  47. end;
  48.  
  49. function TContextMenu.QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst,
  50.           idCmdLast, uFlags: UINT): HResult;
  51. begin
  52.   // Add one menu item to context menu
  53.   InsertMenu (Menu, indexMenu, MF_STRING or MF_BYPOSITION, idCmdFirst,
  54.     'ｺﾝﾊﾟｲﾙ...');
  55.   // Return number of menu items added
  56.   Result := 1;
  57. end;
  58.  
  59. function TContextMenu.InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult;
  60. var
  61.   H: THandle;
  62. begin
  63.   // Make sure we are not being called by an application
  64.   if HiWord(Integer(lpici.lpVerb)) <> 0 then
  65.   begin
  66.     Result := E_FAIL;
  67.     Exit;
  68.   end;
  69.   // Make sure we aren't being passed an invalid argument number
  70.   if LoWord(lpici.lpVerb) > 0 then
  71.   begin
  72.     Result := E_INVALIDARG;
  73.     Exit;
  74.   end;
  75.   // Execute the command specified by lpici.lpVerb.
  76.   if LoWord(lpici.lpVerb) = 0 then
  77.   begin
  78.     // invoke Delphi command line compiler
  79.     H := WinExec(PChar(Format(GetCompilerPath, [szFile])), lpici.nShow);
  80.     if H < 32 then
  81.       MessageBox(lpici.hWnd, 'Error executing Delphi compiler.', 'Error',
  82.         MB_ICONERROR or MB_OK);
  83.   end;
  84.   Result := NOERROR;
  85. end;
  86.  
  87. function TContextMenu.GetCommandString(idCmd, uType: UINT; pwReserved: PUINT;
  88.   pszName: LPSTR; cchMax: UINT): HRESULT;
  89. begin
  90.   if idCmd = 0 then
  91.   begin
  92.     // return help string for menu item
  93.     strCopy(pszName, 'Compile the selected Delphi project');
  94.     Result := NOERROR;
  95.   end
  96.   else
  97.     Result := E_INVALIDARG;
  98. end;
  99.  
  100. function TContextMenu.Initialize(pidlFolder: PItemIDList; lpdobj: IDataObject;
  101.   hKeyProgID: HKEY): HResult;
  102. var
  103.   medium: TStgMedium;
  104.   fe: TFormatEtc;
  105. begin
  106.   with fe do
  107.   begin
  108.     cfFormat := CF_HDROP;
  109.     ptd := Nil;
  110.     dwAspect := DVASPECT_CONTENT;
  111.     lindex := -1;
  112.     tymed := TYMED_HGLOBAL;
  113.   end;
  114.   // Fail the call if lpdobj is Nil.
  115.   if lpdobj = Nil then
  116.   begin
  117.     Result := E_FAIL;
  118.     Exit;
  119.   end;
  120.   // Render the data referenced by the IDataObject pointer to an HGLOBAL
  121.   // storage medium in CF_HDROP format.
  122.   Result := lpdobj.GetData(fe, medium);
  123.   if Failed(Result) then Exit;
  124.   // If only one file is selected, retrieve the file name and store it in
  125.   // szFile. Otherwise fail the call.
  126.   if DragQueryFile(medium.hGlobal, $FFFFFFFF, Nil, 0) = 1 then
  127.   begin
  128.     DragQueryFile(medium.hGlobal, 0, szFile, SizeOf(szFile));
  129.     Result := NOERROR;
  130.   end
  131.   else
  132.     Result := E_FAIL;
  133.   ReleaseStgMedium(medium);
  134. end;
  135.  
  136. initialization
  137.     TComObjectFactory.Create(ComServer, TContextMenu, CLSID_ContextMenuShellExtension,
  138.          '', 'Delphi 3.0 ContextMenu Example', ciMultiInstance);
  139.  
  140. end.
  141.