任何TControl的下拉菜单 [英] Drop down menu for any TControl
问题描述
继续此主题：
我已经为任何 TControl写了一个DropDown memu的通用代码，但是由于某种原因，它不能像 TPanel 所预期的那样工作：
var
TickCountMenuClosed：Cardinal = 0;
LastPopupControl：TControl;
type
TDropDownMenuHandler = class
public
类过程MouseDown（发件人：TObject; Button：TMouseButton;
Shift：TShiftState; X，Y：整数）;
结束
TControlAccess = class（TControl）;
类程序TDropDownMenuHandler.MouseDown（Sender：TObject; Button：TMouseButton;
Shift：TShiftState; X，Y：Integer）;
begin
如果LastPopupControl<>发货人然后退出;
if（Button = mbLeft）和not（（TickCountMenuClosed + 100）&GetTickCount）然后
begin
如果GetCapture<> 0然后SendMessage（GetCapture，WM_CANCELMODE，0，0）;
ReleaseCapture;
// SetCapture（0）;
如果发件人是TGraphicControl然后中止;
结束
结束
程序RegisterControlDropMenu（控件：TControl; PopupMenu：TPopupMenu）;
begin
TControlAccess（Control）.OnMouseDown：= TDropDownMenuHandler.MouseDown;
结束
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;
结束
这对 TButton 和 TSpeedButton 和任何 TGraphicControl （如 TImage 或 TSpeedButton 等），只要我可以告诉。
但是不能像 TPanel
procedure TForm1.Button1Click（Sender：TObject）;
begin
DropMenuDown（发送方作为TControl，PopupMenu1）;
结束
procedure TForm1.Panel1Click（Sender：TObject）;
begin
DropMenuDown（发送方作为TControl，PopupMenu1）; //不行！
结束
程序TForm1.SpeedButton1Click（Sender：TObject）;
begin
DropMenuDown（发送方作为TControl，PopupMenu1）;
结束
程序TForm1.Image1Click（Sender：TObject）;
begin
DropMenuDown（发送方作为TControl，PopupMenu1）;
结束
似乎 TPanel 不尊重<$事件 TDropDownMenuHandler.MouseDown 中的c $ c> ReleaseCapture; 甚至不会中止。使用 TPanel 和其他控件可以做些什么？我缺少什么？
不是 TPanel 不尊重 ReleaseCapture ，那就是捕获是完全不相关的。这是弹出菜单启动并激活后会发生的情况，再次点击控件：
- 点击取消模态菜单循环菜单被关闭，并且发布鼠标下降消息。
- VCL在鼠标下设置一个标志信息处理
[csClicked]。 - 鼠标事件处理程序被触发，释放捕获。
- 鼠标退出消息返回后，系统会处理已发布的鼠标向上消息，VCL将检查该标志，并单击该控件（如果已设置）。
- 点击处理程序弹出菜单。
授予我没有追踪一个工作示例，所以我不知道什么时候和如何 ReleaseCapture 是有帮助的。无论如何，这里无法帮助。
我提出的解决方案与目前的方案有所不同设计。
我们想要的是第二次点击，不会导致点击。请看这段代码：
procedure DropMenuDown（Control：TControl; PopupMenu：TPopupMenu）;
var
APoint：TPoint;
begin
...
PopupMenu.PopupComponent：= Control;
PopupMenu.Popup（APoint.X，APoint.Y）;
TickCountMenuClosed：= GetTickCount;
结束
第二次点击实际上是关闭菜单，然后再次通过同一个处理程序启动它。这是什么导致 PopupMenu.Popup 调用返回。所以我们可以告诉这里，鼠标按钮被点击（左按钮或双击），但还没有被VCL处理。这意味着消息尚未排队。
使用这种方法删除注册机制（鼠标处理程序黑客），它不是必需的，而类本身就是结果和全局变量。
procedure DropMenuDown（Control：TControl; PopupMenu：TPopupMenu）;
var
APoint：TPoint;
消息：TMsg;
Wnd：HWND;
ARect：TRect;
begin
APoint：= Control.ClientToScreen（Point（0，Control.ClientHeight））;
PopupMenu.PopupComponent：= Control;
PopupMenu.Popup（APoint.X，APoint.Y）;
if（控制是TWinControl）然后
Wnd：= TWinControl（Control）.Handle
else
Wnd：= Control.Parent.Handle;
如果PeekMessage（Msg，Wnd，WM_LBUTTONDOWN，WM_LBUTTONDBLCLK，PM_NOREMOVE）然后开始
ARect.TopLeft：= Control.ClientOrigin;
ARect.Right：= ARect.Left + Control.Width;
ARect.Bottom：= ARect.Top + Control.Height;
如果PtInRect（ARect，Msg.pt）然后
PeekMessage（Msg，Wnd，WM_LBUTTONDOWN，WM_LBUTTONDBLCLK，PM_REMOVE）;
结束
结束
此外，这不取决于处理时间。 >
Continue of this topic:
I have wrote a generic code for DropDown memu with any TControl, but for some reason it dose not work as expected with 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, 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;
This works well with TButton and with TSpeedButton and with any TGraphicControl (like TImage or TSpeedButton etc) as far as I can tell.
BUT does not work as expected with 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;
Seems like TPanel is not respecting ReleaseCapture; and not even Abort in the event TDropDownMenuHandler.MouseDown. What can I do to make this work with TPanel and other controls? What am I missing?
It's not that TPanel is not respecting ReleaseCapture, it is that the capture is not relevant at all. This is what happens after the popup menu is launched and active, and the control is clicked once again:
- The click cancels the modal menu loop, the menu is closed and a mouse down message is posted.
- VCL sets a flag within the mouse down message handling
[csClicked]. - Mouse down event handler is fired, you release the capture.
- After the mouse down message returns, posted mouse up message is processed, VCL checks for the flag and clicks the control if it is set.
- The click handler pops the menu.
Granted I didn't trace a working example so I can't tell when and how ReleaseCapture is helpful. In any case, it can't help here.
The solution I'd propose is a little different than the current design.
What we want is a second click to not to cause a click. See this part of the code:
procedure DropMenuDown(Control: TControl; PopupMenu: TPopupMenu);
var
APoint: TPoint;
begin
...
PopupMenu.PopupComponent := Control;
PopupMenu.Popup(APoint.X, APoint.Y);
TickCountMenuClosed := GetTickCount;
end;
The second click is in fact what closes the menu, before launching it again through the same handler. It is what causes the PopupMenu.Popup call to return. So what we can tell here is that the mouse button is clicked (either a left button or a double click), but not yet processed by the VCL. That means the message is yet in the queue.
Remove the registration mechanism (mouse down handler hacking) with this approach, it is not needed, and the class itself as a result, and the globals.
procedure DropMenuDown(Control: TControl; PopupMenu: TPopupMenu);
var
APoint: TPoint;
Msg: TMsg;
Wnd: HWND;
ARect: TRect;
begin
APoint := Control.ClientToScreen(Point(0, Control.ClientHeight));
PopupMenu.PopupComponent := Control;
PopupMenu.Popup(APoint.X, 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, Wnd, WM_LBUTTONDOWN, WM_LBUTTONDBLCLK, PM_REMOVE);
end;
end;
Additionally this doesn't depend on processing timing.
这篇关于任何TControl的下拉菜单的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
