Link to home
Start Free TrialLog in
Avatar of cando
cando

asked on

context menu

how could I write a context menu handler to insert menuitems into the windows menus, like winzip. I only want to know how to make a seperator, an icon for my application and another seperator. Iwould then like to add these items into the context menu for a certain type of file. Adding a glyph next to my menu item would be neat also.
Thank you for your help
cando
ASKER CERTIFIED SOLUTION
Avatar of BoRiS
BoRiS
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of Lischke
Lischke
Hi cando, BoRiS,

this is the very first time I tried to post an answer while some other was doing the same. BoRiS, you click the Submit button obviously a few seconds earlier than me :-)) Well, so I have to give you my (already written) answer as comment. Here's the original text:



Hi cando,

what you're going to do needs a bit work, since you have actually to write a shell extension. In your case it's a context menu handler. Here's a copy of my IBContextMenu implementation. There are a few references to other parts of my project, but you can easily take them out. But at least it is a complete implementation (Delphi 4):

unit IBContextMenu;

interface

{$R-}

uses Windows, ActiveX, Classes, ComObj, ShlObj, PIDLManager;

type TMenuType = (mtAlias, mtExtension, mtFile);

     TIBContextMenu = class(TComObject, IContextMenu, IShellExtInit)
     private
       FMenuType  : TMenuType;
       FileList   : TStringList;
       FPIDL      : PIBItem;
       // 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 methods
       function IShellExtInit.Initialize = IShellExtInit_Initialize;
       function IShellExtInit_Initialize(pidlFolder: PItemIDList; lpdobj: IDataObject; hKeyProgID: HKEY): HResult; stdcall;
     public
       destructor Destroy; override;

       procedure Initialize; override;

       property PIDL: PIBItem read FPIDL write FPIDL;
     end;

const Class_IBContextMenu: TGUID = '{5A5D3B5F-7ECA-11D2-AA75-0080C845E84C}';

//--------------------------------------------------------------------------------

implementation

uses ComServ, ShellAPI, SysUtils, WideStrings, DBStuff,
     Tools, IBBrowser, Preferences, Dialogs, Controls;

const // menu IDs
      IDM_FIRST    = 2;
     
      IDM_RENAME   = 2;
      IDM_CONNECT  = 3;
      IDM_ADDNEW   = 4;
      IDM_ADDDB    = 5;
      IDM_DELETE   = 6;
      IDM_EXPLORE  = 7;
      IDM_CLOSE    = 8;

      IDM_LAST     = 8;

//----------------- TIBContextMenu -----------------------------------------------

function TIBContextMenu.GetCommandString(idCmd, uType: UINT; pwReserved: PUINT; pszName: LPSTR; cchMax: UINT): HResult;

const HelpText : array[IDM_FIRST..IDM_LAST] of String =
        ({HELP_RENAME}   'Rename the selected connection',
         {HELP_CONNECT}  'Establish a database connection',
         {HELP_ADDNEW}   'Create a new connection',
         {HELP_ADDDB}    'Add the selected Interbase files to the connection list',
         {HELP_DELETE}   'Remove the selected connection from the list',
         {HELP_EXPLORE}  'Explore all registered connections',
         {HELP_CLOSE}    'Close the selected connection');

begin
  Result:=E_INVALIDARG;

  case uType of
    GCS_HELPTEXTA : begin
                      StrPLCopy(pszName,HelpText[idCmd],cchMax);
                      Result:=NOERROR;
                    end;
    GCS_HELPTEXTW : begin
                     StrPLCopyW(PWideChar(pszName),HelpText[idCmd],cchMax);
                     Result:=NOERROR;
                   end;
    GCS_VERBA : case idCmd of
                  IDM_RENAME : begin
                                 StrLCopy(pszName,'rename',cchMax);
                                 Result:=NOERROR;
                               end;
                  IDM_EXPLORE : begin
                                  StrLCopy(pszName,'explore',cchMax);
                                  Result:=NOERROR;
                                end;
                end;
    GCS_VERBW : case idCmd of
                  IDM_RENAME : begin
                                 StrPLCopyW(PWideChar(pszName),'rename',cchMax);
                                 Result:=NOERROR;
                               end;
                  IDM_EXPLORE : begin
                                  StrPLCopyW(PWideChar(pszName),'explore',cchMax);
                                  Result:=NOERROR;
                                end;
                end;
    GCS_VALIDATEA,
    GCS_VALIDATEW : Result:=NOERROR;
  end;
end;

//--------------------------------------------------------------------------------

procedure TIBContextMenu.Initialize;

// this gets called before IShellExtInit.Initialize

begin
  FileList:=TStringList.Create;
  FMenuType:=mtAlias;
end;

//--------------------------------------------------------------------------------

function TIBContextMenu.InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult;

var Counter : Integer;
    Name    : String;
    Server  : String;
    Temp,
    Item    : PIBItem;

begin
  with lpici do
  begin
    // is the command being sent via a verb ?
    if HiWord(Cardinal(lpVerb)) <> 0 then Result:=NOERROR
                                     else
      if LoWord(Cardinal(lpVerb)) > IDM_LAST then Result:=E_INVALIDARG
                                             else
      begin
        Item:=IDListManager.GetLastItem(FPIDL);
        case LoWord(Cardinal(lpVerb)) of
          IDM_ADDNEW : begin
                         UsePreferences('IBExplorer');
                         Counter:=ReadPreferenceFor('Counter',0);
                         If (Counter = MaxInt) or (Counter < 0) then Counter:=0;
                         Connections.NewConnection('New Connection '+IntToStr(Counter),'Servername','Database path');
                         Inc(Counter);
                         UsePreferences('IBExplorer');
                         WritePreferenceFor('Counter',Counter);
                         if assigned(RootFolder) then SHChangeNotify(SHCNE_UPDATEDIR,SHCNF_IDLIST or SHCNF_FLUSH,RootFolder.AbsoluteLocation,nil);
                         SetStatusTextW('new connection added.');
                       end;
          IDM_DELETE : begin
                         MessageBeep(MB_ICONQUESTION);
                         if MessageDlg('Do you really want to delete this connection permanently?',mtConfirmation,[mbOK,mbCancel],0) = mrOK then
                         begin
                           ReleaseConnectionSet(Pointer(Item));
                           Connections.DeleteConnection(Item.Name);
                           SHChangeNotify(SHCNE_UPDATEDIR,SHCNF_IDLIST or SHCNF_FLUSH,RootFolder.AbsoluteLocation,nil);
                           SetStatusTextW('connection removed.');
                         end;
                       end;
          IDM_CONNECT : begin
                          SetStatusTextW('opening database connection...');
                          CurrentShellBrowser.BrowseObject(Pointer(FPIDL),SBSP_DEFBROWSER or SBSP_DEFMODE or SBSP_ABSOLUTE);
                        end;
          IDM_CLOSE : begin
                        ReleaseConnectionSet(Pointer(Item));
                        SetStatusTextW(Format('connection ''%s'' closed.',[Item.Name]));
                        Temp:=IDListManager.CopyWithoutLast(FPIDL);
                        CurrentShellBrowser.BrowseObject(Pointer(Temp),SBSP_DEFBROWSER or SBSP_DEFMODE or SBSP_ABSOLUTE);
                        SHChangeNotify(SHCNE_SERVERDISCONNECT,SHCNF_IDLIST or SHCNF_FLUSH,FPIDL,nil);
                        IDListManager.FreeItemIDList(Temp);
                      end;
          IDM_ADDDB : begin
                        // Aufruf kam von einem oder mehreren gdb Files, also alle hinzuf|gen,
                        // die Dateiliste wurde schon beim Aufruf zusammengesammelt
                        for Counter:=0 to FileList.Count-1 do
                        begin
                          SetStatusTextW(Format('adding connection ''%s''...',[FileList[Counter]]));
                          Name:=ExtractFileName(FileList[Counter]);
                          Delete(Name,Pos('.',Name),4);
                          Server:=ExpandUNCFileName(FileList[Counter]);
                          if Pos('\\',Server) = 1 then
                          begin
                            Delete(Server,1,2);
                            Server:=Copy(Server,1,Pos('\',Server)-1);
                          end
                          else Server:='';
                          Connections.NewConnection(Name,Server,FileList[Counter]);
                        end;
                        SetStatusTextW('finished adding connection(s).');
                        if assigned(RootFolder) then SHChangeNotify(SHCNE_UPDATEDIR,SHCNF_IDLIST or SHCNF_FLUSH,RootFolder.AbsoluteLocation,nil);
                      end;
        end;
        Result:=NOERROR;
      end;
  end;
end;

//--------------------------------------------------------------------------------

function TIBContextMenu.QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst, idCmdLast, uFlags: UINT): HResult;

var MII    : TMenuItemInfo;
    S      : String;
    LastID : UINT;
    Item   : PIBItem;

begin
  Result:=MakeResult(SEVERITY_SUCCESS,0,0);

  FillChar(MII,SizeOf(MII),0);
  MII.cbSize:=sizeof(MII);

  LastID:=0;
  Item:=IDListManager.GetLastItem(FPIDL);
  if (CMF_DEFAULTONLY and uFlags) = 0 then
  begin
    case FMenuType of
      mtFile: begin
                MII.fMask:=MIIM_ID or MIIM_TYPE or MIIM_STATE;
                MII.wID:=idCmdFirst+IDM_ADDDB;
                if LastID < IDM_ADDDB then LastID:=IDM_ADDDB;
                MII.fType:=MFT_STRING;
                if FileList.Count > 1 then S:='&Add databases to connection list'
                                      else S:='&Add database to connection list';
                MII.dwTypeData:=PChar(S);
                MII.fState:=MFS_ENABLED or MFS_DEFAULT;
                InsertMenuItem(Menu,indexMenu,True,MII);
                Inc(indexMenu);

                MII.fMask:=MIIM_ID or MIIM_TYPE;
                MII.wID:=0;
                MII.fType:=MFT_SEPARATOR;
                InsertMenuItem(Menu,indexMenu,True,MII);
                Inc(indexMenu);
              end;
      mtExtension: begin
                     MII.fMask:=MIIM_ID or MIIM_TYPE or MIIM_STATE;
                     MII.wID:=idCmdFirst+IDM_ADDNEW;
                     if LastID < IDM_ADDNEW then LastID:=IDM_ADDNEW;
                     MII.fType:=MFT_STRING;
                     MII.dwTypeData:='&Add new connection';
                     MII.fState:=MFS_ENABLED or MFS_DEFAULT;
                     InsertMenuItem(Menu,indexMenu,True,MII);
                     Inc(indexMenu);

                     MII.fMask:=MIIM_ID or MIIM_TYPE;
                     MII.wID:=0;
                     MII.fType:=MFT_SEPARATOR;
                     InsertMenuItem(Menu,indexMenu,True,MII);
                     Inc(indexMenu);
                   end;
      mtAlias: begin
                 MII.fMask:=MIIM_ID or MIIM_TYPE or MIIM_STATE;
                 MII.wID:=idCmdFirst+IDM_CONNECT;
                 if LastID < IDM_CONNECT then LastID:=IDM_CONNECT;
                 MII.fType:=MFT_STRING;
                 MII.dwTypeData:='&Open connection';
                 if ConnectionExists(Pointer(Item)) then MII.fState:=MFS_DISABLED
                                                    else MII.fState:=MFS_ENABLED  or MFS_DEFAULT;
                 InsertMenuItem(Menu,indexMenu,True,MII);
                 Inc(indexMenu);

                 MII.wID:=idCmdFirst+IDM_CLOSE;
                 if LastID < IDM_CLOSE then LastID:=IDM_CLOSE;
                 MII.fType:=MFT_STRING;
                 MII.dwTypeData:='&Close connection';
                 if ConnectionExists(Pointer(Item)) then MII.fState:=MFS_ENABLED  or MFS_DEFAULT
                                                    else MII.fState:=MFS_DISABLED;
                 InsertMenuItem(Menu,indexMenu,True,MII);
                 Inc(indexMenu);

                 MII.wID:=idCmdFirst+IDM_DELETE;
                 if LastID < IDM_DELETE then LastID:=IDM_DELETE;
                 MII.fType:=MFT_STRING;
                 MII.dwTypeData:='&Delete connection';
                 MII.fState:=MFS_ENABLED;
                 InsertMenuItem(Menu,indexMenu,True,MII);
                 Inc(indexMenu);

                 if (uFlags and CMF_CANRENAME) <> 0 then
                 begin
                   MII.fMask:=MIIM_ID or MIIM_TYPE;
                   MII.wID:=0;
                   MII.fType:=MFT_SEPARATOR;
                   InsertMenuItem(Menu,indexMenu,True,MII);
                   Inc(indexMenu);

                   MII.fMask:=MIIM_ID or MIIM_TYPE or MIIM_STATE;
                   MII.wID:=idCmdFirst+IDM_RENAME;
                   if LastID < IDM_RENAME then LastID:=IDM_RENAME;
                   MII.fType:=MFT_STRING;
                   MII.dwTypeData:='&Rename connection';
                   MII.fState:=MFS_ENABLED;
                   InsertMenuItem(Menu,indexMenu,True,MII);
                   Inc(indexMenu);
                 end;
               end;
    end;
    if indexMenu > 0 then Result:=MakeResult(SEVERITY_SUCCESS,0,LastID+1)
                     else Result:=MakeResult(SEVERITY_SUCCESS,0,0);
  end;
end;

//--------------------------------------------------------------------------------

function TIBContextMenu.IShellExtInit_Initialize(pidlFolder: PItemIDList; lpdobj: IDataObject; hKeyProgID: HKEY): HResult;

// gets only called when the context menu is used for file objects or the IBBrowser extension itself

var StgMedium   : TStgMedium;
    FormatEtc   : TFormatEtc;
    FileCount   : Integer;
    I           : Integer;
    Buffer      : array[0..MAX_PATH] of Char;

begin
  // fail the call if lpdobj is nil
  if lpdobj = nil then
  begin
    Result:=E_INVALIDARG;
    Exit;
  end;

  // try to read file objects
  with FormatEtc 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(FormatEtc,StgMedium);
  // got we called on file objects?
  if not Failed(Result) then
  begin
    FMenuType:=mtFile;
    // peel out Interbase database files potentially to be added to our alias list
    FileCount:=DragQueryFile(StgMedium.hGlobal,$FFFFFFFF,nil,0);
    for I:=0 to FileCount-1 do
    begin
      DragQueryFile(StgMedium.hGlobal,I,Buffer,MAX_PATH);
      if CompareText(ExtractFileExt(Buffer),'.gdb') = 0 then FileList.Add(Buffer);
    end;
    Result:=NOERROR;
    ReleaseStgMedium(StgMedium);
  end
  else
  begin
    // reading file objects failed, so we got called by a click on the extension
    FMenuType:=mtExtension;
    Result:=NOERROR;
  end;
end;

//--------------------------------------------------------------------------------

destructor TIBContextMenu.Destroy;

begin
  IDListManager.FreeItemIDList(FPIDL);
  FileList.Free;
  inherited;
end;

//--------------------------------------------------------------------------------

initialization
  TComObjectFactory.Create(ComServer, TIBContextMenu, Class_IBContextMenu, 'IBContextMenu', '', ciMultiInstance, tmApartment);
end.

The pidl is only necessary if you want to use the class for a namespace extension too. The code here is to handle in particular Interbase *.gdb files. Change this to your needs.

If you wanna use the "Register ActiveX server" from Delphi's Run menu, then you should use an own derivation of the factory class and override the UpdateRegistry method:

//----------------- TBrowserFactory ----------------------------------------------

type TIBBrowserFactory = class(TComObjectFactory)
     public
       procedure UpdateRegistry(DoRegister: Boolean); override;
     end;

//--------------------------------------------------------------------------------

procedure TIBBrowserFactory.UpdateRegistry(DoRegister: Boolean);

// write all necessary registry keys to make our DLL available to the system if DoRegister is true
// else remove all created keys

var IBDatabaseName,
    MenuID     : String;
    ModuleName : array[0..MAX_PATH] of Char;

begin
  with TRegistry.Create do
  try
    MenuID:=GUIDToString(Class_IBContextMenu);
    if DoRegister then
    begin
      inherited UpdateRegistry(DoRegister);

      // get this DLL's path and file name
      GetModuleFileName(HInstance, ModuleName, MAX_PATH);

      RootKey:=HKEY_CLASSES_ROOT;

      // context menu handler:
      // for gdb files
      OpenKey('\.gdb',True); // read the gdb file name to be used for registering the handler
      IBDatabaseName:=ReadString('');
      // make sure we have a description
      if IBDataBaseName = '' then
      begin
        IBDatabaseName:='InterbaseDatabase';
        WriteString('',IBDatabaseName);
      end;
      OpenKey('\'+IBDatabaseName+'\shellex\ContextMenuHandlers\IBExplorerMenu',True);
      WriteString('',MenuID);
    end
    else
    begin
      RootKey:=HKEY_CLASSES_ROOT;
      // unregister context menu for gdb files
      OpenKey('\.gdb',True); // read the gdb file name to be used for registering the handler
      IBDatabaseName:=ReadString('');
      // do we have a description?
      if Length(IBDataBaseName) > 0 then DeleteKey('\'+IBDatabaseName+'\shellex');
      inherited UpdateRegistry(DoRegister);
    end;
  finally
    Free;
  end;
end;

//--------------------------------------------------------------------------------

Use TIBBrowserFactory instead of TComObjectFactory in the initialization section of the IContextMenu unit. BTW: The term IBExplorerMenu can freely be chosen. Use what you like.

To actually use the code above create a new project (File|New). Use the wizard and choose ActiveX library on the ActiveX page. Then create a COM object (also with the wizard). Replace the upcoming source code with the one supplied here (but keep the new GUID, do NOT use mine (see Class_IBContextMenu), you can still use the name, though).

Ciao, Mike
Avatar of jeurk
jeurk
By the way, there is such a sample supplied with delphi, a context menu handler
and a system copy hook, look in the samples directory.
Avatar of Madshi
Madshi
Have only something to add:

BoRiS solution is nice, but it doesn't display either a seperator in the context menu nor an icon in front of your menu item. If you can live with that, BoRiS' (uaa - this name is ugly to write) it's the easiest method.
But if you want more control, you'll have to write your own shell extension. If you want this you can either look at Mike's comment or at the examples in Delphi's samples directory (like jeurk said).

Regards, Madshi.