delphi – 任何TControl的下拉菜单
继续这个主题:
Drop down menu for TButton 我已经用任何TControl为DropDown memu编写了一个通用代码,但由于某种原因,它不能像TPanel那样按预期工作: var TickCountMenuClosed: Cardinal = 0; LastPopupControl: TControl; type TDropDownMenuHandler = class public class procedure MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X,Y: Integer); end; TControlAccess = class(TControl); class procedure TDropDownMenuHandler.MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X,Y: Integer); begin if LastPopupControl <> Sender then Exit; if (Button = mbLeft) and not ((TickCountMenuClosed + 100) < GetTickCount) then begin if GetCapture <> 0 then SendMessage(GetCapture,WM_CANCELMODE,0); ReleaseCapture; // SetCapture(0); if Sender is TGraphicControl then Abort; end; end; procedure RegisterControlDropMenu(Control: TControl; PopupMenu: TPopupMenu); begin TControlAccess(Control).OnMouseDown := TDropDownMenuHandler.MouseDown; end; procedure DropMenuDown(Control: TControl; PopupMenu: TPopupMenu); var APoint: TPoint; begin LastPopupControl := Control; RegisterControlDropMenu(Control,PopupMenu); APoint := Control.ClientToScreen(Point(0,Control.ClientHeight)); PopupMenu.PopupComponent := Control; PopupMenu.Popup(APoint.X,APoint.Y); TickCountMenuClosed := GetTickCount; end; 据我所知,这适用于TButton和TSpeedButton以及任何TGraphicControl(如TImage或TSpeedButton等). 但与TPanel无法正常工作 procedure TForm1.Button1Click(Sender: TObject); begin DropMenuDown(Sender as TControl,PopupMenu1); end; procedure TForm1.Panel1Click(Sender: TObject); begin DropMenuDown(Sender as TControl,PopupMenu1); // Does not work! end; procedure TForm1.SpeedButton1Click(Sender: TObject); begin DropMenuDown(Sender as TControl,PopupMenu1); end; procedure TForm1.Image1Click(Sender: TObject); begin DropMenuDown(Sender as TControl,PopupMenu1); end; 似乎TPanel不尊重ReleaseCapture;事件TDropDownMenuHandler.MouseDown甚至没有Abort.我可以做些什么来使用TPanel和其他控件?我错过了什么? 解决方法
这并不是说TPanel不尊重ReleaseCapture,而是捕获根本不相关.弹出菜单启动并激活后会发生这种情况,并再次单击控件:
>单击取消模式菜单循环,关闭菜单并发布鼠标按下消息. 当然,我没有跟踪一个工作示例,所以我不知道ReleaseCapture何时以及如何有用.无论如何,它在这里无济于事. 我建议的解决方案与当前设计略有不同. 我们想要的是第二次点击以不引起点击.看到这部分代码: procedure DropMenuDown(Control: TControl; PopupMenu: TPopupMenu); var APoint: TPoint; begin ... PopupMenu.PopupComponent := Control; PopupMenu.Popup(APoint.X,APoint.Y); TickCountMenuClosed := GetTickCount; end; 实际上,第二次单击是关闭菜单的,然后再通过相同的处理程序再次启动它.这是导致PopupMenu.Popup调用返回的原因.所以我们在这里可以看出鼠标按钮被点击(左键或双击),但尚未由VCL处理.这意味着消息仍在队列中. 使用这种方法删除注册机制(鼠标向下处理程序黑客),它是不需要的,而类本身就是结果,而且是全局的. procedure DropMenuDown(Control: TControl; PopupMenu: TPopupMenu); var APoint: TPoint; Msg: TMsg; Wnd: HWND; ARect: TRect; begin APoint := Control.ClientToScreen(Point(0,APoint.Y); if (Control is TWinControl) then Wnd := TWinControl(Control).Handle else Wnd := Control.Parent.Handle; if PeekMessage(Msg,Wnd,WM_LBUTTONDOWN,WM_LBUTTONDBLCLK,PM_NOREMOVE) then begin ARect.TopLeft := Control.ClientOrigin; ARect.Right := ARect.Left + Control.Width; ARect.Bottom := ARect.Top + Control.Height; if PtInRect(ARect,Msg.pt) then PeekMessage(Msg,PM_REMOVE); end; end; 另外,这不依赖于处理时序. (编辑:李大同) 【声明】本站内容均来自网络,其相关言论仅代表作者个人观点,不代表本站立场。若无意侵犯到您的权利,请及时与联系站长删除相关内容! |