I create a VCL forms application, add a main menu and insert the "MDI Frame Menu" from the menu templates. I run the programme and use the acceleration keys. Everything works as expected.
I now add a toolbar, disconnect the main menu from the form and link it to the toolbar. I run the programme . Now the menu items activate by just pressing the appropriate key without pressing Alt (e.g. pressing "W" opens the Windows menu item.
How can I get the menu on the toolbar to behave like the main menu without it?
I created one answer to my question (there might be simpler and more elegant ones). Steps to make a TMainMenu in a toolbar behave the same as a TMainMenu on a form are:
Put a TMainMenu on MainForm
Populate the MainMenu as needed
Put an ActionList on the form
Make sure all the menu items act via the ActionList
Clear the menu property of the MainForm
Put a TToolbar on the form
Assign the MainMenu to the Toolbar
Write the procedure DeleteHotKeysOfToolbarMenu(Sender: TObject); (see code snippet below)
Write code for the ActionList.OnExecute event as shown below
Set the KeyPreview property of the MainForm to true
Write the MainForm.OnKeyPress event as shown below
In the Create procedure of the MainForm call DeleteHotKeysOfToolbarMenu to start the programme without any visible hot keys
That is it
Below are the code snippets:
procedure TMainForm.DeleteHotKeysOfToolbarMenu(Sender: TObject);
var
m: integer;
begin
for m := 0 to Toolbar.ButtonCount-1 do
Toolbar.Buttons[m].Caption := StripHotKey(Toolbar.Buttons[m].Caption);
end;
procedure TMainForm.ActionListExecute(Action: TBasicAction; var Handled: Boolean);
begin
if Action.ActionComponent.ClassType = TMenuItem then
DeleteHotKeysOfToolbarMenu(Self);
end;
TMainForm.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
if (ssAlt in Shift) or (Key = VK_F10) then
begin
Toolbar.Menu := nil;
Toolbar.Menu := MainMenu;
end;
if Key = VK_Escape then DeleteHotKeysOfToolbarMenu(Self);
end;
Related
I am having a problem with an effect trigger (shadow effect). I did put the trigger to be ismouseover = true. So, when I put the mouse onto a panel (parent), the shadows activate, and it works fine until I start putting some buttons inside the panel (children).
The shadows effect goes off when the mouse is over the children.
So, is there anyway to keep focus on the parents while being focused on the children?
I did try to change the trigger of the effects (from ismouseover to isfocused), but it didn't give any different results.
As said, your design is wrong, then you can remove the trigger and do it manually :
// show or hide shadow effect
procedure TForm2.ShowShadowEffect(AValue: boolean);
begin
if ShadowEffect1.Enabled <> AValue then
ShadowEffect1.Enabled := AValue;
end;
// show when enter on panel
procedure TForm2.Panel1MouseEnter(Sender: TObject);
begin
ShowShadowEffect(True);
end;
// hide when leave the panel
procedure TForm2.Panel1MouseLeave(Sender: TObject);
begin
ShowShadowEffect(False);
end;
// keep visible when over button
procedure TForm2.Button1MouseEnter(Sender: TObject);
begin
ShowShadowEffect(True);
end;
When use TEdit control on the right side stay small icon 'x'. How after click on icon clear TEdit box.
Tnx all!
Delphi provide TClearEditButton to clear the TEdit content. It can be added by right clicking and selecting AddItem - TClearEditButton from the popup menu. It also has a Click procedure overriden in FMX.Edit unit like:
procedure TClearEditButton.Click;
var
EditTmp: TCustomEdit;
begin
inherited Click;
EditTmp := GetEdit;
if EditTmp <> nil then
begin
if EditTmp.Observers.IsObserving(TObserverMapping.EditLinkID) then
if not TLinkObservers.EditLinkEdit(EditTmp.Observers) then
Exit; // Can't change
EditTmp.Text := string.Empty;
if EditTmp.Observers.IsObserving(TObserverMapping.EditLinkID) then
TLinkObservers.EditLinkModified(EditTmp.Observers);
if EditTmp.Observers.IsObserving(TObserverMapping.ControlValueID) then
TLinkObservers.ControlValueModified(EditTmp.Observers);
end;
end;
Which make you don't need to write OnClick event handler for the TClearEditButton unless you want to do some other job along side with clearing the edit.
If you are using a TEditButton then you should write the OnClick event handler like:
procedure TForm1.EditButton1Click(Sender: TObject);
begin
Edit1.Text:= EmptyStr;
end;
This one has been puzzling me for some time now and maybe the answer is an easy one, or perhaps it involves much more VCL hacking or magic to accomplish what I am looking for but either way I am at a loss as to how to solve my problem.
If you look at the Delphi Form Designer you will see that none of the controls animate when the mouse moves over them, they also cannot receive focus or input (eg you cannot type into a TEdit, click a TCheckBox or move a TScrollBar etc), only at runtime do the controls behave normally and respond to user interaction.
I want to know how can I implement this type of behavior to any control at runtime, eg set controls into like a Designer State Mode? However, controls should also still respond to Mouse Events such as OnMouseDown, OnMouseMove, OnMouseUp etc so they can be moved and sized if needed for example.
This is the closest that I managed:
procedure SetControlState(Control: TWinControl; Active: Boolean);
begin
SendMessage(Control.Handle, WM_SETREDRAW, Ord(Active), 0);
InvalidateRect(Control.Handle, nil, True);
end;
Which could be called simply like so:
procedure TForm1.chkActiveClick(Sender: TObject);
begin
SetControlState(Button1, chkActive.Checked);
SetControlState(Button2, chkActive.Checked);
SetControlState(Edit1, chkActive.Checked);
end;
Or for example, all controls on the form:
procedure TForm1.chkActiveClick(Sender: TObject);
var
I: Integer;
Ctrl: TWinControl;
begin
for I := 0 to Form1.ControlCount -1 do
begin
if Form1.Controls[I] is TWinControl then
begin
Ctrl := TWinControl(Form1.Controls[I]);
if (Ctrl <> nil) and not (Ctrl = chkActive) then
begin
SetControlState(Ctrl, chkActive.Checked);
end;
end;
end;
end;
Two problems I have noticed with the above is that whilst the controls do appear to become Design State like, some controls such as TButton still have the animation effect painted on them. The other issue is when pressing the left Alt key when the controls are Design State like causes them to disappear.
So my question is, how do I put controls into a Design State mode at runtime just like the Delphi Form Designer does, where those controls do not animate (based on Windows Theme) and cannot receive focus or input?
To make that bit clearer, look at this sample image based off the above code sample where the controls are no longer active, but the TButton's animation paint is still active:
But should actually be:
From the two images above, only the TCheckBox control can be interacted with.
Is there a procedure hidden away somewhere that can change the state of a control? Or perhaps a more suitable approach to achieving this? The code I managed to get so far just presents more problems.
Setting the controls to Enabled := False is not an answer I am looking for either, yes the behavior is kind of the same but of course the controls paint differently to show they are disabled which is not what I am looking for.
What you are looking for is not a feature of the controls themselves, but rather is an implementation of the Form Designer itself. At design-time, user input is intercepted before it can be processed by any given control. The VCL defines a CM_DESIGNHITTEST message to allow each control to specify whether it wants to receive user input at design-time (for example to allow visual resizing of list/grid column headers). It is an opt-in feature.
What you can do, though, is put the desired controls onto a borderless TPanel, and then simply enable/disable the TPanel itself as needed. That will effectively enable/disable all user input and animations for its child controls. Also, when the TPanel is disabled, the child controls will not render themselves as looking disabled.
Remy Lebeau's answer on putting controls into a container such as a TPanel, and then setting the panel to Enabled := False does put the controls into the state I was looking for. I also discovered that overriding the controls WM_HITTEST put the controls into the same state, eg they don't receive focus and cannot be interacted with. The problem with those two is that the controls still need to be able to respond to MouseDown, MouseMove and MouseUp events etc but they no longer cannot.
Remy also suggested writing a class and implement Vcl.Forms.IDesignerHook, something I have not attempted yet as maybe it requires too much work for what I need.
Anyway, after lots of playing around I found another alternative way, it involves the use of PaintTo to draw the control onto a canvas. The steps I did are as follows:
Create a custom TPanel with an exposed Canvas
At FormCreate create and align the custom panel to client
Add controls to the form at runtime (bringing the custom panel to the front)
Call the controls PaintTo method onto the custom panels Canvas
What this is essentially doing is creating the components and using the Form as the parent with our custom panel sitting on top. The controls are then painted onto the panels canvas which makes it appear as if the control is on the panel, when actually it sits underneath on the form undisturbed.
Because the controls are underneath the panel, in order for them to respond to events such as MouseDown, MouseMove and MouseUp etc I overrided the WM_NCHitTest in the panel and set the result to HTTRANSPARENT.
In code it would look something like this:
Custom panel:
type
TMyPanel = class(TPanel)
protected
procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHitTest;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Canvas;
end;
{ TMyPanel }
constructor TMyPanel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Align := alClient;
BorderStyle := bsNone;
Caption := '';
end;
destructor TMyPanel.Destroy;
begin
inherited Destroy;
end;
procedure TMyPanel.WMNCHitTest(var Message: TWMNCHitTest);
begin
Message.Result := HTTRANSPARENT;
end;
Form:
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
FMyPanel: TMyPanel;
procedure ControlMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
public
{ Public declarations }
end;
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
FMyPanel := TMyPanel.Create(nil);
FMyPanel.Parent := Form1;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FMyPanel.Free;
end;
procedure TForm1.ControlMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Sender is TWinControl then
begin
ShowMessage('You clicked: ' + TWinControl(Sender).Name);
end;
end;
Example of adding a TButton to the form:
procedure TForm1.Button1Click(Sender: TObject);
var
Button: TButton;
begin
Button := TButton.Create(Form1);
Button.Parent := Form1;
FMyPanel.BringToFront;
with Button do
begin
Caption := 'Button';
Left := 25;
Name := 'Button';
Top := 15;
OnMouseDown := ControlMouseDown;
PaintTo(FMyPanel.Canvas, Left, Top);
Invalidate;
end;
end;
If you try running the above, you will see that the TButton we created does not animate or receive focus, but it can respond to MouseDown events we attached in the code above, that is because we are not actually looking at the control, instead we are viewing a graphical copy of the control.
I'm not sure if this is what you're after or not, but Greatis has a Form Designer component. See: http://www.greatis.com/delphicb/formdes/
Continue of this topic:
Drop down menu for TButton
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.
Requirements
If I understand you correctly, then the requirements are:
At the first left mouse button click on a Control, a PopupMenu should be shown beneath the Control.
At the second left mouse button click an that same Control, the shown PopupMenu should be closed.
Realize that, disregarding the implementation of requirement 1 for the moment, requirement 2 happens automatically: when you click outside a PopupMenu, the PopupMenu will close. This concludes to that the implementation of the first should not interfere with the second.
Possible solutions:
Count the clicks on the Control: at the first click, show the PopupMenu and at the second click, do nothing. But this will not work, because the PopupMenu may be closed already by clicks elsewhere and then a second click should actually be the first click.
At the first click, show the PopupMenu. At the second click, determine whether the PopupMenu is still shown. If so, then do nothing. Otherwise, assume a first click. This also will not work, because when a second click is processed, the PopupMenu will be already closed.
At the first click, show the PopupMenu. At the second click, determine whether the PopupMenu is closed sometime during the last couple of milliseconds. If so, then the disappearance is due to this very second click and do nothing. This is the solution you are currently using by utilizing the fact that TPopupMenu.Popup will not return until the PopupMenu is closed.
The current implementation
During the OnClick event of a Control:
The OnMouseDown event of the control is assigned to a custom handler,
The PopupMenu is Shown.
On the second click on the Control:
The time when then PopupMenu was closed is saved (this is still during execution of the previous OnClick event),
The custom OnMouseDown event handler is called,
If the saved time was within the last 100 milliseconds, the mouse capture is released and all execution is aborted.
Note: a possibly already OnMouseDown event setting is not saved and gone!
Why this works for a Button
A TCustomButton handles click events by responding to a by Windows send CN_COMMAND message. That is a specific Windows BUTTON sytem class control characteristic. By canceling the mouse capture mode, this message is not send. Thus the Control's OnClick event is not fired on the second click.
Why this doesn't work for a Panel
A TPanel handles click events by adding the csClickEvents style to its ControlStyle property. This is a specific VCL characteristic. By aborting execution, subsequent code due to the WM_LBUTTONDOWN message is stopped. However, the OnClick event of a TPanel is fired somewhere down its WM_LBUTTONUP message handler, thus the OnClick event is still fired.
Solution for both
Use davea's answer on your other question wherein he simply does nothing if the saved time of the PopupMenu's closing was within the last 100 milliseconds.
Having a popup menu attached to several components on a form (buttons, but also things like TCharts), I would like to know which component was right clicked to start the popup menu in the first place.
The Sender parameter of the click method just points to the TMenuItem, its parent to the popup menu (or the parenting menu item).
How do I get the originating component?
Did you mean PopupMenu1.PopupComponent ?
You can get the caller component within the click event of the TMenuItem of a PopupMenu by
Caller := ((Sender as TMenuItem).GetParentMenu as TPopupMenu).PopupComponent;
An Example of a PopupMenu which is assigned to several list boxes and solves the export to file functionality:
procedure TForm1.mniExportFileClick(Sender: TObject);
var Caller: TObject;
begin
if SaveTextFileDialog1.Execute then
begin
Caller := ((Sender as TMenuItem).GetParentMenu as TPopupMenu).PopupComponent;
(Caller as TListBox).Items.
SaveToFile(SaveTextFileDialog1.FileName,
StandardEncodingFromName(
SaveTextFileDialog1.Encodings[SaveTextFileDialog1.EncodingIndex]));
end;
end;
As a last resort you can use Mouse.CursorPos in TPopupMenu.OnPopup to find this component on a form. But there is probably a better/easier way.
PopUpMenu.PopupComponent indicates the component that last displayed the popup menu in response to the right mouse click
I have a bunch of panels and I want to let the user right click any of those panels and perform a "delete file" action.
So, I have a single pop-up menu associated with all those panels.
This is how I find out which panel was right clicked:
(Note: I put lots of comments to clearly explain how it works. But if you don't like it, you can compactify the code to 2 lines (see the second procedure)).
So, if you have actions assigned to that pop-up menu:
procedure Tfrm.actDelExecute(Sender: TObject);
VAR
PopMenu: TPopupMenu;
MenuItem: TMenuItem;
PopupComponent: TComponent;
begin
{ Find the menuitem associated to this action }
MenuItem:= TAction(Sender).ActionComponent as TMenuItem; { This will crash and burn if we call this from a pop-up menu, not from an action! But we always use actions, so.... }
{ Was this action called by keyboard shortcut? Note: in theory there should be no keyboard shortcuts for this action if the action can be applyed to multiple panels. We can call this action ONLY by selecting (right click) a panel! }
if MenuItem = NIL then
begin
MsgError('This action should not be called by keyboard shortcuts!');
EXIT;
end;
{ Find to which pop-up menu this menuitem belongs to }
PopMenu:= (MenuItem.GetParentMenu as TPopupMenu);
{ Find on which component the user right clicks }
PopupComponent := PopMenu.PopupComponent;
{ Finally, access that component }
(PopupComponent as TMonFrame).Delete(FALSE);
end;
If you only have a simple pop-up menu (no actions assigned):
procedure Tfrm.actDelHddExecute(Sender: TObject);
VAR PopupComponent: TComponent;
begin
PopupComponent := ((Sender as TMenuItem).GetParentMenu as TPopupMenu).PopupComponent;
(PopupComponent as TMonFrame).Delete(TRUE);
end;
You can put all that code in a single function that returns a TPanel and call it like this:
procedure Tfrm.actDelWallExecute(Sender: TObject);
begin
if GetPanelFromPopUp(Sender) <> NIL
then GetPanelFromPopUp(Sender).Delete(FALSE);
end;