Solved

InProcServer(IContextMenu)

Posted on 2000-03-01
8
485 Views
Last Modified: 2012-05-05
I want to know how Winzip works :

When user selects several files in explorer shell ,
then right click mouse button,
An Item-'Add to Zip' can be added ,
This menuitem can include an icon .

I want to know :
1. How to add an menuitem with an icon .
2. How to add an menuitem when several files are selected .(I have run the demo-ConMenu.dpr with delphi, but the menuitem can be added only when one .dpr file was selected --not several but one!)
3. How to get filenames user selected.

Give A demo for me is best.
Thank you very much !
 
0
Comment
Question by:flyindance
  • 5
  • 3
8 Comments
 
LVL 10

Accepted Solution

by:
Lischke earned 100 total points
ID: 2572095
Hi flyer,

three questions for 100 points... Here's code directly from one of my projects:

unit IBContextMenu;

interface

{$R-}

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

type TMenuType = (mtAlias, mtExtension, mtFile);

     TIBContextMenu = class(TComObject, IContextMenu, IContextMenu2, IShellExtInit)
     private
       FMenuType  : TMenuType;
       FFileList  : TStringList;
       FPIDLList  : PIBItemArray;
       FPIDLListSize,
       FIDOffset  : Cardinal;
       // 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;
       function HandleMenuMsg(uMsg: UINT; WParam, LParam: Integer): 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 PIDLList: PIBItemArray read FPIDLList write FPIDLList;
       property PIDLListSize: Cardinal read FPIDLListSize write FPIDLListSize;
     end;

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

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

implementation

uses ComServ, ShellAPI, SysUtils, Graphics, WideStrings, DBStuff,
     Tools, IBFolder, Preferences, Dialogs, Controls, Messages, CommCtrl;

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;

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

function TIBContextMenu.HandleMenuMsg(uMsg: UINT; WParam, LParam: Integer): HResult; stdcall;

// handle messages related to our context menu, sent by the owner window of the menu (the explorer)

var MIS    : PMeasureItemStruct;
    DIS    : PDrawItemStruct;
    S,
    Name   : String;
    Color  : Cardinal;
    DC     : HDC;
    Size   : TSize;
    Index  : Integer;

begin
  Result:=1;
  Name:='';
  for Index:=0 to FPIDLListSize-1 do
  begin
    if Length(Name) > 0 then Name:=Name+', ';
    Name:=Name+IDListManager.GetLastItem(Pointer(FPIDLList[Index])).Name;
  end;
  if Length(Name) > 50 then
  begin
    SetLength(Name,50);
    Name:=Name+'...';
  end;
  case uMsg of
    WM_MEASUREITEM : begin
                       MIS:=Pointer(LParam);
                       DC:=GetDC(0);
                       SelectObject(DC,GetStockObject(DEFAULT_GUI_FONT));
                       case MIS.itemID-FIDOffset of
                         IDM_CONNECT : S:=StrOpenConnection+' '''+Name+'''';
                         IDM_ADDNEW  : S:=StrAddNewConnection+' '''+Name+'''';
                         IDM_DELETE  : S:=StrDeleteConnection+' '''+Name+'''';
                         IDM_CLOSE   : S:=StrCloseConnection+' '''+Name+'''';
                         IDM_RENAME  : S:=StrRenameConnection+' '''+Name+'''';
                       else
                         S:='???';
                       end;
                       GetTextExtentPoint32(DC,PChar(S),Length(S),Size);
                       MIS.itemWidth:=Size.cx;
                       MIS.itemHeight:=20;
                       ReleaseDC(0,DC);
                     end;
    WM_DRAWITEM : begin
                    DIS:=Pointer(LParam);
                    SelectObject(DIS.hDC,GetStockObject(DEFAULT_GUI_FONT));
                    case DIS.itemID-FIDOffset of
                      IDM_CONNECT : begin
                                      S:=StrOpenConnection+' '''+Name+'''';
                                      Index:=MenuIconFromType[mitConnect];
                                    end;
                      IDM_ADDNEW  : begin
                                      S:=StrAddNewConnection+' '''+Name+'''';
                                      Index:=MenuIconFromType[mitAddNew];
                                    end;
                      IDM_DELETE  : begin
                                      S:=StrDeleteConnection+' '''+Name+'''';
                                      Index:=MenuIconFromType[mitDelete];
                                    end;
                      IDM_CLOSE   : begin
                                      S:=StrCloseConnection+' '''+Name+'''';
                                      Index:=MenuIconFromType[mitClose];
                                    end;
                      IDM_RENAME  : begin
                                      S:=StrRenameConnection+' '''+Name+'''';
                                      Index:=MenuIconFromType[mitRename];
                                    end;
                    else
                      S:='???';
                      Index:=-1;
                    end;
                    if (DIS.itemState and ODS_SELECTED) <> 0 then Color:=COLOR_BTNSHADOW
                                                             else Color:=COLOR_BTNFACE;
                    FillRect(DIS.hDC,DIS.rcItem,Color+1);
                    DrawIconEx(DIS.hDC,2,DIS.rcItem.Top+2,ImageList_GetIcon(MenuImages.Handle,Index,ILD_NORMAL),16,16,0,0,DI_NORMAL);
                    Inc(DIS.rcItem.Left,20);
                    SetBkMode(DIS.hDC,TRANSPARENT);
                    SetTextColor(DIS.hDC,ColorTORGB(clGrayText));
                    if (DIS.itemState and ODS_DISABLED) <> 0 then ;
                    DrawText(DIS.hDC,PChar(S),Length(S),DIS.rcItem,DT_LEFT or DT_SINGLELINE or DT_VCENTER);
                  end;
  end;
end;

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

procedure TIBContextMenu.Initialize;

// this gets called before IShellExtInit.Initialize

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

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

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

var Counter : Cardinal;
    Name    : String;
    Server  : String;
    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
        case LoWord(Cardinal(lpVerb)) of
          IDM_ADDNEW : begin
                         UsePreferences('IBExplorer');
                         Counter:=ReadPreferenceFor('Counter',0) mod 1000;
                         Connections.NewConnection('New Connection '+IntToStr(Counter),'server name','database path');
                         Inc(Counter);
                         UsePreferences('IBExplorer');
                         WritePreferenceFor('Counter', Integer(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(StrDelConQuestion,mtConfirmation,[mbOK,mbCancel],0) = mrOK then
                         begin
                           for Counter:=0 to FPIDLListSize-1 do
                           begin
                             Item:=IDListManager.GetLastItem(FPIDLList[Counter]);
                             ReleaseConnectionSet(Pointer(Item));
                             Connections.DeleteConnection(Item.Name);
                           end;
                           SHChangeNotify(SHCNE_UPDATEDIR,SHCNF_IDLIST or SHCNF_FLUSH,RootFolder.AbsoluteLocation,nil);
                           SetStatusTextW('connection(s) removed.');
                         end;
                       end;
          IDM_CONNECT : begin
                          for Counter:=0 to FPIDLListSize-1 do
                            CurrentShellBrowser.BrowseObject(Pointer(IDListManager.GetLastItem(FPIDLList[Counter])),
                                                             SBSP_DEFBROWSER or SBSP_DEFMODE or SBSP_ABSOLUTE);
                        end;
          IDM_CLOSE : begin
                        for Counter:=0 to FPIDLListSize-1 do
                        begin
                          Item:=IDListManager.GetLastItem(FPIDLList[Counter]);
                          ReleaseConnectionSet(Pointer(Item));
                        end;
                        CurrentShellBrowser.BrowseObject(Pointer(RootFolder.AbsoluteLocation),SBSP_DEFBROWSER or SBSP_DEFMODE or SBSP_ABSOLUTE);
                        SHChangeNotify(SHCNE_SERVERDISCONNECT,SHCNF_IDLIST or SHCNF_FLUSH,FPIDLList[0],nil);
                      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 FFileList.Count-1 do
                        begin
                          SetStatusTextW(Format('adding connection ''%s''...',[FFileList[Counter]]));
                          Name:=ExtractFileName(FFileList[Counter]);
                          Delete(Name,Pos('.',Name),4);
                          Server:=ExpandUNCFileName(FFileList[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,FFileList[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(FPIDLList[0]);
  FIDOffset:=idCmdFirst;
  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 FFileList.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:=PChar(StrAddNewConnection);
                     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_OWNERDRAW;
                 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_OWNERDRAW;
                 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_OWNERDRAW;
                 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_OWNERDRAW;
                   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 FFileList.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.FreeItemList(FPIDLList,FPIDLListSize);
  FFileList.Free;
  inherited;
end;

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

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


Ciao, Mike
0
 

Author Comment

by:flyindance
ID: 2575947
Hi , Thanks .
But What is 'PIDLManager'?(Uses ..)
0
 

Author Comment

by:flyindance
ID: 2575955
Can you give me a demo can be run and
tested?
I will give you my last 100 points.
Many thanks!
0
 

Author Comment

by:flyindance
ID: 2575995
Waiting....
0
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 
LVL 10

Expert Comment

by:Lischke
ID: 2576113
Unfortunately, this stuff is quite complex. I recommend that you copy out those parts from my code which you need, say into the context menu demo comming with Delphi.

The code is by no means intended to be runnable by you (there is quite a lot missing, like my PIDL manager class which handles allocation, deallocation, concatenation etc. of pidls). It is the idea that counts. Shell extensions are much too complex to give complete examples. You should have a fair amount of programming experience and if you have this then the code I gave you should answer many of your questions (if this is enough to answer this question here at E-E is a different thing and a decision you have to make yourself).

Ciao, Mike
0
 

Author Comment

by:flyindance
ID: 2576150
Many Thanks...
I will try it ...

0
 
LVL 10

Expert Comment

by:Lischke
ID: 2576175
Thank you for the A grading. Although I cannot give you a complete sample I still can lend a hand on specific details. So just ask if you need some additional information...

Ciao, Mike
0
 

Author Comment

by:flyindance
ID: 2576219
Please look for the new 'Question'
that name is:
'Mr.Mike Lischke'

:-)

Please answer it .
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

Suggested Solutions

A lot of questions regard threads in Delphi.   One of the more specific questions is how to show progress of the thread.   Updating a progressbar from inside a thread is a mistake. A solution to this would be to send a synchronized message to the…
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…
Illustrator's Shape Builder tool will let you combine shapes visually and interactively. This video shows the Mac version, but the tool works the same way in Windows. To follow along with this video, you can draw your own shapes or download the file…
When you create an app prototype with Adobe XD, you can insert system screens -- sharing or Control Center, for example -- with just a few clicks. This video shows you how. You can take the full course on Experts Exchange at http://bit.ly/XDcourse.

747 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

12 Experts available now in Live!

Get 1:1 Help Now