IE 工具栏上放置的ToolButton的DropDownMenu为什么在IE新建窗口后弹不出来了?(300分)

  • 主题发起人 主题发起人 zqw0117
  • 开始时间 开始时间
Z

zqw0117

Unregistered / Unconfirmed
GUEST, unregistred user!
最近在做IE Toolbar的工具栏程序,可是发现一个问题,如果在工具栏上放置的ToolButton,给他设定DropDownMenu后,双击IE,点击自己的工具栏Toolbutton,可以弹出DropDownMenu,如果点IE的文件->新建窗口,然后在新建窗口上点ToolButton,DropDownMenu则根本不弹出,太奇怪了,跟了半天源代码也没发现问题,反正在执行TrackPopupMenu方法后没有任何菜单弹出!郁闷,有没做过的朋友帮忙解答一下疑惑?分数可再加.
 
顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶
密切关注
 
唉,我也搜过全文搜索,没有人解答这个问题!讨厌的是,在PopupMenu的Create方法里面,竟然
FWindowHandle := Application.Handle;
郁闷啊,万恶的Application又来了!普通程序这样肯定没错,但是在工具栏里面,Application是无效的啊!郁闷郁闷的很啊!
 
楼主强
 
我再悬赏500分！决不食言！查看我以前的贴曾悬赏1000分兑现！
 
zqw0117 : 但是在工具栏里面,Application是无效的啊!
这个我不太清除，不过你可以根据自己的需要写一个YourPopupMenu控件，让他继承PopupMenu，修改自己需要的那部分代码。
 
这是由于VCL的不是线程安全造成的，而IE一个窗口一个线程(可以在任务管理器中看出)。同时还造成其它问题，如hint,出现hint时可能会有out of resource错误。
如果你可以接受没有下拉键头，点击时出现的菜单的方式，可以把按钮作为第一个参数，按钮的位置左下角的位置的坐标作为第二个参数，调用下面的函数。
如果不能接受，可以尝试继承TToolBar,重载CheckMenuDropdown，改为下面的方式。
也可改VCL源码，使TPopupList线程安全。
procedure TTradeBrowser.InnerContextMenu(Sender: TObject; MousePos: TPoint;
var Handled: boolean);
var
T: integer;
PM: TPopupMenu;
MI: TMenuItem;
H: THandle;
procedure UpdateMenu(Menu: TMenuItem);
var
I: integer;
begin
for i := 0 to Menu.Count - 1 do begin
if (Menu.Action <> nil) then
Menu.Action.Update
else if Menu.Count > 0 then
UpdateMenu(menu);
end;
end;
begin
if Sender = nil then exit;
if Sender.ClassType = TToolButton then begin
PM := TToolbutton(Sender).DropdownMenu;
H := TToolButton(Sender).Parent.Handle;
end else begin
PM := TPopupMenu(GetObjectProp(Sender, 'PopupMenu'));
H := TWinControl(Sender).Handle;
end;
if PM <> nil then begin
Windows.ClientToScreen(H, MousePos);
UpdateMenu(PM.Items);
PM.Items.RethinkHotkeys;
T := Integer(TrackPopupMenu(PM.Handle, TPM_RETURNCMD or TPM_NONOTIFY,
MousePos.X, MousePos.Y, 0, GetActiveWindow(), nil));
if T > 0 then begin
MI := PM.FindItem(T, fkCommand);
if (MI <> nil) and MI.Enabled then
MI.Click;
end;
Handled := True;
end;
end;
 
type
TMyToolBar=class(TToolBar)
protected
function CheckMenuDropdown(Button: TToolButton): Boolean;override;
procedure InnerContextMenu(Sender: TObject; MousePos: TPoint;
var Handled: boolean);
end;
implementation
function TMyToolBar.CheckMenuDropdown(Button: TToolButton): Boolean;
begin
InnerContextMenu(Button,Point(Button.Left,button.Height),Result);
Result:=False;
end;
procedure TMyToolBar.InnerContextMenu(Sender: TObject; MousePos: TPoint;
var Handled: boolean);
var
T: integer;
PM: TPopupMenu;
MI: TMenuItem;
H: THandle;
procedure UpdateMenu(Menu: TMenuItem);
var
I: integer;
begin
for i := 0 to Menu.Count - 1 do begin
if (Menu.Action <> nil) then
Menu.Action.Update
else if Menu.Count > 0 then
UpdateMenu(menu);
end;
end;
begin
if Sender = nil then exit;
if Sender.ClassType = TToolButton then begin
PM := TToolbutton(Sender).DropdownMenu;
H := TToolButton(Sender).Parent.Handle;
end;
if PM <> nil then begin
Windows.ClientToScreen(H, MousePos);
UpdateMenu(PM.Items);
PM.Items.RethinkHotkeys;
T := Integer(TrackPopupMenu(PM.Handle, TPM_RETURNCMD or TPM_NONOTIFY,
MousePos.X, MousePos.Y, 0, GetActiveWindow(), nil));
if T > 0 then begin
MI := PM.FindItem(T, fkCommand);
if (MI <> nil) and MI.Enabled then
MI.Click;
end;
Handled := True;
end;
end;
 
谢谢，这么快回复。

我试了上面的代码，可以弹出来了，但是弹出的menuitem没有caption了。

>>经测试，使用了Action的MenuItem没有了Caption,如果知道什么原因请告知
>>免我继续测试:)
 
to 铁盒子,
是的，不过我找到一个以前的Menus.pas，里面把PopupList改成线程安全的了，就解决了这个问题。不过，我现在想动手改2006的menus.pas，不知道怎么下手。。。。。。
 
to zqw0117
能否传一份改过的Menus.pas给我？谢谢，CoolSlob at 163.com

>>不过，我现在想动手改2006的menus.pas，不知道怎么下手。。。。。。

没有用过2006, 难道不是一样的改法吗？
 
可以，没问题，等下传一分给你。
不是，是不知道他改了哪些地方（没写注释），怕有遗漏，同时，2006的menu和d7的变化比较大，怕修改错了更麻烦，毕竟是修改vcl内部的东西啊。
 
可以使用编辑器进行对比。
 
哦，是哦，回头试试：）
邮件已发送，请查收。
 
邮件收到，谢谢。
 
如果你用了SVN的话，SVN的对比功能很好.
 
我这里可以正常使用，delphi7 win200server
你可以跟踪下在TrackPopupMenu前menu的Caption是赋值
 
接受答案了.
 
我的Win2003 sp1,
使用zqw0117的menus,也没有效果。
 
您必须登录或注册才可回复。

Similar threads

Ray
[转]终于可以发布Delphi下收点OSGI精髓皮毛而设计的插件框架WisdomPluginFramework
回复
4
查看
4K
chlkuei
C
W
怪不得我的问题没人回答，原来忘了给分．还是关于怎样判断哪些窗口是IE的弹出窗口.(300分)
2
回复
29
查看
390
www
W
D
怎样禁止IE的弹出窗口(200分)
回复
3
查看
137
woyeah2000
W
R
关于给delphi6中demo的textedit这个例子加上工具栏的问题？ (100分)
回复
0
查看
195
rocken2
R
I
如何作出象Foxmail工具栏那样，窗口宽度变小后，在右方出现箭头，点击后会弹出越出边界的按钮？？(100分)
回复
7
查看
173
ili
I
后退
顶部