Solved

About IContextMenu ...

Posted on 2000-02-29
10
605 Views
Last Modified: 2008-03-17
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 ?




0
Comment
Question by:rain1977
  • 6
  • 4
10 Comments
 
LVL 1

Expert Comment

by:DValery
ID: 2595203
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
0
 
LVL 1

Expert Comment

by:DValery
ID: 2595221
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]));



0
 

Author Comment

by:rain1977
ID: 2595615
Adjusted points to 40
0
 

Author Comment

by:rain1977
ID: 2595616
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^



0
 

Author Comment

by:rain1977
ID: 2595628
Adjusted points to 53
0
IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 

Author Comment

by:rain1977
ID: 2595629
^o^

waiting ...
0
 
LVL 1

Expert Comment

by:DValery
ID: 2595713
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;


0
 

Author Comment

by:rain1977
ID: 2595947
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.

0
 
LVL 1

Accepted Solution

by:
DValery earned 53 total points
ID: 2596062
Try it:

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 begin
      AppendMenu (Popmenu, MF_STRING or MF_BYPOSITION, idCmdFirst,
      PChar(FFileList.Strings[i]));
        idCmdFirst := idCmdFirst+1;    
    end;
   InsertMenu (Menu, FMenuIdx, MF_STRING or MF_BYPOSITION or
     MF_POPUP, PopMenu, 'Info...');
   Result := MakeResult(SEVERITY_SUCCESS, 0, CountSelectFiles);
end;

0
 

Author Comment

by:rain1977
ID: 2596378
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^
 
0

Featured Post

What Is Threat Intelligence?

Threat intelligence is often discussed, but rarely understood. Starting with a precise definition, along with clear business goals, is essential.

Join & Write a Comment

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…
Have you ever had your Delphi form/application just hanging while waiting for data to load? This is the article to read if you want to learn some things about adding threads for data loading in the background. First, I'll setup a general applica…
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…
Here's a very brief overview of the methods PRTG Network Monitor (https://www.paessler.com/prtg) offers for monitoring bandwidth, to help you decide which methods you´d like to investigate in more detail.  The methods are covered in more detail in o…

746 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

13 Experts available now in Live!

Get 1:1 Help Now