Solved

About IContextMenu ...

Posted on 2000-02-29
10
609 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
Back Up Your Microsoft Windows Server®

Back up all your Microsoft Windows Server – on-premises, in remote locations, in private and hybrid clouds. Your entire Windows Server will be backed up in one easy step with patented, block-level disk imaging. We achieve RTOs (recovery time objectives) as low as 15 seconds.

 

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
 

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

NAS Cloud Backup Strategies

This article explains backup scenarios when using network storage. We review the so-called “3-2-1 strategy” and summarize the methods you can use to send NAS data to the cloud

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
delphi exception 7 64
Best Firemonkey component pack 1 105
Virtuailstring tree add node to another virtuailstring tree list 4 115
oracle global variables 4 68
This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
Introduction I have seen many questions in this Delphi topic area where queries in threads are needed or suggested. I know bumped into a similar need. This article will address some of the concepts when dealing with a multithreaded delphi database…
This Micro Tutorial will teach you how to censor certain areas of your screen. The example in this video will show a little boy's face being blurred. This will be demonstrated using Adobe Premiere Pro CS6.
The Email Laundry PDF encryption service allows companies to send confidential encrypted  emails to anybody. The PDF document can also contain attachments that are embedded in the encrypted PDF. The password is randomly generated by The Email Laundr…

810 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