• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1746
  • Last Modified:

Context Menu Handler Example

Could some one supply an example of how to implement a Context menu handler in delphi. That is the DLL that is used to generate dynamic menu items for the right clicking on given file types in explorer
0
RoryBecker
Asked:
RoryBecker
  • 5
1 Solution
 
RoryBeckerAuthor Commented:
Edited text of question
0
 
BoRiSCommented:
rorybecker

here is a snippet form the delphi contextmenu stuff...

unit ContextM;


interface
uses
    Windows, ComObj, ComServ, ShlObj, ActiveX, ShellApi, SysUtils, Registry;

Const
   CLSID_ContextMenuShellExtension: TGUID = (
    D1:$8e3e0f0a; D2:$0fcc; D3:$11ce; D4:($bc, $b0, $b3, $fd, $0e, $25, $38, $1a));

type
    TContextMenu = class(TComObject, IShellExtInit, IContextMenu)
    private
      szFile: array[0..MAX_PATH] of Char;
    public
      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;
      function Initialize(pidlFolder: PItemIDList; lpdobj: IDataObject;
        hKeyProgID: HKEY): HResult; stdcall;
    end;



implementation

function GetCompilerPath: string;
// Returns string containing path to Delphi command line compiler
var
  Reg: TRegistry;
begin
  Reg := TRegistry.Create;
  try
    with Reg do
    begin
      RootKey := HKEY_LOCAL_MACHINE;
      OpenKey('\SOFTWARE\Borland\Delphi\3.0', False);
      Result := ReadString('RootDir');
    end;
    Result := Result + '\bin\dcc32.exe %s';
  finally
    Reg.Free;
  end;
end;

function TContextMenu.QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst,
          idCmdLast, uFlags: UINT): HResult;
begin
  // Add one menu item to context menu
  InsertMenu (Menu, indexMenu, MF_STRING or MF_BYPOSITION, idCmdFirst,
    'Compile...');
  // Return number of menu items added
  Result := 1;
end;

function TContextMenu.InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult;
var
  H: THandle;
begin
  // Make sure we are not being called by an application
  if HiWord(Integer(lpici.lpVerb)) <> 0 then
  begin
    Result := E_FAIL;
    Exit;
  end;
  // Make sure we aren't being passed an invalid argument number
  if LoWord(lpici.lpVerb) > 0 then
  begin
    Result := E_INVALIDARG;
    Exit;
  end;
  // Execute the command specified by lpici.lpVerb.
  if LoWord(lpici.lpVerb) = 0 then
  begin
    // invoke Delphi command line compiler
    H := WinExec(PChar(Format(GetCompilerPath, [szFile])), lpici.nShow);
    if H < 32 then
      MessageBox(lpici.hWnd, 'Error executing Delphi compiler.', 'Error',
        MB_ICONERROR or MB_OK);
  end;
  Result := NOERROR;
end;

function TContextMenu.GetCommandString(idCmd, uType: UINT; pwReserved: PUINT;
  pszName: LPSTR; cchMax: UINT): HRESULT;
begin
  if idCmd = 0 then
  begin
    // return help string for menu item
    strCopy(pszName, 'Compile the selected Delphi project');
    Result := NOERROR;
  end
  else
    Result := E_INVALIDARG;
end;

function TContextMenu.Initialize(pidlFolder: PItemIDList; lpdobj: IDataObject;
  hKeyProgID: HKEY): HResult;
var
  medium: TStgMedium;
  fe: TFormatEtc;
begin
  with fe do
  begin
    cfFormat := CF_HDROP;
    ptd := Nil;
    dwAspect := DVASPECT_CONTENT;
    lindex := -1;
    tymed := TYMED_HGLOBAL;
  end;
  // Fail the call if lpdobj is Nil.
  if lpdobj = Nil then
  begin
    Result := E_FAIL;
    Exit;
  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;
  // 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, szFile, SizeOf(szFile));
    Result := NOERROR;
  end
  else
    Result := E_FAIL;
  ReleaseStgMedium(medium);
end;

initialization
    TComObjectFactory.Create(ComServer, TContextMenu, CLSID_ContextMenuShellExtension,
         '', 'Delphi 3.0 ContextMenu Example', ciMultiInstance);

end.

Check out the project it explains everything, if found under....
.\delphi 3\demos\shellext\

Later
BoRiS
0
 
RoryBeckerAuthor Commented:
The delphi Example only shows how to provide one extra item. I should like to understand how to add more than one and ideally how to add a submenu.


0
Upgrade your Question Security!

Your question, your audience. Choose who sees your identity—and your question—with question security.

 
RoryBeckerAuthor Commented:
Not sure if my first comment reached this forum so.....

I am really looking to produce more than one menu item at a time and so need to be able to tell which item was clicked i would guess in the invoke command procedure above

But I would ideally like to learn how to add one or more submenus ala Winzip 6.3


TIA

Rory
0
 
RoryBeckerAuthor Commented:
See Previous comment
0
 
RoryBeckerAuthor Commented:
Adjusted points to 80
0
 
JamCommented:
Hi.

I created small example of work with IContextMenu.
This implementation in _PURE_ COM (Delphi 2, without Delphi 3 features)

Something is take from Microsoft Win 32 SDK.

Here is it:

//**********************************************************************
// File: shl_menu.dpr
//**********************
library shl_menu;

uses
  Ole2, OleAuto, SysUtils,
  shell_ctx;

{$R *.RES}

function DllGetClassObject(const rclsid: TCLSID; const riid: TGUID;
                           var ppv): hResult; stdcall export;
var
  HR:  HRESULT;
  ShellExtClassFactory: TClassFactory;
begin
  if not IsEqualIID(CLSID_ShellExtension, rclsid) then begin
    Result := E_FAIL;
    Exit;
  end;

  try
    ShellExtClassFactory := TClassFactory.Create;
  except
    Result := E_OUTOFMEMORY;
    Exit;
  end;

  hr := ShellExtClassFactory.QueryInterface(riid, ppv);

  if (FAILED(hr)) then begin
    ShellExtClassFactory.Free;
    Result := hr;
    Exit;
  end;
  Result := hr;
end;

function DllCanUnloadNow: hResult;
begin
  if (LockCount = 0) and (ObjCount = 0) then
    Result := S_Ok
  else
    Result := S_False;
end;

exports
  DllGetClassObject name 'DllGetClassObject',
  DllCanUnloadNow name 'DllCanUnloadNow';

begin
end.

//********************************************
// File: shell_ctx.pas
// 1998 by Michael Jastrebtsoff   M_Jastrebtsoff@yahoo.com
// This code based on Microsoft Win 32 SDK
// Copyright (C) 1993-1995  Microsoft Corporation.  All Rights Reserved.

unit Shell_Ctx;

interface

uses
  Ole2, Windows, SysUtils, ShlObj;

const
  // GUID
  CLSID_ShellExtension: TGUID = (
    D1:$C9B0B160;
    D2:$1308;
    D3:$11cf;
    D4:($AB,$35,$00,$00,$C0,$7E,$BA,$2B)
  );

type
  TObjectDestroyed = procedure;

  // This interface need for a correctly initialization for shell
  // context menu's
  TShellExtInit = class(IShellExtInit)
  private
    FRefCount: LongInt;
    FObjectDestroyed: TObjectDestroyed;
    m_pDataObj: IDataObject;
  public
    constructor Create(ObjectDestroyed: TObjectDestroyed);
    destructor  Destroy;
    // IUnknown
    function QueryInterface(const iid: TIID; var obj): HResult; override;
    function AddRef: Longint; override;
    function Release: Longint; override;
    // IShellExtInit
    function Initialize(pidlFolder: PItemIDList; lpdobj: IDataObject;
                        hKeyProgID: HKEY): HResult; override;
  end;

  // implementation of IContextMenu
  TContextMenu = class(IContextMenu)
  private
    FRefCount: LongInt;
    FObjectDestroyed: TObjectDestroyed;
  public
    // IUnknown
    constructor Create(ObjectDestroyed: TObjectDestroyed);
    function QueryInterface(const iid: TIID; var obj): HResult; override;
    function AddRef: Longint; override;
    function Release: Longint; override;
    // IContextMenu
    function QueryContextMenu(Menu: HMENU;
      indexMenu, idCmdFirst, idCmdLast, uFlags: UINT): HResult; override;
    function InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult; override;
    function GetCommandString(idCmd, uType: UINT; pwReserved: PUINT;
      pszName: LPSTR; cchMax: UINT): HResult; override;
  end;

  // Class factory for DLL-objects
  TClassFactory = class(IClassFactory)
  private
    FRefCount: LongInt;
  public
    constructor Create;
    function QueryInterface(const iid: TIID; var obj): HResult; override;
    function AddRef: Longint; override;
    function Release: Longint; override;
    function CreateInstance(unkOuter: IUnknown; const iid: TIID;
      var obj): HResult; override;
    function LockServer(fLock: BOOL): HResult; override;
  end;

var
  LockCount: Integer;
  ObjCount: Integer;

implementation

{$R m_bmps.res }  // bitmaps for menu items

procedure ObjectDestroyed;
begin
  Dec(ObjCount)
end;

{TShellExtInit}
constructor TShellExtInit.Create(ObjectDestroyed: TObjectDestroyed);
begin
  inherited Create;
  FObjectDestroyed := ObjectDestroyed;
  FRefCount := 0;
  m_pDataObj := nil;
end;

destructor TShellExtInit.Destroy;
begin
  if m_pDataObj <> nil then
     m_pDataObj.Release;
end;

function TShellExtInit.QueryInterface(const iid: TIID; var obj): HResult;
var
  ictx_menu: TContextMenu;
  hr: HResult;
begin
  if IsEqualIID(iid, IID_IUnknown) or
     IsEqualIID(iid, IID_IShellExtInit) then
  begin
    Pointer(obj) := Self;
    AddRef;
    Result := S_OK;
  end
  else if IsEqualIID(iid, IID_IContextMenu) then
  begin
    ictx_menu := TContextMenu.Create(ObjectDestroyed);
    if ictx_menu = nil then
    begin
      Pointer(Obj) := nil;
      Result := E_OutOfMemory;
      Exit;
    end;
    hr := ictx_menu.QueryInterface(iid, Obj);
    if Failed(hr) then
      ictx_menu.Free
    else
      Inc(ObjCount);
    Result := hr;
  end
  else
    Result := E_NOINTERFACE;
end;

function TShellExtInit.Initialize(pidlFolder: PItemIDList; lpdobj: IDataObject;
                                  hKeyProgID: HKEY): HResult;
begin
  if m_pDataObj <> nil then
      m_pDataObj.Release;

  // duplicate the object pointer and registry handle
  if lpdobj <> nil then
  begin
    m_pDataObj := lpdobj;
    lpdobj.AddRef;
  end;

  Result := NOERROR;
end;

function TShellExtInit.AddRef: Longint;
begin
  Inc(FRefCount);
  Result := FRefCount;
end;

function TShellExtInit.Release: Longint;
begin
  Dec(FRefCount);
  if FRefCount = 0 then begin
    FObjectDestroyed;
    Free;
    Result := 0;
  end else
    Result := FRefCount;
end;

{ TContextMenu }
constructor TContextMenu.Create(ObjectDestroyed: TObjectDestroyed);
begin
  inherited Create;
  FObjectDestroyed := ObjectDestroyed;
  FRefCount := 0;
end;

function TContextMenu.QueryInterface(const iid: TIID; var obj): HResult;
var
  hr: HResult;
begin
  if IsEqualIID(iid, IID_IUnknown) or
     IsEqualIID(iid, IID_IContextMenu) then
  begin
    Pointer(obj) := Self;
    AddRef;
    Result := S_OK;
  end
  else
    Result := E_NOINTERFACE;
end;

function TContextMenu.AddRef: Longint;
begin
  Inc(FRefCount);
  Result := FRefCount;
end;

function TContextMenu.Release: Longint;
begin
  Dec(FRefCount);
  if FRefCount = 0 then begin
    FObjectDestroyed;
    Free;
    Result := 0;
  end else
    Result := FRefCount;
end;


function TContextMenu.QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst,
                                       idCmdLast, uFlags: UINT): HResult;
const
  ITEMS_COUNT = 4; // number of menu items (separators included)
var
  MenuText1, MenuText2, MenuText3, MenuText4: string;
  bAppendItems: boolean;
  MenuBmp: HBITMAP;
begin
  Result := NOERROR;

  bAppendItems := true;

  if ((uFlags and $000F) = CMF_NORMAL)  then  //Check == here, since CMF_NORMAL=0
  begin
      MenuText1 := '&New menuitem 1, Normal File';
      MenuText2 := '&New menuitem 2, Normal File';
      MenuText3 := '&New menuitem 3, Normal File';
      MenuText4 := '&New menuitem 4, Normal File';
  end
  else if (uFlags and CMF_VERBSONLY) <> 0 then
  begin
      MenuText1 := '&New menuitem 1, Shortcut File';
      MenuText2 := '&New menuitem 2, Shortcut File';
      MenuText3 := '&New menuitem 3, Shortcut File';
      MenuText4 := '&New menuitem 4, Shortcut File';
  end
  else if (uFlags and CMF_EXPLORE) <> 0 then
  begin
      MenuText1 := '&New menuitem 1, Normal File right click in Explorer';
      MenuText2 := '&New menuitem 2, Normal File right click in Explorer';
      MenuText3 := '&New menuitem 3, Normal File right click in Explorer';
      MenuText4 := '&New menuitem 4, Normal File right click in Explorer';
  end
  else if (uFlags and CMF_DEFAULTONLY) <> 0 then
  begin
    bAppendItems := false;
  end
  else // unknown flag
  begin
    bAppendItems := false;
  end;

  // If all Okey insert menu items
  if bAppendItems then
  begin
    InsertMenu(Menu,
                indexMenu,
                MF_STRING or MF_BYPOSITION,
                idCmdFirst,
                PChar(MenuText1)
              );
    InsertMenu(Menu,
                indexMenu + 1,
                MF_STRING or MF_BYPOSITION,
                idCmdFirst + 1,
                PChar(MenuText2)
              );

    InsertMenu(Menu,
                indexMenu + 2,
                MF_STRING or MF_BYPOSITION,
                idCmdFirst + 2,
                PChar(MenuText3)
              );
    InsertMenu(Menu, indexMenu + 3, MF_SEPARATOR or MF_BYPOSITION, 0, Pointer(0));

    InsertMenu(Menu,
                indexMenu + 4,
                MF_STRING or MF_BYPOSITION,
                idCmdFirst + 3,
                PChar(MenuText4)
              );
    Result := ITEMS_COUNT; //Must return number of menu
                           //items we added.
   
    // Set image for menu item 1
    MenuBmp := LoadBitmap(hInstance, 'M_BMP1'); // load from *.res
    SetMenuItemBitmaps( Menu,      // menu handle
            indexMenu,            
            MF_BYPOSITION,
            MenuBmp,              // Bitmap handle for uncheked item
            MenuBmp);             // Bitmap handle for checked item

    // Set image for menu item 2
    MenuBmp := LoadBitmap(hInstance, 'M_BMP2');
    SetMenuItemBitmaps( Menu,
            indexMenu+1,
            MF_BYPOSITION,
            MenuBmp,
            MenuBmp);

    // Set image for menu item 3
    MenuBmp := LoadBitmap(hInstance, 'M_BMP3');
    SetMenuItemBitmaps( Menu,
            indexMenu+2,
            MF_BYPOSITION,
            MenuBmp,
            MenuBmp);
  end;
end;

function TContextMenu.InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult;
var
  hr: HResult;
  idCmd: cardinal;
begin
  Result := E_INVALIDARG;

  //If HIWORD(lpcmi->lpVerb) then we have been called programmatically
  //and lpVerb is a command that should be invoked.  Otherwise, the shell
  //has called us, and LOWORD(lpcmi->lpVerb) is the menu ID the user has
  //selected.  Actually, it's (menu ID - idCmdFirst) from QueryContextMenu().
  if  not HiWord(Integer(lpici.lpVerb)) <> 0 then
  begin
    idCmd := LoWord(Integer(lpici.lpVerb));

    Result := NOERROR;
    MessageBox(lpici.hwnd, PChar('Invoke menu item ' + IntToStr(idCmd+1)), 'Shell Extension Sample', MB_OK);

    {** Realistic handling:
     case idCmd of
       0: begin SomethingDo; end;  // Click on menu item 1
       1: begin ....         end;  // Click on menu item 2
       2: begin ....         end;  // ..........
       3: begin ....         end;
     end;
    **}
  end;
end;

function TContextMenu.GetCommandString(idCmd, uType: UINT; pwReserved: PUINT;
      pszName: LPSTR; cchMax: UINT): HResult;
begin
  case idCmd of
    0: StrCopy(pszName, 'New menu item number 1');
    1: StrCopy(pszName, 'New menu item number 2');
    2: StrCopy(pszName, 'New menu item number 3');
    3: StrCopy(pszName, 'New menu item number 4');
  end;
  Result := NOERROR;
end;

{ --- TClassFactory --- }

constructor TClassFactory.Create;
begin
  inherited Create;
  FRefCount := 0;
end;

function TClassFactory.QueryInterface(const iid: TIID; var obj): HResult;
begin
  if IsEqualIID(iid, IID_IClassFactory) or
     IsEqualIID(iid, IID_IUnknown) then begin
    Pointer(obj) := Self;
    AddRef;
    Result := S_OK;
  end else begin
    Pointer(obj) := nil;
    Result := E_NOINTERFACE;
  end;
end;

function TClassFactory.AddRef: Longint;
begin
  Inc(FRefCount);
  Result := FRefCount;
end;

function TClassFactory.Release: Longint;
begin
  Dec(FRefCount);
  if FRefCount = 0 then begin
    Destroy;
    Result := 0;
  end else
    Result := FRefCount;
end;

function TClassFactory.CreateInstance(UnkOuter: IUnknown;
                                        const iid: Tiid;
                                        var Obj): hResult;
var
  hr: HResult;
  ShellExt: TShellExtInit;
  ShellMenu: TContextMenu;
begin
  if UnkOuter <> nil then begin
    Result := E_Fail;
    Exit;
  end;
  if (not isEqualIID(iid, IID_IUnknown)) and
     (not isEqualIID(iid, IID_IShellExtInit)) then begin
    Result := E_Fail;
    Exit;
  end;

  ShellExt := TShellExtInit.Create(ObjectDestroyed);

  if ShellExt = nil then
  begin
    Pointer(Obj) := nil;
    Result := E_OutOfMemory;
    Exit;
  end;

  hr := ShellExt.QueryInterface(iid, Obj);
  if Failed(hr) then
    ShellExt.Free
  else
    Inc(ObjCount);

  Result := hr;
end;

function TClassFactory.LockServer(fLock: BOOL): HResult;
begin
  if fLock then
    Inc(LockCount)
  else
    Dec(LockCount);
  Result := S_Ok;
end;


initialization
  LockCount := 0;
  ObjCount := 0;
end.

;********************
; File: shl_ctx.reg

REGEDIT4

[HKEY_CLASSES_ROOT\CLSID\{C9B0B160-1308-11cf-AB35-0000c07eba2b}]
   @="Shell context menu's sample"
[HKEY_CLASSES_ROOT\CLSID\{C9B0B160-1308-11cf-AB35-0000c07eba2b}\InProcServer32]
   @="E:\\PROJECTS\\SHELL\\SHELL_CTX\\shl_menu.dll"
     "ThreadingModel"="Apartment"

[HKEY_CLASSES_ROOT\directory\shellex\ContextMenuHandlers\ShellCtxSample]
   @="{C9B0B160-1308-11cf-AB35-0000c07eba2b}"

[HKEY_CLASSES_ROOT\*\shellex\ContextMenuHandlers\ShellCtxSample]
   @="{C9B0B160-1308-11cf-AB35-0000c07eba2b}"

[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved]
   "{C9B0B160-1308-11cf-AB35-0000c07eba2b}"="Shell context menu's sample"

// File: m_bmps.rc (anything bitmaps here)
M_BMP1 BITMAP "M1.BMP"
M_BMP2 BITMAP "M2.BMP"
M_BMP3 BITMAP "M3.BMP"

--------------------------------------END------------------------------------
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Cloud Class® Course: Microsoft Windows 7 Basic

This introductory course to Windows 7 environment will teach you about working with the Windows operating system. You will learn about basic functions including start menu; the desktop; managing files, folders, and libraries.

  • 5
Tackle projects and never again get stuck behind a technical roadblock.
Join Now