I have this popup menu:
object pmTest: TPopupMenu
OnPopup = pmTestPopup
Left = 32
Top = 24
object mTest1: TMenuItem
Caption = 'Test 1'
OnClick = mTest1Click
end
object mTest2: TMenuItem
Caption = 'Test 2'
OnClick = mTest2Click
end
end
After showing the popup menu with the Popup method, I need to programmatically HIGHLIGHT (not to click!) a specific menu item, so I tried this:
Winapi.Windows.HiliteMenuItem(pmTest.WindowHandle, pmTest.Handle, 1, MF_BYPOSITION or MF_HILITE);
But it does not work.
How can I programmatically HIGHLIGHT a specific popup menu item?
By default, the TPopupMenu.WindowHandle property is set to the Application.Handle window, not to the private HWND that TPopupMenu actually uses internally to actually dispatch its WM_COMMAND messages to. That window is established when the TPopupMenu.Popup() method is called, and it does not update the TPopupMenu.WindowHandle property.
Try using the TPopupList.Window property instead of the TPopupMenu.WindowHandle property for the HWND to pass to HiliteMenuItem(). There is a global PopupList object in the Vcl.Menus unit:
procedure TMyForm.pmTestPopup(Sender: TObject);
begin
Winapi.Windows.HiliteMenuItem({pmTest.WindowHandle}PopupList.Window, pmTest.Handle, 1, MF_BYPOSITION or MF_HILITE);
end;
If that still does not work, then try the Win32 SetMenuItemInfo() function instead, which does not take an HWND for input:
procedure TMyForm.pmTestPopup(Sender: TObject);
var
mii: MENUITEMINFO;
begin
ZeroMemory(#mii, sizeof(mii));
mii.cbSize := sizeof(mii);
mii.fMask := MIIM_STATE;
mii.fState := MFS_HILITE;
Winapi.Windows.SetMenuItemInfoW(pmTest.Handle, 1, True, mii);
end;
UPDATE: Upon further review, the TPopupMenu.OnPopup event is fired BEFORE the menu is made visible, and TPopupMenu may recreate the menu AFTER OnPopup has been called and BEFORE the menu is actually shown. So, your best bet is likely to subclass the TPopupList window so you can intercept the WM_ENTERMENULOOP message, then customize your menu items at that point. For example:
type
TPopupListEx = class(TPopupList)
protected
procedure WndProc(var Message: TMessage); override;
end;
procedure TPopupListEx.WndProc(var Message: TMessage);
begin
inherited;
if (Message.Msg = WM_ENTERMENULOOP) and (Message.WParam = 1) then
begin
// customize pmTest items as needed...
end;
end;
initialization
Popuplist.Free; //free the "default", "old" list
PopupList := TPopupListEx.Create; //create the new one
// The new PopupList will be freed by
// finalization section of Menus unit.
end.
Related
I'm referring to question
Passing the variable to another Form
Is there also a way to handover data - for example from a settings form to the application's main form without using a global variable?
Since you are talking about a "settings form", I assume that the form is shown modally. Then it is actually almost trivial.
As an example, create a new VCL application with a label and a button:
Then create a settings form used to set the font of the main label in the middle. It can look like this, with two TLabel controls, two TEdit controls, two TCheckBox controls, and two TButton controls.
Don't forget to make sure the tab order is correct, that each control has a unique access key (use the FocusControl property of the label to make the connection to the appropriate edit box), that the OK button has Default = True and ModalResult = mrOk, and that the Cancel button has Cancel = True and ModalResult = mrCancel.
(As a bonus, set NumbersOnly = True on the size edit box.)
Now, to pass information between the forms, it is as simple as this:
procedure TfrmMain.btnSettingsClick(Sender: TObject);
var
dlg: TfrmSettings;
begin
dlg := TfrmSettings.Create(Self);
try
// Populate dialog
dlg.eFont.Text := lblCaption.Font.Name;
dlg.eSize.Text := lblCaption.Font.Size.ToString;
dlg.cbBold.Checked := fsBold in lblCaption.Font.Style;
dlg.cbItalic.Checked := fsItalic in lblCaption.Font.Style;
if dlg.ShowModal = mrOk then
begin
// Apply settings from dialog
lblCaption.Font.Name := dlg.eFont.Text;
lblCaption.Font.Size := StrToInt(dlg.eSize.Text);
if dlg.cbBold.Checked then
lblCaption.Font.Style := lblCaption.Font.Style + [fsBold]
else
lblCaption.Font.Style := lblCaption.Font.Style - [fsBold];
if dlg.cbItalic.Checked then
lblCaption.Font.Style := lblCaption.Font.Style + [fsItalic]
else
lblCaption.Font.Style := lblCaption.Font.Style - [fsItalic];
end;
finally
dlg.Free;
end;
end;
The settings form has several possibilities to handover data to application mainform without using global variable. I'll assume that the setting form has bee created by the mainform like this:
SettingForm := TSettingForm.Create(Self);
SettingForm.ShowModal;
When the setting form is done (closed), ShowModal returns and mainform can access any filed (variable) or property of the setting form, before destroying it:
ShowMessage(SettingForm.SomeVariable.ToString);
SettingForm.Free;
Another way to do is to use an event.
type
TSettingFormValueAvailableEvent = procedure (Sender : TObject; Value : Integer) of object;
// Create the form and assign an event handler then show the form
SettingForm := TSettingForm.Create(Self);
SettingForm.OnValueAvailable := SettingFormValueAvailable;
SettingForm.ShowModal;
// The event handler in main form
procedure TForm1.SettingFormValueAvailable(Sender: TObject; Value : Integer);
begin
ShowMessage(Value.ToString);
end;
// The event declaration in TFormSetting
private
FOnValueAvailable : TSettingFormValueAvailableEvent ;
public
property OnValueAvailable : TSettingFormValueAvailableEvent read FOnValueAvailable write FOnValueAvailable;
// The use of the event in the form setting
procedure TFormSetting.Button1.Click(Sender : TObject);
begin
if Assigned(FOnValueAvailable) then
FOnValueAvailable(Self, 1234); // Pass value 1234
end;
Using an event is a little bit more code but it is "real time". The main form can react immediately when something happens while SettingForm is being displayed.
TAction has a OnHint event, but unfortunately not a OnHideHint event. This has the following drawback:
I have ToolButtons and other controls associated with actions. Whenever the mouse is over such a control, the hint of the Action is shown in the StatusBar; (I have set the StatusBar's AutoHint property to True). But when the mouse leaves the ToolButton, the previous custom text in the StatusBar (which is not from a hint) is NOT automatically restored!
Now I could write an OnMouseLeave event handler for each and every control on the form to restore my custom text in the StatusBar, but this would be cumbersome!
Isn't there something which automatically restores the previous text in the StatusBar?
An OnHideHint event in TAction would be ideal!
That is default behavior, When AutoHint is True, the status bar automatically responds to hint actions by displaying the long version of the hint's text in the first panel.
The issue that you are having is that when you leave a control with your mouse, you are basically entering another window, it's parent control. And because that parent has no Hint string value assigned to it, the HintAction is updated to an empty string.
If you want to return the default value when there is no hint to display then drop a TApplicationEvents component on the form and use the TApplication.OnHint event like this:
var
OriginalPanelText : String = 'BLA';
procedure TForm1.ApplicationEvents1Hint(Sender: TObject);
begin
if StatusBar1.SimplePanel or (StatusBar1.Panels.Count = 0)
then
if Application.Hint <> ''
then
StatusBar1.SimpleText := Application.Hint
else
StatusBar1.SimpleText := OriginalPanelText
else
if Application.Hint <> ''
then
StatusBar1.Panels[0].Text := Application.Hint
else
StatusBar1.Panels[0].Text := OriginalPanelText;
end;
The AutoHint magic all happens in TStatusBar.ExecuteAction. When the hint stops showing that code sets the status bar text to be empty. You could modify the behaviour like this:
type
TStatusBar = class(ComCtrls.TStatusBar)
private
FRestoreTextAfterHintAction: string;
public
function ExecuteAction(Action: TBasicAction): Boolean; override;
end;
function TStatusBar.ExecuteAction(Action: TBasicAction): Boolean;
var
HintText: string;
begin
if AutoHint and not (csDesigning in ComponentState) and
(Action is THintAction) and not DoHint then begin
HintText := THintAction(Action).Hint;
if SimplePanel or (Panels.Count=0) then begin
if HintText='' then begin
SimpleText := FRestoreTextAfterHintAction;
end else begin
FRestoreTextAfterHintAction := SimpleText;
SimpleText := HintText;
end;
end else begin
if HintText='' then begin
Panels[0].Text := FRestoreTextAfterHintAction;
end else begin
FRestoreTextAfterHintAction := Panels[0].Text;
Panels[0].Text := HintText;
end;
end;
Result := True;
end else begin
Result := inherited ExecuteAction(Action);
end;
end;
I've used a rather crude interposer class and a brittle instance variable to store the text to be restored. You could tart this up to be a little more robust if you wish. The code above at least shows you the place you need to add your hooks.
We use mouse left click to trigger actions in menu items of TPopupMenu. How to trigger different action on mouse middle click in these menu items? In other word, mouse left and middle click on TPopupmenu's menu items are both different action.
The global Menus.PopupList variable keeps track of all PopupMenus and handles all massages send to them. You can override this PopupList with your own instance, as follows:
type
TMyPopupList = class(TPopupList)
private
FMenuItem: TMenuItem;
protected
procedure WndProc(var Message: TMessage); override;
end;
{ TMyPopupList }
procedure TMyPopupList.WndProc(var Message: TMessage);
var
FindKind: TFindItemKind;
I: Integer;
Item: Integer;
Action: TBasicAction;
Menu: TMenu;
begin
case Message.Msg of
WM_MENUSELECT:
with TWMMenuSelect(Message) do
begin
FindKind := fkCommand;
if MenuFlag and MF_POPUP <> 0 then
FindKind := fkHandle;
for I := 0 to Count - 1 do
begin
if FindKind = fkHandle then
begin
if Menu <> 0 then
Item := GetSubMenu(Menu, IDItem)
else
Item := -1;
end
else
Item := IDItem;
FMenuItem := TPopupMenu(Items[I]).FindItem(Item, FindKind);
if FMenuItem <> nil then
Break;
end;
end;
WM_MBUTTONUP:
if FMenuItem <> nil then
begin
GetMenuItemSecondAction(FMenuItem, Action);
Menu := FMenuItem.GetParentMenu;
if Action <> nil then
begin
Menu := FMenuItem.GetParentMenu;
SendMessage(Menu.WindowHandle, WM_IME_KEYDOWN, VK_ESCAPE, 0);
Action.Execute;
Exit;
end;
end;
end;
inherited WndProc(Message);
end;
initialization
PopupList.Free;
PopupList := TMyPopupList.Create;
The GetMenuItemSecondAction routine you have to write yourself. Maybe this answer provides some help about adding your own actions to a component.
Note that the code under WM_MENUSELECT is simply copied from Menus.TPopupList.WndProc. You could also retrieve the MenuItem in the WM_MBUTTONUP handling by using MenuItemFromPoint.
But as the many comments have already said: think twice (or more) before implementing this UI functionality.
You are not notified of such an event. If you were there would be an entry for middle mouse button click in the list of menu notifications.
So perhaps you could use some sort of hack behind the back of the menu system if you really want to do this. However, as discussed in the comments, there are good reasons for thinking that your proposed UI may not be very appropriate.
If the middle click is not a suitable choice, how about using some key combination with mouse click like Ctrl-Click, to trigger another action? The TPopupMenu doesn't have any event related to customized click.
That is preferred over a middle mouse button click.
And then it is much simpler. Just check in your action execute handler if the CTRL button is pressed:
procedure TForm1.Action1Execute(Sender: TObject);
begin
if (GetKeyState(VK_CONTROL) and $8000 = 0) then
// process normal click
else
// process ctrl click
end;
I try to combine 2 answers from author NGLN and come out with the following.
Define a new class inherit from TPopupList:
TMyPopupList = class(TPopupList)
protected
procedure WndProc(var Message: TMessage); override;
end;
procedure TMyPopupList.WndProc(var Message: TMessage);
var H: HWND;
begin
case Message.Msg of
WM_MBUTTONDOWN: begin
H := FindWindow(PChar('#32768'), nil);
SendMessage(H, WM_IME_KEYDOWN, VK_RETURN, 0);
end;
end;
inherited WndProc(Message);
end;
initialization
PopupList.Free;
PopupList := TMyPopupList.Create;
end.
The Item1Click is an OnClick event handler of TMenuItem that perform based on mouse click:
procedure TForm1.Item1Click(Sender: TObject);
begin
if (GetKeyState(VK_MBUTTON) and $80 > 0) then
Caption := 'Middle Click'
else
Caption := 'Normal Click';
end;
Note: #32768 is the default window class name for a pop-up menu, see MSDN documentation.
When the user clicks 'x' on a Pinned Form OnClose is called.
When the user clicks 'x' on an Unpinned Form OnHide is called
When the user clicks 'UnPin' on a Pinned Form OnHide is called.
I'm trying to synchronise the visible forms with a menu system but I don't know how to determine the difference in the OnHide event between when the user clicks 'x' and when the user clicks 'UnPin'. I want to intercept the 'x' and call Close instead.
Each child is a descendant of TManagerPanel which in turn is a descendant of TForm with the border style set to bsSizeToolWin, Drag Kind set to dkDock and Drag Mode is dmAutomatic.
type
TPanelManager = class(TForm)
...
private
...
Panels: TManagerPanelList;
Settings: TSettings; //User Settings
...
end;
...
function TPanelManager.InitChild(ChildClass: TManagerPanelClass): TManagerPanel;
var
Child: TManagerPanel;
begin
Child := ChildClass.Create(Self);
Child.Connection := MSConnection1;
Child.Settings := Settings;
Child.Styles := Styles;
...
Child.OnPanelClosed := PanelClosed;
Child.OnPercentChanged := PercentChanged;
...
Child.OnPanelHide := PanelHide;
Child.Font := Font;
Child.Initialise;
Child.ManualDock(DockTarget);
Panels.AddPanel(Child);
Result := Child;
end;
procedure TPanelManager.PanelClosed(Sender: TObject; var Action: TCloseAction);
var
MenuItem: TMenuItem;
Child: TManagerPanel;
begin
if Sender is TManagerPanel then
begin
Child := TManagerPanel(Sender);
Action := caFree;
MenuItem := MenuItemFromChild(Child);
MenuItem.Checked := False;
Settings[RemoveAmpersand(MenuItem.Caption)] := MenuItem.Checked;
Panels.Remove(Child);
end;
end;
EDIT:
What I mean by a "Pinned" Form: A docked form with the pin set such that it always visible.
What I mean by a "UnPinned" Form: A docked form with the pin released such that a tab appears in a dock tab set and the form appears when the tab is selected.
Delphi Version is 2007
it seems that pinning and unpinning a docked form changes it's parent between a TTabDockPanel and the TPanel I'm docking it to.
Adding an OnHide method to the Demo Dock Form...
procedure TfrmDock.FormHide(Sender: TObject);
begin
if Assigned(Self.Parent) then
ShowMessage(Self.Parent.ClassName)
else
ShowMessage('No Parent');
end;
I can now distinguish between "Floating", "Docked,Pinned" and "Docked, Unpinned" when the form gets hidden.
EDIT
I've found a better way of doing this
procedure TfrmDock.FormHide(Sender: TObject);
begin
if Assigned(Parent) then
begin
if Not (csDocking in ControlState) then //This was the original test above
begin
if Parent is TTabDockPanel then // This is now a safety check
begin
if TTabDockPanel(Parent).AnimateSpeed = 1 then //Additional Test
//form is closing
else
//form is hiding (Unpinned focused changed)
end;
end
else
//form is being unpinned.
end;
end;
In DockCaptionMouseUp the Animation Speed is set to 1 so that the panel appears to close (Hides really fast). The same happens for "Unpinning" but control state changes.
So I have a TMenuItem attached to a TAction on a TPopupMenu for a TDBGrid (actually 3rd party, but you get the idea). Based on the selected row in the grid, the TAction is enabled or disabled. What I want is to be able to display a hint to the user explaining why the item is disabled.
As far as why I want a hint on a disabled menu item, lets just say I am in agreement with Joel.
All TMenuItem's have a hint property, but as best I can tell they are only used the the TApplicationEvent.OnHint event handler to stick the hint in a TStatusBar or some other special processing. I found an article on how to create your own even window for a TMainMenu's TMenuItems, but it doesn't work on a TPopupMenu's TMenuItem. It works by handling the WM_MENUSELECT message, which as far as I can tell is not sent on a TPopupMenu.
WM_MENUSELECT is indeed handled for menu items in popup menus also, but not by the windows proc of the form containing the (popup) menu, but by an invisible helper window created by Menus.PopupList. Luckily you can (at least under Delphi 5) get at this HWND via Menus.PopupList.Window.
Now you can use the old-fashioned way to subclass a window, as described for example in this CodeGear article, to handle WM_MENUSELECT also for popup menus. The HWND will be valid from after the first TPopupMenu is created to before the last TPopupMenu object is destroyed.
A quick test with the demo app in the linked article in the question should reveal whether this is going to work.
Edit: It does indeed work. I changed the linked example to show hints also for the popup menu. Here are the steps:
Add a handler for OnDestroy, a member variable for the old window proc and a method for the new window proc to the form:
TForm1 = class(TForm)
...
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure ApplicationEvents1Hint(Sender: TObject);
private
miHint : TMenuItemHint;
fOldWndProc: TFarProc;
procedure WMMenuSelect(var Msg: TWMMenuSelect); message WM_MENUSELECT;
procedure PopupListWndProc(var AMsg: TMessage);
end;
Change the OnCreate handler of the form to subclass the hidden PopupList window, and implement the proper restoration of the window proc in the OnDestroy handler:
procedure TForm1.FormCreate(Sender: TObject);
var
NewWndProc: TFarProc;
begin
miHint := TMenuItemHint.Create(self);
NewWndProc := MakeObjectInstance(PopupListWndProc);
fOldWndProc := TFarProc(SetWindowLong(Menus.PopupList.Window, GWL_WNDPROC,
integer(NewWndProc)));
end;
procedure TForm1.FormDestroy(Sender: TObject);
var
NewWndProc: TFarProc;
begin
NewWndProc := TFarProc(SetWindowLong(Menus.PopupList.Window, GWL_WNDPROC,
integer(fOldWndProc)));
FreeObjectInstance(NewWndProc);
end;
Implement the subclassed window proc:
procedure TForm1.PopupListWndProc(var AMsg: TMessage);
function FindItemForCommand(APopupMenu: TPopupMenu;
const AMenuMsg: TWMMenuSelect): TMenuItem;
var
SubMenu: HMENU;
begin
Assert(APopupMenu <> nil);
// menuitem
Result := APopupMenu.FindItem(AMenuMsg.IDItem, fkCommand);
if Result = nil then begin
// submenu
SubMenu := GetSubMenu(AMenuMsg.Menu, AMenuMsg.IDItem);
if SubMenu <> 0 then
Result := APopupMenu.FindItem(SubMenu, fkHandle);
end;
end;
var
Msg: TWMMenuSelect;
menuItem: TMenuItem;
MenuIndex: integer;
begin
AMsg.Result := CallWindowProc(fOldWndProc, Menus.PopupList.Window,
AMsg.Msg, AMsg.WParam, AMsg.LParam);
if AMsg.Msg = WM_MENUSELECT then begin
menuItem := nil;
Msg := TWMMenuSelect(AMsg);
if (Msg.MenuFlag <> $FFFF) or (Msg.IDItem <> 0) then begin
for MenuIndex := 0 to PopupList.Count - 1 do begin
menuItem := FindItemForCommand(PopupList.Items[MenuIndex], Msg);
if menuItem <> nil then
break;
end;
end;
miHint.DoActivateHint(menuItem);
end;
end;
This is done for all popup menus in a loop, until the first matching item or submenu is found.
Not sure if it helps, but I have created my own multi-line hint window (for Delphi7) to be able to show more then just one line of text.
It's open source and you can find it here.
There is some work involved showing it on the right location on the screen, but you have full control over it.