Solved

context menu

Posted on 1998-12-08
4
689 Views
Last Modified: 2010-04-04
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
0
Comment
Question by:cando
4 Comments
 
LVL 4

Accepted Solution

by:
BoRiS earned 300 total points
Comment Utility
cando

here is a code snippet from the delphi tips and tricks...

    In Win32, create a new registry entry under the
                              HKEY_CLASSES_ROOT root key that points to the file
                              extension, the command line to invoke, and the icon to
                              display. Under Win16, simply file extension and the command
                              line to invoke in the [Extensions] sections of Win.ini.

                              Example:

                              uses
                                Registry, {For Win32}
                                IniFiles; {For Win16}

                              {For Win32}
                              procedure TForm1.Button1Click(Sender: TObject);
                              var
                                reg: TRegistry;
                              begin
                                reg := TRegistry.Create;
                                reg.RootKey := HKEY_CLASSES_ROOT;
                                reg.LazyWrite := false;
                               {Add Program Support}
                                reg.OpenKey('.bor\shell\open\command',
                                            true);
                              {Invoke the program passing the file name as the first parameter}
                                reg.WriteString('',
                                               'C:\Program Files\Borland\Delphi 3\Project1.exe %1');
                               {Add Icon Display}
                                reg.CloseKey;
                                reg.OpenKey('.bor\DefaultIcon',
                                            true);
                              {Use the first icon in the executable to display}
                                reg.WriteString('',
                                                'C:\Program Files\Borland\Delphi 3\Project1.exe,0');
                                reg.CloseKey;
{Example two}
       reg.OpenKey('\txtfile\shell\hello', true);
       reg.WriteString('', 'say hello');
       reg.OpenKey('\txtfile\shell\hello\command', true);
       reg.WriteString('', 'C:\Windows\notepad.exe %1');
       reg.CloseKey;  
       reg.free;
                              end;

                              {For Win16}
                              procedure TForm1.Button2Click(Sender: TObject);
                              var
                                WinIni : TIniFile;
                                WinIniFileName : array[0..MAX_PATH] of char;
                                s : array[0..64] of char;
                              begin
                                GetWindowsDirectory(WinIniFileName, sizeof(WinIniFileName));
                                StrCat(WinIniFileName, '\win.ini');
                                WinIni := TIniFile.Create(WinIniFileName);
                                WinIni.WriteString('Extensions',
                                             'bor',
                                             'C:\PROGRA~1\BORLAND\DELPHI~1\PROJECT1.EXE ^.bor');
                                WinIni.Free;
                                StrCopy(S, 'Extensions');
                                SendMessage(HWND_BROADCAST, WM_WININICHANGE,
                                     0, LongInt(@S));
                              end;

There are two examples here, one creates an association with a file type and the other one creates a full context menu for txt files, just change what you need your context menu item for...I sent you two examples as sometimes people want an association and sometimes they want context menu...

Later
BoRiS
0
 
LVL 10

Expert Comment

by:Lischke
Comment Utility
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
0
 
LVL 4

Expert Comment

by:jeurk
Comment Utility
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.
0
 
LVL 20

Expert Comment

by:Madshi
Comment Utility
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.
0

Featured Post

Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

Join & Write a Comment

The uses clause is one of those things that just tends to grow and grow. Most of the time this is in the main form, as it's from this form that all others are called. If you have a big application (including many forms), the uses clause in the in…
Hello everybody This Article will show you how to validate number with TEdit control, What's the TEdit control? TEdit is a standard Windows edit control on a form, it allows to user to write, read and copy/paste single line of text. Usua…
It is a freely distributed piece of software for such tasks as photo retouching, image composition and image authoring. It works on many operating systems, in many languages.
Get a first impression of how PRTG looks and learn how it works.   This video is a short introduction to PRTG, as an initial overview or as a quick start for new PRTG users.

762 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

10 Experts available now in Live!

Get 1:1 Help Now