Выпадающее меню для любого TControl
Продолжить эту тему:
Я написал общий код для DropDown MEMU слюбой TControl
, но по какой-то причине он не работает, как ожидалось с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;
Это хорошо работает с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;
и даже неAbort
в случаеTDropDownMenuHandler.MouseDown
, Что я могу сделать, чтобы сделать эту работу сTPanel
и другие элементы управления? Что мне не хватает?