var hWndToolbar: HWND; tbbi: TBBUTTONINFO; pt: TPoint; rect: TRect; nButtonCount, nTargetButton: Integer; OldButtonStyle: Integer; uses Windows, CommCtrl; GetCursorPos(pt); hWndToolbar := WindowFromPoint(pt); // Get number of buttons on the toolbar this button belongs to nButtonCount := SendMessage(hWndToolbar, TB_BUTTONCOUNT, 0, 0); OldButtonStyle := SendMessage(hWndToolbar, TB_GETSTYLE, 0, 0); // Find this button by finding which of the buttons is under the cursor nTargetButton := -1; ScreenToClient(hWndToolbar, pt); for I := 0 to nButtonCount -1 do begin if SendMessage(hWndToolbar, TB_GETITEMRECT, I, Integer(@rect)) <> 0 then if PtInRect(rect, pt) then begin nTargetButton := I; Break; end; end; if nTargetButton <> -1 then begin tbbi.idCommand := 1111; // Needs to have a unique value for various TB_XXX messages to work SendMessage(hWndToolbar, TB_SETCMDID, nTargetButton, tbbi.idCommand); SendMessage(hWndToolbar, TB_SETSTYLE, 0, OldButtonStyle or TBSTYLE_CHECKGROUP); // Make the button appear pressed SendMessage(hWndToolbar, TB_CHECKBUTTON, tbbi.idCommand, Integer(True)); end; ...... // Display and track the menu ...... if nTargetButton <> -1 then begin // Make the button appear not pressed SendMessage(hWndToolbar, TB_CHECKBUTTON, tbbi.idCommand, Integer(False)); SendMessage(hWndToolbar, TB_SETSTYLE, 0, OldButtonStyle); end; reference http://msdn.microsoft.com/library/default.asp?url=/library/en-us/dhtmltechcol/cols/dnwebteam/webteam11062001.asp
实际上就是操作注册表.只是IE5以下不能用这个,所以,用处不大.. 建议把所要的功能菜单写入IE的右键菜单内...类似于NetAnts的 "download all by netants" <--这个菜单也是加在注册表里面的, REGEDIT4[HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\MenuExt\访问大富翁] @="http://www.gislab.ecnu.edu.cn/delphibbs/"上面那个URL你可以换成程序的路径...
var
hWndToolbar: HWND;
tbbi: TBBUTTONINFO;
pt: TPoint;
rect: TRect;
nButtonCount, nTargetButton: Integer;
OldButtonStyle: Integer;
uses
Windows, CommCtrl;
GetCursorPos(pt);
hWndToolbar := WindowFromPoint(pt);
// Get number of buttons on the toolbar this button belongs to
nButtonCount := SendMessage(hWndToolbar, TB_BUTTONCOUNT, 0, 0);
OldButtonStyle := SendMessage(hWndToolbar, TB_GETSTYLE, 0, 0);
// Find this button by finding which of the buttons is under the cursor
nTargetButton := -1;
ScreenToClient(hWndToolbar, pt);
for I := 0 to nButtonCount -1 do
begin
if SendMessage(hWndToolbar, TB_GETITEMRECT, I, Integer(@rect)) <> 0 then
if PtInRect(rect, pt) then
begin
nTargetButton := I;
Break;
end;
end;
if nTargetButton <> -1 then
begin
tbbi.idCommand := 1111; // Needs to have a unique value for various
TB_XXX messages to work
SendMessage(hWndToolbar, TB_SETCMDID, nTargetButton, tbbi.idCommand);
SendMessage(hWndToolbar, TB_SETSTYLE, 0, OldButtonStyle or
TBSTYLE_CHECKGROUP);
// Make the button appear pressed
SendMessage(hWndToolbar, TB_CHECKBUTTON, tbbi.idCommand, Integer(True));
end;
......
// Display and track the menu
......
if nTargetButton <> -1 then
begin
// Make the button appear not pressed
SendMessage(hWndToolbar, TB_CHECKBUTTON, tbbi.idCommand,
Integer(False));
SendMessage(hWndToolbar, TB_SETSTYLE, 0, OldButtonStyle);
end;
reference
http://msdn.microsoft.com/library/default.asp?url=/library/en-us/dhtmltechcol/cols/dnwebteam/webteam11062001.asp
建议把所要的功能菜单写入IE的右键菜单内...类似于NetAnts的
"download all by netants" <--这个菜单也是加在注册表里面的,
REGEDIT4[HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\MenuExt\访问大富翁]
@="http://www.gislab.ecnu.edu.cn/delphibbs/"上面那个URL你可以换成程序的路径...
var
rg:Tregistry;
begin
rg:=Tregistry.create;
rg.rootkey:=HKEY_LOCAL_MACHINE;
rg.openkey('SOFTWARE\MICROSOFT\INTERNET EXPLORER\EXTENSIONS\{0713E8D2-850A-101B-AFC0-4210102A8DA7}',true); rg.writestring('BUTTONTEXT',Ewenzi.text);
rg.writestring('CLSID','{1FBA04EE-3024-11D2-8F1F-0000F87ABD16}');
rg.writestring('DEFAULT VISIBLE','YES');
rg.writestring('EXEC',AppName);
rg.writestring('ICON',AppDir+'\Icon2.ico');
rg.writestring('HOTICON',AppDir+'\Icon1.ico'); rg.closekey;
rg.free;
end;
但楼上两位说的都不是我要的东西。
再次说明一下:这个问题不是操作注册表能够搞定的,操作注册表只能添加一个图标,不能实现下拉菜单。
IE右键菜单扩展也不是我想要的。
初步估计这个问题要用BHO来实现,而且应该是动态在IE工具栏上创建一按钮(当IE产生新窗口时)
jiangsheng兄的方法似乎是得到某个工具栏上按钮的信息,然后加以处理吧? 还没有试,试过再说。