Forum > LCL
Popup menu hierarchy
(1/1)
simone:
I start the post illustrating something I didn't know, in order to confirm that I understood correctly, then I ask the consequent question.
Suppose we have a control with an associated popup menu, which is the parent of a control with a different associated popup menu, both set at design time. If at run time the popup menu of the child control is disabled (i.e. the PopupMenu property set to nil), every time the right mouse button is pressed on the child control, the context menu of the parent control is shown. Therefore the possibility of activating the popup menu is not disabled. The attached example shows this mechanism.
If this is confirmed, then I have the following problem. I'm developing a component that can be used as a child of any parent, within a parent-child hierarchy. This control, if in a certain state, uses the right mouse button for a specific function, therefore in that state the popup menu of the control itself must not be active. In this state, to prevent the parent control's popup menu from being shown, should I recursively nil all the ancestors' popup menus, or is there a smarter way to disable the popup?
zeljko:
What about setting TPopupMenu.AutoPopup to false (parent popup menu) ?
EDIT: Sorry, in that case you should call manually popup for your parent control. Maybe MyChild.OnContextPopup and then set Handled := True if MyChild.PopupMenu = nil.
simone:
The problem is that if the child control is a TScrollBox, as in my attached example, the OnContextPopup property is not available.
simone:
While waiting for a more intelligent solution to the problem, here's what I had thought:
--- Code: Pascal [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---unit Unit1; {$mode objfpc}{$H+} interface uses Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, Menus; type { TScrollBox } TScrollBox=class(Forms.TScrollBox) private procedure EnablePopupMenus; procedure DisablePopupMenus; public PopupMenuList : array of TPopupMenu; end; { TForm1 } TForm1 = class(TForm) Button1: TButton; Button2: TButton; MenuItem1: TMenuItem; MenuItem2: TMenuItem; MenuItem3: TMenuItem; PopupMenu1: TPopupMenu; PopupMenu2: TPopupMenu; ScrollBox1: TScrollBox; procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); private public end; var Form1: TForm1; implementation {$R *.lfm} { TScrollBox } procedure TScrollBox.DisablePopupMenus;var P : TWinControl;begin PopupMenuList:=nil; P:=self; while Assigned(P) do begin Insert(P.PopupMenu,PopupMenuList,Length(PopupMenuList)); P.PopupMenu:=nil; P:=P.Parent; end;end; procedure TScrollBox.EnablePopupMenus;var P : TWinControl; ind : integer;begin P:=self; for ind:=0 to Length(PopupMenuList)-1 do begin P.PopupMenu:=PopupMenuList[ind]; P:=P.Parent; end;end; { TForm1 } procedure TForm1.Button1Click(Sender: TObject);begin ScrollBox1.DisablePopupMenus;end; procedure TForm1.Button2Click(Sender: TObject);begin ScrollBox1.EnablePopupMenus;end; end.
jamie:
I could consider this as a bug, but I am not sure of this isn't the way it should work..
In any case look at my test app.
--- Code: Pascal [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---unit Unit1; {$mode objfpc}{$H+} interface uses Classes, SysUtils, Forms, Controls, Graphics, Dialogs, Menus, StdCtrls,Lmessages;Type { TscrollBar } TscrollBox = Class(Forms.TScrollBox) procedure WndProc(Var Msg:TLMessage); Override;end; { TForm1 } TForm1 = class(TForm) Button1: TButton; MenuItem1: TMenuItem; MenuItem2: TMenuItem; MenuItem3: TMenuItem; MenuItem4: TMenuItem; MenuItem5: TMenuItem; MenuItem6: TMenuItem; MenuItem7: TMenuItem; PopupMenu1: TPopupMenu; PopupMenu2: TPopupMenu; ScrollBox1: TScrollBox; private public end; var Form1: TForm1; implementation {$R *.lfm} { TscrollBar } procedure TscrollBox.WndProc(var Msg: TLMessage);begin if Msg.msg = LM_ContextMenu then begin If PopUpMenu = Nil then Msg.Msg := 0; end; inherited WndProc(Msg);end; end;
Btw, That works :D
Navigation
[0] Message Index