Solved

Context Menu shell extension ...

Posted on 2002-06-11
14
1,134 Views
Last Modified: 2010-10-13
I need a COM server demo
of Context Menu shell extension .
I want to know
how to insert a new menuitem in the contextmenu of shell ,
and this menuitem has a submenu , has an icon .

If you can give a demo that show us  
how to add an OWNERDRAW menuitem into the contextmenu ,
just like AcdSystem PicaView doing ,
I will be very glad to pay another 500 points to you .

Many thanks ...
wishing ...
0
Comment
Question by:sina2000
  • 7
  • 4
  • 3
14 Comments
 
LVL 3

Expert Comment

by:Slavak
ID: 7070523
you need make com object that implements IShellExtInit, IContextMenu and IContextMenu2 interfaces.

IContextMenu2 interface has method HandleMenuMsg that receive WM_DRAWITEM message, so you can override it
0
 
LVL 12

Expert Comment

by:Lee_Nover
ID: 7071136
if you don't mind the components being commercial then I suggest you use ShellPlus from http://www.shellplus.com/

regarding yourproblem you simply assign a menu to the TSxContextMenu component
do the Custom drawing as you would with any other menu :)
0
 

Author Comment

by:sina2000
ID: 7071704
Thank you . But I want to study . :-)
I need demos ...
0
 

Author Comment

by:sina2000
ID: 7071850

There is some tips below :

http://www.thecodeproject.com/shell/shellextguideindex.asp

But it is in VC++ , I need some demos in delphi ...

:-)

Popmenu , ownerdraw ...
0
 
LVL 12

Expert Comment

by:Lee_Nover
ID: 7071947
I'll check it out later ... here's a bit of code to handle the ContextMenus

uses windows, shlobj;

type
  TlnShellExtMenu = class(TInterfacedObject, IContextMenu)
  private
    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;
  public
    // maybe your own constructor ?
  end;




{ TlnShellExtMenu }

function TlnShellExtMenu.GetCommandString(idCmd, uType: UINT;
  pwReserved: PUINT; pszName: LPSTR; cchMax: UINT): HResult;
begin
     Result:=S_OK; // or any OLE error code
     // here you copy the items caption where idCmd is the items Index
     if uType = GCS_HELPTEXT then
        StrPLCopy(pszName, 'the menuitems caption', cchMax);
end;

function TlnShellExtMenu.InvokeCommand(
  var lpici: TCMInvokeCommandInfo): HResult;
begin
     // lpici.lpVerb is your custom menuitem identifier (it's Index perhaps)
     // so you simply call Menu.Items[lpici.lpVerb].Click;
     // haven't tried it but it should be like that
end;

function TlnShellExtMenu.QueryContextMenu(Menu: HMENU; indexMenu,
  idCmdFirst, idCmdLast, uFlags: UINT): HResult;
begin
     // here you get queried about the menu to be inserted
     // Menu is the handle of the Parent menu where to insert the menuitems
     // you insert he menuitems with InsertMenu macro
     // you will also need to check if your menuitem has subitems
     // then add the menuitems recursivelly
end;


I don't have the time to write the complete code .. but this should be enough to get you started

I might be adding more code to this and maybe make it work :)
0
 

Author Comment

by:sina2000
ID: 7071978
Yeah ...
Thank you very much .(& Sorry for my bad english) :-)
I myself have gotten my started 2 days ago .
But I don't know how to do

  SubMenu & OwnerDraw ...
  ~~~~~~~~~~~~~~~~~~~

My codes for you below :
-----------------------

unit main;

interface

uses
  Windows, ActiveX, ComObj, ShlObj, graphics;

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

const
  Class_ContextMenu: TGUID = '{B535C4E9-10C2-4F53-B77E-045DF3C1AE93}';

implementation

uses ComServ, SysUtils, ShellApi, Registry;

function TContextMenu.SEIInitialize(pidlFolder: PItemIDList; lpdobj: IDataObject;
  hKeyProgID: HKEY): HResult;
var
  StgMedium: TStgMedium;
  FormatEtc: TFormatEtc;
begin
  if (lpdobj = nil) then begin
    Result := E_INVALIDARG;
    Exit;
  end;

  with FormatEtc do begin
    cfFormat := CF_HDROP;
    ptd      := nil;
    dwAspect := DVASPECT_CONTENT;
    lindex   := -1;
    tymed    := TYMED_HGLOBAL;
  end;


  Result := lpdobj.GetData(FormatEtc, StgMedium);
  if Failed(Result) then
    Exit;

  if (DragQueryFile(StgMedium.hGlobal, $FFFFFFFF, nil, 0) = 1) then begin
    DragQueryFile(StgMedium.hGlobal, 0, FFileName, SizeOf(FFileName));
    Result := NOERROR;
  end
  else begin
    FFileName[0] := #0;
    Result := E_FAIL;
  end;
  ReleaseStgMedium(StgMedium);
end;

function TContextMenu.QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst,
          idCmdLast, uFlags: UINT): HResult;
const
     ITEMS_COUNT = 5;
var
   MenuText1, MenuText2, MenuText3, MenuText4: string;

begin
    Result := NOERROR;
    if BT = nil then BT := TBitmap.Create;
    BT.LoadFromResourceName(HInstance, 'LIGHT');

    if ((uFlags and $0000000F)=CMF_NORMAL) then 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
         exit;
    end
    else begin
         exit;
    end;

    InsertMenu(Menu,indexMenu,MF_SEPARATOR or MF_BYPOSITION, 0, Pointer(0));
    InsertMenu(Menu,indexMenu + 1,MF_STRING or MF_BYPOSITION,idCmdFirst + 1,PChar(MenuText1));
    InsertMenu(Menu,indexMenu + 2,MF_STRING or MF_BYPOSITION,idCmdFirst + 2,PChar(MenuText2));
    InsertMenu(Menu,indexMenu + 3,MF_STRING or MF_BYPOSITION,idCmdFirst + 3,PChar(MenuText3));
    InsertMenu(Menu,indexMenu + 4,MF_STRING or MF_BYPOSITION,idCmdFirst + 4,PChar(MenuText4));
    InsertMenu(Menu,indexMenu + 5,MF_SEPARATOR or MF_BYPOSITION, 0, Pointer(0));

    SetMenuItemBitmaps(Menu,indexMenu + 1,MF_BYPOSITION,BT.Handle,BT.Handle);
    SetMenuItemBitmaps(Menu,indexMenu + 2,MF_BYPOSITION,BT.Handle,BT.Handle);
    SetMenuItemBitmaps(Menu,indexMenu + 3,MF_BYPOSITION,BT.Handle,BT.Handle);
    SetMenuItemBitmaps(Menu,indexMenu + 4,MF_BYPOSITION,BT.Handle,BT.Handle);

    Result := ITEMS_COUNT;
end;


function TContextMenu.InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult;
var
   idCmd: cardinal;

begin
    Result := E_INVALIDARG;

    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)),'Shell Extension Sample',MB_OK);

    end;
end;

function TContextMenu.GetCommandString(idCmd, uType: UINT; pwReserved: PUINT;
  pszName: LPSTR; cchMax: UINT): HRESULT;
begin
    if (uType = GCS_HELPTEXT) then begin
       StrCopy(pszName, PChar('Invoke menu item '+IntToStr(idCmd)));
       Result := NOERROR;
    end
    else Result := E_INVALIDARG;
end;

type
  TContextMenuFactory = class(TComObjectFactory)
  public
    procedure UpdateRegistry(Register: Boolean); override;
  end;

procedure TContextMenuFactory.UpdateRegistry(Register: Boolean);
var
  ClassID: string;
begin
  if Register then begin
    inherited UpdateRegistry(Register);

    ClassID := GUIDToString(Class_ContextMenu);
    CreateRegKey('DelphiProject\shellex', '', '');
    CreateRegKey('DelphiProject\shellex\ContextMenuHandlers', '', '');
    CreateRegKey('DelphiProject\shellex\ContextMenuHandlers\ContMenu', '', ClassID);

    if (Win32Platform = VER_PLATFORM_WIN32_NT) then
      with TRegistry.Create do
        try
          RootKey := HKEY_LOCAL_MACHINE;
          OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions', True);
          OpenKey('Approved', True);
          WriteString(ClassID, 'Delphi Context Menu Shell Extension Example');
        finally
          Free;
        end;
  end
  else begin
    DeleteRegKey('DelphiProject\shellex\ContextMenuHandlers\ContMenu');
    DeleteRegKey('DelphiProject\shellex\ContextMenuHandlers');
    DeleteRegKey('DelphiProject\shellex');

    inherited UpdateRegistry(Register);
  end;
end;

initialization
  TContextMenuFactory.Create(ComServer, TContextMenu, Class_ContextMenu,
    '', 'Delphi Context Menu Shell Extension Example', ciMultiInstance,
    tmApartment);
end.

0
 

Author Comment

by:sina2000
ID: 7072016
Yeah ...
Thank you very much .(& Sorry for my bad english) :-)
I myself have gotten my started 2 days ago .
But I don't know how to do

  SubMenu & OwnerDraw ...
  ~~~~~~~~~~~~~~~~~~~

My codes for you below :
-----------------------

unit main;

interface

uses
  Windows, ActiveX, ComObj, ShlObj, graphics;

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

const
  Class_ContextMenu: TGUID = '{B535C4E9-10C2-4F53-B77E-045DF3C1AE93}';

implementation

uses ComServ, SysUtils, ShellApi, Registry;

function TContextMenu.SEIInitialize(pidlFolder: PItemIDList; lpdobj: IDataObject;
  hKeyProgID: HKEY): HResult;
var
  StgMedium: TStgMedium;
  FormatEtc: TFormatEtc;
begin
  if (lpdobj = nil) then begin
    Result := E_INVALIDARG;
    Exit;
  end;

  with FormatEtc do begin
    cfFormat := CF_HDROP;
    ptd      := nil;
    dwAspect := DVASPECT_CONTENT;
    lindex   := -1;
    tymed    := TYMED_HGLOBAL;
  end;


  Result := lpdobj.GetData(FormatEtc, StgMedium);
  if Failed(Result) then
    Exit;

  if (DragQueryFile(StgMedium.hGlobal, $FFFFFFFF, nil, 0) = 1) then begin
    DragQueryFile(StgMedium.hGlobal, 0, FFileName, SizeOf(FFileName));
    Result := NOERROR;
  end
  else begin
    FFileName[0] := #0;
    Result := E_FAIL;
  end;
  ReleaseStgMedium(StgMedium);
end;

function TContextMenu.QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst,
          idCmdLast, uFlags: UINT): HResult;
const
     ITEMS_COUNT = 5;
var
   MenuText1, MenuText2, MenuText3, MenuText4: string;

begin
    Result := NOERROR;
    if BT = nil then BT := TBitmap.Create;
    BT.LoadFromResourceName(HInstance, 'LIGHT');

    if ((uFlags and $0000000F)=CMF_NORMAL) then 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
         exit;
    end
    else begin
         exit;
    end;

    InsertMenu(Menu,indexMenu,MF_SEPARATOR or MF_BYPOSITION, 0, Pointer(0));
    InsertMenu(Menu,indexMenu + 1,MF_STRING or MF_BYPOSITION,idCmdFirst + 1,PChar(MenuText1));
    InsertMenu(Menu,indexMenu + 2,MF_STRING or MF_BYPOSITION,idCmdFirst + 2,PChar(MenuText2));
    InsertMenu(Menu,indexMenu + 3,MF_STRING or MF_BYPOSITION,idCmdFirst + 3,PChar(MenuText3));
    InsertMenu(Menu,indexMenu + 4,MF_STRING or MF_BYPOSITION,idCmdFirst + 4,PChar(MenuText4));
    InsertMenu(Menu,indexMenu + 5,MF_SEPARATOR or MF_BYPOSITION, 0, Pointer(0));

    SetMenuItemBitmaps(Menu,indexMenu + 1,MF_BYPOSITION,BT.Handle,BT.Handle);
    SetMenuItemBitmaps(Menu,indexMenu + 2,MF_BYPOSITION,BT.Handle,BT.Handle);
    SetMenuItemBitmaps(Menu,indexMenu + 3,MF_BYPOSITION,BT.Handle,BT.Handle);
    SetMenuItemBitmaps(Menu,indexMenu + 4,MF_BYPOSITION,BT.Handle,BT.Handle);

    Result := ITEMS_COUNT;
end;


function TContextMenu.InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult;
var
   idCmd: cardinal;

begin
    Result := E_INVALIDARG;

    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)),'Shell Extension Sample',MB_OK);

    end;
end;

function TContextMenu.GetCommandString(idCmd, uType: UINT; pwReserved: PUINT;
  pszName: LPSTR; cchMax: UINT): HRESULT;
begin
    if (uType = GCS_HELPTEXT) then begin
       StrCopy(pszName, PChar('Invoke menu item '+IntToStr(idCmd)));
       Result := NOERROR;
    end
    else Result := E_INVALIDARG;
end;

type
  TContextMenuFactory = class(TComObjectFactory)
  public
    procedure UpdateRegistry(Register: Boolean); override;
  end;

procedure TContextMenuFactory.UpdateRegistry(Register: Boolean);
var
  ClassID: string;
begin
  if Register then begin
    inherited UpdateRegistry(Register);

    ClassID := GUIDToString(Class_ContextMenu);
    CreateRegKey('DelphiProject\shellex', '', '');
    CreateRegKey('DelphiProject\shellex\ContextMenuHandlers', '', '');
    CreateRegKey('DelphiProject\shellex\ContextMenuHandlers\ContMenu', '', ClassID);

    if (Win32Platform = VER_PLATFORM_WIN32_NT) then
      with TRegistry.Create do
        try
          RootKey := HKEY_LOCAL_MACHINE;
          OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions', True);
          OpenKey('Approved', True);
          WriteString(ClassID, 'Delphi Context Menu Shell Extension Example');
        finally
          Free;
        end;
  end
  else begin
    DeleteRegKey('DelphiProject\shellex\ContextMenuHandlers\ContMenu');
    DeleteRegKey('DelphiProject\shellex\ContextMenuHandlers');
    DeleteRegKey('DelphiProject\shellex');

    inherited UpdateRegistry(Register);
  end;
end;

initialization
  TContextMenuFactory.Create(ComServer, TContextMenu, Class_ContextMenu,
    '', 'Delphi Context Menu Shell Extension Example', ciMultiInstance,
    tmApartment);
end.

0
6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

 
LVL 12

Expert Comment

by:Lee_Nover
ID: 7072187
aahhh :)
well I'll check on that code and see what can be done bout it
0
 

Author Comment

by:sina2000
ID: 7072322
Waiting ...   :-)

btw: I am a chinese boy . I am not able to speak english well ~   *^^p*
0
 
LVL 3

Expert Comment

by:Slavak
ID: 7072760
Hi, I see the question still open, so here is working code:

unit unExtMenu;

interface

uses
  Messages, Windows, SysUtils, ComObj, ActiveX, ExtMenu_TLB, StdVcl, shlobj,
  Dialogs, Registry, Graphics, Menus, Classes, Forms;

Const
  myFileExt = '.aaa';

type
  TMyExtMenu = class(TAutoObject, IMyExtMenu, IShellExtInit, IContextMenu)
  private
    FDataObject : IDataObject;
    FBitmap     : TBitmap;

    function ShellInitialize(pidlFolder: PItemIDList; lpdobj: IDataObject; hKeyProgID: HKEY): HResult; stdcall;
    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;
  protected
    { Protected declarations }

    // IShellExtInit
    function IShellExtInit.Initialize = ShellInitialize;

    // IContextMenu
    function IContextMenu.QueryContextMenu  = QueryContextMenu;
    function IContextMenu.InvokeCommand     = InvokeCommand;
    function IContextMenu.GetCommandString  = GetCommandString;
  end;

  TExtMenuFactory = class(TAutoObjectFactory)
  protected
    procedure ApproveShellExtension(Register: Boolean; const ClsID: string);
    function  GetProgID: string; override;
  public
    procedure UpdateRegistry(Register: Boolean); override;
  end;


implementation

uses ComServ;


{ TMyExtMenu }

function TMyExtMenu.ShellInitialize(pidlFolder: PItemIDList; lpdobj: IDataObject; hKeyProgID: HKEY): HResult;
begin
  FDataObject    := lpdobj;

  FBitmap        := TBitmap.Create;
  FBitmap.Width  := 50;
  FBitmap.Height := 20;
  FBitmap.Canvas.FillRect(Rect(0, 0, 50, 20));
  FBitmap.Canvas.LineTo(50, 20);


  Result         := NOERROR;
end;

function TMyExtMenu.GetCommandString(idCmd, uType: UINT; pwReserved: PUINT; pszName: LPSTR; cchMax: UINT): HResult;
Var
  S : String;
begin
  S := '';

  If (uType and GCS_HELPTEXTA) <> 0 Then Begin
    Case idCmd of
      0 : S := 'New menu item number 0';
    End;
  End;

  If (uType and not GCS_VERBW) = 0 Then Begin
    Case idCmd of
      0 : S := 'My Menu item';
    End;
  End;

  if (uType and GCS_VERBW) <> 0
    Then StringToWideChar(S, POleStr(pszName), Length(S) + 1)
    Else StrCopy(pszName, PChar(S));

  Result := S_OK;
end;


function TMyExtMenu.InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult;
//Var
//  Cmd : String;
begin

  If HiWord(Cardinal(lpici.lpVerb)) = 0 Then Begin
    With lpici Do Begin
      case LoWord(lpici.lpVerb) of
        0 : ShowMessage('Bitmap');
        1 : ShowMessage('Sub. Menu 1');
        2 : ShowMessage('Sub. Menu 2');
      end;
    End;
  End
  Else Begin
    // Cmd := lpici.lpVerb
    ShowMessage('My action');
  End;

  Result := NOERROR;
end;

function TMyExtMenu.QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst, idCmdLast, uFlags: UINT): HResult;
Var
  idCmd        : Cardinal;
  MenuText     : String;
  bAppendItems : Boolean;

  PopupMenu    : HMenu;
begin
  idCmd := idCmdFirst;
  bAppendItems := True;

  If (uFlags and $F) = CMF_NORMAL Then MenuText := 'Do MenuCmd1 (Normal)'
                                  else bAppendItems := False;

  //Insert the menu items.
  If bAppendItems Then Begin
    InsertMenuW(Menu, indexMenu, MF_SEPARATOR or MF_BYPOSITION, 0, nil);
    Inc(IndexMenu);

    InsertMenu(Menu, indexMenu, MF_BITMAP or MF_BYPOSITION, idCmd, PChar(FBitmap.Handle));
    Inc(IndexMenu);
    Inc(idCmd);

    PopupMenu := CreatePopupMenu;

    InsertMenu(Menu, indexMenu, MF_STRING or MF_BYPOSITION or MF_POPUP, PopupMenu, PChar(MenuText));
//    Inc(indexMenu);

    MenuText := 'Sub. Menu 1';
    InsertMenu(PopupMenu, 0, MF_STRING or MF_BYPOSITION, idCmd, PChar(MenuText));
    Inc(idCmd);

    MenuText := 'Sub. Menu 2';
    InsertMenu(PopupMenu, 1, MF_STRING or MF_BYPOSITION, idCmd, PChar(MenuText));
    Inc(idCmd);

    Result := idCmd - idCmdFirst;
    Exit;
  End;
  Result := NOERROR;
end;


{ TDFMInfoTipFactory }

// This registry entry is required in order for the extension to
// operate correctly under Windows NT.
procedure TExtMenuFactory.ApproveShellExtension(Register: Boolean; const ClsID: string);
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;

function TExtMenuFactory.GetProgID: string;
begin
  Result := ''; // ProgID not needed for shell extension
end;

procedure TExtMenuFactory.UpdateRegistry(Register: Boolean);
Var
  ClsID: string;
begin
  ClsID := GUIDToString(ClassID);
  inherited;

  ApproveShellExtension(Register, ClsID);

  If Register Then CreateRegKey(myFileExt + '\shellex\ContextMenuHandlers\MyExtMenu', '', ClsID)
              else DeleteRegKey(myFileExt + '\shellex\ContextMenuHandlers\MyExtMenu');
end;

initialization
  TExtMenuFactory.Create(ComServer, TMyExtMenu, Class_MyExtMenu, ciMultiInstance, tmApartment);
end.

Regards
0
 
LVL 12

Expert Comment

by:Lee_Nover
ID: 7073438
what is ExtMenu_TLB ? what ActiveX did you import ?
0
 
LVL 3

Accepted Solution

by:
Slavak earned 500 total points
ID: 7073518
In Delphi menu:

1. New/Active X/Type Library
2. Save it as ExtMenu.Dpr
3. New/Active X/Automation object.
   Set Name to MyExtMenu.
4. Save file as unExtMenu.
5. Copy code from my previous comment and paste to the unMyExtMenu file.
6. Build the project.
7. register the object with regsvr32 utility
8. create file with '.aaa' extention.
   Right click on the file in explorer.
   You should see 2 additional menu items:
     1. white bitmap with the line
     2. regular item with submenu

Good luck
0
 

Author Comment

by:sina2000
ID: 7075008
Year ! I got my mistakes ! Many many thanks ... ^^
Share my codes below :
-----------------------

unit main;

interface
   uses Windows,ActiveX,ComObj,ShlObj,Classes,Graphics;

type
   TContextMenu = class(TComObject,IShellExtInit,IContextMenu)
   private
      FFileName   : array[0..MAX_PATH] of Char;
      FMenuIndex  : UINT;
      FDataObject : IDataObject;
      FBitmap, FICON : TBitmap;
   protected
      function IShellExtInit.Initialize = SEIInitialize; // Avoid compiler warning
      function SEIInitialize(pidlFolder: PItemIDList; lpdobj: IDataObject;
               hKeyProgID: HKEY): HResult; stdcall;
      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;
end;

const
   Class_ContextMenu: TGUID = '{19741013-C829-11D1-8233-0020AF3E97A9}';

var
   FileList:TStringList;
   Buffer:array[1..1024]of char;

implementation

uses ComServ, SysUtils, ShellApi, Registry;

function TContextMenu.SEIInitialize(pidlFolder: PItemIDList; lpdobj: IDataObject;
   hKeyProgID: HKEY): HResult;
var
   StgMedium: TStgMedium;
   FormatEtc: TFormatEtc;
   FileNumber,i:Integer;
begin
   if (lpdobj = nil) then begin
      Result := E_INVALIDARG;
      Exit;
   end;

   FDataObject := lpdobj;
   if FBitmap=nil then begin
        FBitmap := TBitmap.Create;
        FBitmap.Width := 50;
        FBitmap.Height:= 60;
        FBitmap.Canvas.FillRect(Rect(0, 0, 50, 60));
        FBitmap.Canvas.LineTo(50, 60);
   end;
   if FICON=nil then begin
        FICON := TBitmap.Create;
        FICON.LoadFromResourceName(HInstance, 'LIGHT');
   end;

   FileList:=TStringList.Create;
   FileList.Clear;

   with FormatEtc do begin
      cfFormat := CF_HDROP;
      ptd := nil;
      dwAspect := DVASPECT_CONTENT;
      lindex := -1;
      tymed := TYMED_HGLOBAL;
   end;
   Result := lpdobj.GetData(FormatEtc, StgMedium);
   if Failed(Result) then Exit;

   FileNumber := DragQueryFile(StgMedium.hGlobal,$FFFFFFFF,nil,0);
   for i:=0 to FileNumber-1 do begin
      DragQueryFile(StgMedium.hGlobal, i, FFileName, SizeOf(FFileName));
      FileList.Add(FFileName);
      Result := NOERROR;
   end;

   ReleaseStgMedium(StgMedium);
end;

function TContextMenu.QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst,
   idCmdLast, uFlags: UINT): HResult;
var
   MenuText1, MenuText2, MenuText3, MenuText4: string;
   PopupMenu : HMenu;
   idCmd : Cardinal;

begin
    Result := NOERROR;
    if ((uFlags and $0000000F)=CMF_NORMAL) then 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, File right click in Explorer';
         MenuText2 := '&New menuitem 2, File right click in Explorer';
         MenuText3 := '&New menuitem 3, File right click in Explorer';
         MenuText4 := '&New menuitem 4, File right click in Explorer';
    end
    else if (uFlags and CMF_DEFAULTONLY) <> 0 then begin
         exit;
    end
    else exit;

    FMenuIndex:=indexMenu;
    idCmd := idCmdFirst;
    PopupMenu := CreatePopupMenu;

    InsertMenu(Menu,indexMenu,MF_SEPARATOR or MF_BYPOSITION,0,Pointer(0));
    Inc(IndexMenu);
    InsertMenu(Menu,indexMenu,MF_STRING or MF_BYPOSITION or MF_POPUP,PopupMenu,PChar(MenuText1));
    SetMenuItemBitmaps(Menu,indexMenu,MF_BYPOSITION,FICON.Handle,FICON.Handle);
    Inc(IndexMenu);
    InsertMenu(PopupMenu,0,MF_STRING or MF_BYPOSITION,idCmd,PChar('SubMenu Item 1'));
    SetMenuItemBitmaps(PopupMenu,0,MF_BYPOSITION,FICON.Handle,FICON.Handle);
    Inc(idCmd);
    InsertMenu(PopupMenu,1,MF_STRING or MF_BYPOSITION,idCmd,PChar('SubMenu Item 2'));
    SetMenuItemBitmaps(PopupMenu,1,MF_BYPOSITION,FICON.Handle,FICON.Handle);
    Inc(idCmd);
    InsertMenu(Menu,indexMenu,MF_STRING or MF_BYPOSITION,idCmd,PChar(MenuText2));
    Inc(IndexMenu);Inc(idCmd);
    InsertMenu(Menu,indexMenu,MF_STRING or MF_BYPOSITION,idCmd,PChar(MenuText3));
    Inc(IndexMenu);Inc(idCmd);
    InsertMenu(Menu,indexMenu,MF_BITMAP or MF_BYPOSITION,idCmd,PChar(FBitmap.Handle));
    Inc(IndexMenu);Inc(idCmd);
    InsertMenu(Menu,indexMenu,MF_SEPARATOR or MF_BYPOSITION,0,Pointer(0));

    Result := idCmd - idCmdFirst;
end;

function TContextMenu.InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult;
var
    idCmd: cardinal;
    i:Integer;
    FileListStr : string;

begin
    Result := E_INVALIDARG;
    if (HiWord(Integer(lpici.lpVerb)) <> 0) then begin
        Result := E_FAIL;
        Exit;
    end;

    //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().

    idCmd := LoWord(Integer(lpici.lpVerb));
    FileListStr := 'Invoke menu item '+IntToStr(idCmd) + ' , '+IntToStr(FileList.Count)+' files selected' + #13#10;
    for i:=0 to FileList.Count -1 do begin
        FileListStr:=FileListStr + FileList.Strings[i] + #13#10;
    end;
    MessageBox(lpici.hwnd,PChar(FileListStr),'Shell Extension Sample',MB_OK);
    Result := NOERROR;

    //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;


function TContextMenu.GetCommandString(idCmd, uType: UINT; pwReserved: PUINT;
         pszName: LPSTR; cchMax: UINT): HRESULT;
begin
   if (idCmd = FMenuIndex) then begin
   if (uType = GCS_HELPTEXT) then
        StrCopy(pszName, PChar('MenuItem '+IntToStr(idCmd)+' , '+IntToStr(FileList.Count)+' Files Selectd'));
        Result := NOERROR;
   end
   else
      Result := E_INVALIDARG;
end;



type
   TContextMenuFactory = class(TComObjectFactory)
   public
   procedure UpdateRegistry(Register: Boolean); override;
end;



procedure TContextMenuFactory.UpdateRegistry(Register: Boolean);
var
   ClassID: string;
begin
   if Register then begin
      inherited UpdateRegistry(Register);
      ClassID := GUIDToString(Class_ContextMenu);
      CreateRegKey('*\shellex', '', '');
      CreateRegKey('*\shellex\ContextMenuHandlers', '', '');
      CreateRegKey('*\shellex\ContextMenuHandlers\OpenWithWordPad', '', ClassID);

    //Hg9{2YWwO5M3N*Windows NT5D;0
      if (Win32Platform = VER_PLATFORM_WIN32_NT) then
      with TRegistry.Create do
      try
         RootKey := HKEY_LOCAL_MACHINE;
         OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions', True);
         OpenKey('Approved', True);
         WriteString(ClassID, 'Context Menu Shell Extension');
      finally
         Free;
      end;
   end
   else begin
      DeleteRegKey('*\shellex\ContextMenuHandlers\FileOpreation');
      DeleteRegKey('*\shellex\ContextMenuHandlers');
//      DeleteRegKey('*\shellex');
      inherited UpdateRegistry(Register);
   end;
end;



initialization
 TContextMenuFactory.Create(ComServer, TContextMenu, Class_ContextMenu,
   '', 'Context Menu Shell Extension', ciMultiInstance,tmApartment);

end.

0
 

Author Comment

by:sina2000
ID: 7075014
Hi , dear expert , thank you very much ! ^^
0

Featured Post

Enabling OSINT in Activity Based Intelligence

Activity based intelligence (ABI) requires access to all available sources of data. Recorded Future allows analysts to observe structured data on the open, deep, and dark web.

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…
Objective: - This article will help user in how to convert their numeric value become words. How to use 1. You can copy this code in your Unit as function 2. than you can perform your function by type this code The Code   (CODE) The Im…
Internet Business Fax to Email Made Easy - With eFax Corporate (http://www.enterprise.efax.com), you'll receive a dedicated online fax number, which is used the same way as a typical analog fax number. You'll receive secure faxes in your email, fr…
This video gives you a great overview about bandwidth monitoring with SNMP and WMI with our network monitoring solution PRTG Network Monitor (https://www.paessler.com/prtg). If you're looking for how to monitor bandwidth using netflow or packet s…

707 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

16 Experts available now in Live!

Get 1:1 Help Now