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\C ontmenu.dp r
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 ?
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\
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 ?
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] ));
for i := 0 to CountSelectFiles - 1 do
AppendMenu (PopMenu, MF_STRING or MF_BYPOSITION, idCmdFirst, PChar(ListFiles.Strings[i]
ASKER
Adjusted points to 40
ASKER
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^
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^
ASKER
Adjusted points to 53
ASKER
^o^
waiting ...
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.lpVer b)) <> 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(l pici.lpVer b)-1]; // Selected file path from MenuItem
// ...Now you can use S for any your operations
end;
Result := NOERROR;
end;
the event InvokeCommand, where you can
write your code:
function TContextMenu.InvokeCommand
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.lpVer
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(l
// ...Now you can use S for any your operations
end;
Result := NOERROR;
end;
ASKER
I have test you codes...
Use Messagebox as command to show
PChar(IntToStr(LoWord(lpic i.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=I ShellExtIn it_Initial ize;
function IShellExtInit_Initialize(p idlFolder: 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(Regi ster: Boolean; const ClsID: string);
virtual;
public
procedure UpdateRegistry(Register: Boolean); override;
end;
implementation
uses ComServ, SysUtils, ShellAPI, Registry;
function TContextMenu.QueryContextM enu(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:=FFileLis t.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_SUCCES S, 0, CountSelectFiles);
end;
function TContextMenu.InvokeCommand (var lpici: TCMInvokeCommandInfo): HResult;
var s:string;
begin
if HiWord(Integer(lpici.lpVer b)) <> 0 then
begin
Result := E_FAIL;
Exit;
end;
MessageBox(lpici.hwnd, PChar(IntToStr(LoWord(lpic i.lpVerb), '', MB_OK);
Result := NOERROR;
end;
function TContextMenu.GetCommandStr ing(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 _Initializ e(pidlFold er: 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(M edium.hGlo bal,$FFFFF FFF,nil,0) ;
for I:=0 to FileCount-1 do
begin
DragQueryFile(Medium.hGlob al,I,Buffe r,MAX_PATH );
FFileList.Add(Buffer);
end;
Result:=NOERROR;
finally
ReleaseStgMedium(medium);
end;
except
Result := E_UNEXPECTED;
end;
end;
procedure TContextMenu.Initialize;
begin
FFileList:=TStringList.Cre ate;
end;
destructor TContextMenu.Destroy;
begin
FFileList.Free;
inherited;
end;
end.
Use Messagebox as command to show
PChar(IntToStr(LoWord(lpic
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=I
function IShellExtInit_Initialize(p
hKeyProgID: HKEY): HResult; reintroduce; stdcall;
public
destructor Destroy; override;
procedure Initialize; override;
end;
TContextMenuFactory = class(TComObjectFactory)
protected
function GetProgID: string; override;
procedure ApproveShellExtension(Regi
virtual;
public
procedure UpdateRegistry(Register: Boolean); override;
end;
implementation
uses ComServ, SysUtils, ShellAPI, Registry;
function TContextMenu.QueryContextM
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:=FFileLis
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_SUCCES
end;
function TContextMenu.InvokeCommand
var s:string;
begin
if HiWord(Integer(lpici.lpVer
begin
Result := E_FAIL;
Exit;
end;
MessageBox(lpici.hwnd, PChar(IntToStr(LoWord(lpic
Result := NOERROR;
end;
function TContextMenu.GetCommandStr
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
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(M
for I:=0 to FileCount-1 do
begin
DragQueryFile(Medium.hGlob
FFileList.Add(Buffer);
end;
Result:=NOERROR;
finally
ReleaseStgMedium(medium);
end;
except
Result := E_UNEXPECTED;
end;
end;
procedure TContextMenu.Initialize;
begin
FFileList:=TStringList.Cre
end;
destructor TContextMenu.Destroy;
begin
FFileList.Free;
inherited;
end;
end.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
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-idcm dfirst);
}
return noerror;
OK!!! GET IT!!! :-)
Thank YOU very much !!!
^O^
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-idcm
}
return noerror;
OK!!! GET IT!!! :-)
Thank YOU very much !!!
^O^
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(pi
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.hGlob
if CountSelectFiles > 0 then
begin
for i := 0 to CountSelectFiles - 1 do
begin
DragQueryFile(medium.hGlob
ListFiles.Add(StrPas(szFil
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.QueryContextM
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_SUCCES
end;
This function add one item in context menu and add subitems with caption = selected file name.
Best regards
Valery