Link to home
Start Free TrialLog in
Avatar of rain1977
rain1977

asked on

About IContextMenu ...

Sorry ...
I have only 13 points for you ...
But I need your help soon ...
Thank you very much !

I have test the demo --D:\delphi\Demos\Activex\Shellext\Contmenu.dpr

Then I find that ,
When select only one file in explorer,
The registered menu item will be added...
And when select more then one files,
The registered menu item can't be shown...

Why ?
How can my menuitem be added to popupmenu  
when selected files>1 ?




Avatar of DValery
DValery

Hi, rain1977

You have to change the Initialize function in module ContextM.pas like it:

var
    ListFiles: TStrings; // List of the selected files
    CountSelectFiles : integer;

function TContextMenu.Initialize(pidlFolder: PItemIDList; lpdobj: IDataObject;
  hKeyProgID: HKEY): HResult;
var
  medium: TStgMedium;
  fe: TFormatEtc;
  i: integer;
begin
  with fe do
  begin
    cfFormat := CF_HDROP;
    ptd := Nil;
    dwAspect := DVASPECT_CONTENT;
    lindex := -1;
    tymed := TYMED_HGLOBAL;
  end;
  // Fail the call if lpdobj is Nil.
  if lpdobj = Nil then
  begin
    Result := E_FAIL;
    Exit;
  end;
  // Render the data referenced by the IDataObject pointer to an HGLOBAL
  // storage medium in CF_HDROP format.
  Result := lpdobj.GetData(fe, medium);
  if Failed(Result) then Exit;
  ListFiles.Clear;
  CountSelectFiles := DragQueryFile(medium.hGlobal, $FFFFFFFF, Nil, 0);
  if CountSelectFiles > 0 then
  begin
    for i := 0 to CountSelectFiles - 1 do
    begin
      DragQueryFile(medium.hGlobal, i, szFile, SizeOf(szFile));
      ListFiles.Add(StrPas(szFile));
    end;
    Result := NOERROR;
  end
  else
    Result := E_FAIL;
  ReleaseStgMedium(medium);
end;


When you may to use it list of the files like it:

function TContextMenu.QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst,
          idCmdLast, uFlags: UINT): HResult;
VAR
  PopMenu :  HMENU;
begin
 
  Result := 0;

  if (uFlags and CMF_VERBSONLY=0) and
         (uFlags and CMF_EXPLORE=0) and
         (uFlags and $F<>0) then
        exit;

  InsertMenu (Menu, indexMenu, MF_SEPARATOR or MF_BYPOSITION, 0,Nil);
  indexMenu := indexMenu+1;

  PopMenu := CreatePopupMenu;
 
  for i := 0 to CountSelectFiles - 1 do begin
    AppendMenu (PopMenu, MF_STRING or MF_BYPOSITION, idCmdFirst, PChar(ListFiles.Strings[i]));
    idCmdFirst := idCmdFirst+1;
  End;

  // Add one menu item to context menu

  InsertMenu (Menu, indexMenu, MF_STRING or MF_BYPOSITION or MF_POPUP, PopMenu,
    'Paths of the files');
   
  Result := MakeResult(SEVERITY_SUCCESS, 0, CountSelectFiles);

end;

This function add one item in context menu and add subitems with caption = selected file name.

Best regards
Valery
Sorry, I have mistaken in the function: QueryContextMenu. Need to correct one like it:
   
for i := 0 to CountSelectFiles - 1 do
    AppendMenu (PopMenu, MF_STRING or MF_BYPOSITION, idCmdFirst, PChar(ListFiles.Strings[i]));



Avatar of rain1977

ASKER

Adjusted points to 40
OK! Now I have 40 pts.
But I am afraid that if that is enough for you ...:-(

Many thanks !
I am glad that I got the answer ...
And more !!!
Now I know how to add submenu to my context-menuitem...
But , Can you tell me how to add command for each Submenu-item?

After-->
AppendMenu(PopMenu, MF_STRING or MF_BYPOSITION, idCmdFirst, PChar(ListFiles.Strings[i]));
How to-->
Set command for each MenuItem of PopMenu?

Sorry , My english is so bad . And Delphi Help is too hard to me ...
I want you undersand me ...
I think that is easy for you ..:")
 

Many Thanks!!! ^o^



Adjusted points to 53
^o^

waiting ...
When you are selecting MenuItem occurs
the event InvokeCommand, where you can
write your code:

function TContextMenu.InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult;
var
  H: THandle;
  s: string;
begin
    // If the high-order word of lpcmi.lpVerb is not NULL, this
    // function was called by an application and lpVerb is a command
    // that should be activated. Otherwise, the shell has called this
    // function, and the low-order word of lpcmi.lpVerb is the
    // identifier of the menu item that the user selected.

  // Make sure we are not being called by an application
  if HiWord(Integer(lpici.lpVerb)) <> 0 then begin
    Result := E_FAIL;
    Exit;
  end;

  // Make sure we aren't being passed an invalid argument number
  // LoWord is index of menu item

  if (LoWord(lpici.lpVerb) > 0) and (LoWord(lpici.lpVerb) <= CountSelectFiles) then begin
      s := ListFiles.Strings[LoWord(lpici.lpVerb)-1];      // Selected file path from MenuItem
      // ...Now you can use S for any your operations
  end;
  Result := NOERROR;
end;


I have test you codes...
Use Messagebox as command to show
PChar(IntToStr(LoWord(lpici.lpVerb))...
But when I select a subitem ,
It shows '0'...

When each subitem I selected ,
LoWord(lpici.lpVerb)=0
 
Why?
I can't understand...
---------------------

unit ContMain;

interface

uses Windows, ComObj, ShlObj, ActiveX, Classes;

type
  TContextMenu = class(TComObject, IContextMenu, IShellExtInit)
  private
    FFileList  : TStringList;
    FMenuIdx: UINT;
  protected
    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 IShellExtInit.Initialize=IShellExtInit_Initialize;
    function IShellExtInit_Initialize(pidlFolder: PItemIDList; lpdobj: IDataObject;
      hKeyProgID: HKEY): HResult; reintroduce; stdcall;
  public
    destructor Destroy; override;
    procedure Initialize; override;
  end;

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

implementation

uses ComServ, SysUtils, ShellAPI, Registry;

function TContextMenu.QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst,
  idCmdLast, uFlags: UINT): HResult;
VAR PopMenu :  HMENU;
  i, CountSelectFiles: integer;
begin
    FMenuIdx := indexMenu;
    Result := 0;
    if (uFlags and CMF_VERBSONLY=0) and(uFlags and CMF_EXPLORE=0)
      and (uFlags and $F<>0) then exit;
    InsertMenu (Menu, FMenuIdx, MF_SEPARATOR or MF_BYPOSITION,
      0,Nil);
    FMenuIdx:=FMenuIdx+1;
    CountSelectFiles:=FFileList.Count;
    PopMenu :=CreatePopupMenu;
    for i:=0 to CountSelectFiles-1 do
      AppendMenu (Popmenu, MF_STRING or MF_BYPOSITION, idCmdFirst,
      PChar(FFileList.Strings[i]));
   InsertMenu (Menu, FMenuIdx, MF_STRING or MF_BYPOSITION or
     MF_POPUP, PopMenu, 'Info...');
   Result := MakeResult(SEVERITY_SUCCESS, 0, CountSelectFiles);
end;

function TContextMenu.InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult;
var s:string;
begin
  if HiWord(Integer(lpici.lpVerb)) <> 0 then
    begin
      Result := E_FAIL;
      Exit;
    end;
  MessageBox(lpici.hwnd, PChar(IntToStr(LoWord(lpici.lpVerb), '', MB_OK);
  Result := NOERROR;
end;

function TContextMenu.GetCommandString(idCmd, uType: UINT; pwReserved: PUINT;
  pszName: LPSTR; cchMax: UINT): HRESULT;
begin
  Result := S_OK;
  try
    if (idCmd = FMenuIdx) and ((uType and GCS_HELPTEXT) <> 0) then
      StrLCopy(pszName, 'Get information for the selected package.', cchMax)
    else
      Result := E_INVALIDARG;
  except
    Result := E_UNEXPECTED;
  end;
end;

function TContextMenu.IShellExtInit_Initialize(pidlFolder: PItemIDList; lpdobj: IDataObject;
  hKeyProgID: HKEY): HResult;
var
  Medium: TStgMedium;
  FE: TFormatEtc;
  FileCount,I: Integer;
  Buffer: array[0..MAX_PATH] of Char;

begin
  try
    if lpdobj = nil then
    begin
      Result := E_FAIL;
      Exit;
    end;
    with FE do
    begin
      cfFormat := CF_HDROP;
      ptd := nil;
      dwAspect := DVASPECT_CONTENT;
      lindex := -1;
      tymed := TYMED_HGLOBAL;
    end;
    Result := lpdobj.GetData(FE, Medium);
    if Failed(Result) then Exit;
    try
      FileCount:=DragQueryFile(Medium.hGlobal,$FFFFFFFF,nil,0);
      for I:=0 to FileCount-1 do
        begin
          DragQueryFile(Medium.hGlobal,I,Buffer,MAX_PATH);
          FFileList.Add(Buffer);
        end;
      Result:=NOERROR;
    finally
      ReleaseStgMedium(medium);
    end;
  except
    Result := E_UNEXPECTED;
  end;
end;

procedure TContextMenu.Initialize;
begin
  FFileList:=TStringList.Create;
end;

destructor TContextMenu.Destroy;
begin
  FFileList.Free;
  inherited;
end;

end.

ASKER CERTIFIED SOLUTION
Avatar of DValery
DValery

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
Hi ! :-)
I have just find the answer in C++ codes.

unit idcmd=idcmdfirst;
bool bappenditems=true;

if (...) {bappenditems=true}
else {bappenditems=false;}

if (bappenditems) {
insertmenu(popmenu, indexmenu++, mf_string|mf_byposition, idcmd++, "yeah");
insertmenu(popmenu, indexmenu++, mf_string|mf_byposition, idcmd++, "yeah");
....
return resultfromshort(idcmd-idcmdfirst);
}

return noerror;

OK!!! GET IT!!! :-)
Thank YOU very much !!!

^O^