IN TMS string grid I used to use this to paste the caption of the popup menu into the grid's cell :
var
s:string;
begin
s:=(Sender as TmenuItem).Caption;
s:=stringReplace(s,'&','',[rfReplaceAll]);
with AdvStringGrid1 do
Cells[Col,Row]:=s;
I never used this before in a cxGrid so I am totally new to this. I have linked cxGridpopUpMenu1 to my grid,added a classic PopUpMenu so it gets used by the cxGridpopUpMenu1,added some items in the popup menu and thats it. popup menu fires on right click in the grid ok, but how do you paste the value of the menuitem into the cell??
+ Is there a way to assign popopmenu to a particular column ?
I'd do it like this:
procedure TForm1.MenuItem1Click(Sender: TObject);
var
s: string;
begin
Assert(Sender is TMenuItem);
s := StripHotKey(TMenuItem(Sender).Caption);
cxGrid1TableView1.DataController.Edit;
cxGrid1TableView1.Controller.FocusedColumn.EditValue := s;
end;
This can be done combining two event handlers:
The OnPopUp handler of your TcxGridPopupMenu.
An OnClick handler for all your popup menu items.
The idea is to use the OnPopup to store a reference to the item (column) and record clicked, while the OnClick would apply the value to the cell.
Code is as following:
//in private section of your form
fItem: TcxCustomGridTableItem;
fRec: TcxCustomGridRecord;
procedure TForm1.cxGridPopupMenu1Popup(ASenderMenu: TComponent;
AHitTest: TcxCustomGridHitTest; X, Y: Integer; var AllowPopup: Boolean);
begin
if AHitTest is TcxGridRecordCellHitTest then
begin
fItem := TcxGridRecordCellHitTest(AHitTest).Item;
fRec := TcxGridRecordCellHitTest(AHitTest).GridRecord;
end;
end;
procedure TForm1.MenuItem1Click(Sender: TObject);
var
s : string;
begin
s := (sender as tmenuItem).Caption;
gridView.DataController.Values[frec.Index, fitem.Index] := StripHotKey(s);
end;
As #DavidHeffernan suggested, notice the use of StripHotKey that removes the accelerator character mark from the menu caption.
Related
I have a program with n ComboBoxes and n Labels and I want to update the corresponding Label depending on the selection from the adjacent ComboBox i.e ComboBox2 would update Label2.
I am using the same event handler for every ComboBox and currently checking if Combobox1 or Combobox2 has fired the event handler. Is there a way to use the ItemIndex of the ComboBox passed to the procedure, such as Sender.ItemIndex? This is not currently an option and gives the error 'TObject' does not contain a member named 'ItemIndex'.
procedure TForm2.ComboBoxChange(Sender: TObject);
begin
if Sender = ComboBox1 then
Label1.Caption := ComboBox1.Items.Strings[ComboBox1.ItemIndex]
else
Label2.Caption := ComboBox2.Items.Strings[ComboBox2.ItemIndex];
end;
This code has the desired behavior but is obviously not scale-able.
Every component has a Tag property inherited from TComponent, where the Tag is a pointer-sized integer. As such, you can store each TLabel pointer directly in the corresponding TComboBox.Tag, eg:
procedure TForm2.FormCreate(Sender: TObject);
begin
ComboBox1.Tag := NativeInt(Label1);
ComboBox2.Tag := NativeInt(Label2);
end;
This way, ComboBoxChange() can then directly access the TLabel of the changed TComboBox, eg:
procedure TForm2.ComboBoxChange(Sender: TObject);
var
CB: TComboBox;
begin
CB := TComboBox(Sender);
if CB.Tag <> 0 then
TLabel(CB.Tag).Caption := CB.Items.Strings[CB.ItemIndex];
end;
Option 1
This is the most robust one.
Let your form have private members
private
FControlPairs: TArray<TPair<TComboBox, TLabel>>;
procedure InitControlPairs;
and call InitControlPairs when the form is created (either in its constructor, or in its OnCreate handler):
procedure TForm1.InitControlPairs;
begin
FControlPairs :=
[
TPair<TComboBox, TLabel>.Create(ComboBox1, Label1),
TPair<TComboBox, TLabel>.Create(ComboBox2, Label2),
TPair<TComboBox, TLabel>.Create(ComboBox3, Label3)
]
end;
You need to add the controls to this array manually. That's the downside of this approach. But you only need to do this once, right here. Then everything else can be done automagically.
Now, this is where it gets really nice: Let all your comboboxes share this OnChange handler:
procedure TForm1.ComboBoxChanged(Sender: TObject);
var
i: Integer;
begin
for i := 0 to High(FControlPairs) do
if FControlPairs[i].Key = Sender then
FControlPairs[i].Value.Caption := FControlPairs[i].Key.Text;
end;
Option 2
Forget about any private fields. Now instead make sure that each pair has a unique Tag. So the first combo box and label both have Tag = 1, the second pair has Tag = 2, and so on. Then you can do simply
procedure TForm1.ComboBoxChanged(Sender: TObject);
var
TargetTag: Integer;
CB: TComboBox;
i: Integer;
begin
if Sender is TComboBox then
begin
CB := TComboBox(Sender);
TargetTag := CB.Tag;
for i := 0 to ControlCount - 1 do
if (Controls[i].Tag = TargetTag) and (Controls[i] is TLabel) then
begin
TLabel(Controls[i]).Caption := CB.Text;
Break;
end;
end;
end;
as the shared combo-box event handler. The downside here is that you must be sure that you control the Tag properties of all your controls on the form (at least with the same parent as your labels). Also, they must all have the same parent control.
I'm trying to simply create a popup menu (or context menu), add some items to it, and show it at the mouse location. All the examples I have found are doing this using the designer. I'm doing this from a DLL plugin, so there is no form/designer. The user will click a button from the main application which calls the execute procedure below. I just want something similar to a right click menu to appear.
My code obviously doesn't work, but I was hoping for an example of creating a popup menu during runtime instead of design time.
procedure TPlugIn.Execute(AParameters : WideString);
var
pnt: TPoint;
PopupMenu1: TPopupMenu;
PopupMenuItem : TMenuItem;
begin
GetCursorPos(pnt);
PopupMenuItem.Caption := 'MenuItem1';
PopupMenu1.Items.Add(PopupMenuItem);
PopupMenuItem.Caption := 'MenuItem2';
PopupMenu1.Items.Add(PopupMenuItem);
PopupMenu1.Popup(pnt.X, pnt.Y);
end;
You have to actually create instances of a class in Delphi before you can use them. The following code creates a popup menu, adds a few items to it (including an event handler for the click), and assigns it to the form. Note that you have to declare (and write) the HandlePopupItemClick event yourself like I've done).
In the interface section (add Menus to the uses clause):
type
TForm1 = class(TForm)
// Double-click the OnCreate in the Object Inspector Events tab.
// It will add this item.
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
// Add the next two lines yourself, then use Ctrl+C to
// generate the empty HandlePopupItem handler
FPopup: TPopupMenu;
procedure HandlePopupItem(Sender: TObject);
public
{ Public declarations }
end;
implementation
// The Object Inspector will generate the basic code for this; add the
// parts it doesn't add for you.
procedure TForm1.FormCreate(Sender: TObject);
var
Item: TMenuItem;
i: Integer;
begin
FPopup := TPopupMenu.Create(Self);
FPopup.AutoHotkeys := maManual;
for i := 0 to 5 do
begin
Item := TMenuItem.Create(FPopup);
Item.Caption := 'Item ' + IntToStr(i);
Item.OnClick := HandlePopupItem;
FPopup.Items.Add(Item);
end;
Self.PopupMenu := FPopup;
end;
// The Ctrl+C I described will generate the basic code for this;
// add the line between begin and end that it doesn't.
procedure TForm1.HandlePopupItem(Sender: TObject);
begin
ShowMessage(TMenuItem(Sender).Caption);
end;
Now I'll leave it to you to figure out how to do the rest (create and show it at a specific position).
I have a ListView with ViewStyle = vsReport and two popup menus:
Column popup menu, which I want to open when user right-clicking the header bar
Item popup menu, must open when the user right-clicking any list item/subitem or whitespace below items.
What is the most correct way to show that menus? Which events should I handle?
The problem is when I set ListView.PopupMenu property, the popup menu appearing after right-clicking any point in ListView's client rectangle.
When I handle ListView.OnColumnRightClick event, if fires only after clicking on column header, excluding free space of the header bar (on the right of columns).
Event LisView.OnMouseUp fires only after right-clicking on whitespace below items.
You don't have to use the PopupMenu property of the listview, leave it unset and you can attach a handler to OnContextPopup event and launch whatever popup menu you'd like depending on the position. Example:
procedure TForm1.ListViewContextPopup(Sender: TObject; MousePos: TPoint;
var Handled: Boolean);
var
HeaderRect: TRect;
Pos: TPoint;
begin
GetWindowRect(ListView_GetHeader(ListView.Handle), HeaderRect);
Pos := ListView.ClientToScreen(MousePos);
if PtInRect(HeaderRect, Pos) then
PopupMenuColumns.Popup(Pos.X, Pos.Y)
else
PopupMenuItems.Popup(Pos.X, Pos.Y);
end;
You can simplify it considerably. Create your two popup menus (one each for the header row and the columns. Assign the TListView.PopupMenu the column popup menu in the IDE.
Use this for the event handler for the ListView:
procedure TForm1.ListView1ContextPopup(Sender: TObject; MousePos: TPoint; var Handled: Boolean);
var
HeaderRect: TRect;
HeaderHeight: Integer;
Header: HWnd;
begin
ListView1.PopupMenu := ColumnMenu; // Default to ColumnMenu
Header := ListView_GetHeader(ListView1.Handle);
GetWindowRect(Header, HeaderRect);
HeaderHeight := HeaderRect.Bottom - HeaderRect.Top;
if MousePos.Y < HeaderHeight then
ListView1.PopupMenu := HeaderMenu;
end;
It's slightly different than #Sertac's approach, in not calling ClientToScreen and PtInRect - since we know the point is within the bounds of the ListView, a simple test of the height of the click is sufficient to know if we're in the header or column area. It also ensures that there is always at least one of the popup menus assigned to the ListView at all times.
This is how I solved it, but I don't like this solution. If you have a better one, please write down, I'll accept it as correct.
uses
CommCtrl;
procedure TForm1.FormCreate(Sender: TObject);
begin
ListView.PopupMenu := TPopupMenu.Create(Self);
ListView.PopupMenu.OnPopup := ListViewPopup;
end;
procedure TForm1.ListViewPopup(Sender: TObject);
var
Pos: TPoint;
SrcMenu: TPopupMenu;
I: Integer;
MenuItem: TMenuItem;
Header: HWND;
HeaderRect: TRect;
HeaderHeight: Integer;
begin
// Re-filling ListView's popup menu
ListView.PopupMenu.Items.Clear();
// Getting header height
Header := ListView_GetHeader(ListView.Handle);
GetWindowRect(Header, HeaderRect);
HeaderHeight := HeaderRect.Bottom - HeaderRect.Top;
Pos := ListView.ScreenToClient(ListView.PopupMenu.PopupPoint);
// Clicked on header?
if Pos.Y < HeaderHeight then
SrcMenu := PopupMenuColumns
else
SrcMenu := PopupMenuItems;
// Copying destired menu to ListView.PopupMenu
for I := 0 to SrcMenu.Items.Count - 1 do
begin
MenuItem := TMenuItem.Create(FListViewPopupMenu);
with SrcMenu.Items[I] do
begin
MenuItem.Action := Action;
MenuItem.Caption := Caption;
MenuItem.ShortCut := ShortCut;
MenuItem.Checked := Checked;
MenuItem.Enabled := Enabled;
MenuItem.OnClick := OnClick;
MenuItem.HelpContext := HelpContext;
MenuItem.Name := Name;
MenuItem.ImageIndex := ImageIndex;
end;
ListView.PopupMenu.Items.Add(MenuItem);
end;
ListView.PopupMenu.Images := SrcMenu.Images;
end;
I want to restrict users (based on special condition) to open a tab or not in a page control. ie, the user can click on the tab but it will not be displayed to him. Instead, a message will show to him that "he don't have the access right to see such tab".
On what event I should write the checking code, and what tab property (of TPageControl component) will allow/block user to enter such tab?
In an ideal world you would set AllowChange to False from theOnChanging event to block a page change. However, this does not appear to be viable because I can find no way of discerning, from within OnChanging, which page the user is trying to select.
Even looking at the underlying Windows notification seems to offer little hope. The TCN_SELCHANGING notification identifies the control, but not says nothing about the pages involved, so far as I can tell.
The best I can come up with is to use OnChanging to note the current active page and then do the hard work in OnChange. If the selected page has been changed to something undesirable, then just change it back.
procedure TForm1.PageControl1Changing(Sender: TObject; var AllowChange: Boolean);
begin
FPreviousPageIndex := PageControl1.ActivePageIndex;
end;
procedure TForm1.PageControl1Change(Sender: TObject);
begin
if PageControl1.ActivePageIndex=1 then begin
PageControl1.ActivePageIndex := FPreviousPageIndex;
Beep;
end;
end;
Rather messy I know, but it has the virtue of working!
The OnChanging event does not allow you to determine which tab is being selected, because Windows itself does not report that information. What you can do, however, is subclass the TPageControl.WindowProc property to intercept messages that are sent to the TPageControl before it processes them. Use mouse messages to determine which tab is being clicked on directly (look at the TPageControl.IndexOfTabAt() method), and use keyboard messages to detect left/right arrow presses to determine which tab is adjacent to the active tab (look at the TPageControl.FindNextPage() method).
Use the OnChanging event of the page control.
procedure TForm1.PageControl1Changing(Sender: TObject; var AllowChange: Boolean);
begin
if (self.PageControl1.TabIndex= 1)and
(NotAllowUser = 'SomePerson') then
begin
AllowChange:= False;
ShowMessage('Person not allow for this Tab');
end;
end;
Ok, the PageControle1.TabIndex is the activepageindex and not the one i want to select.
How can i get the clicked Page.
procedure TForm1.PageControl1Changing(Sender: TObject; var AllowChange: Boolean);
var
P: TPoint;
NewTabIndex: Integer;
begin
P := PageControl1.ScreenToClient(Mouse.CursorPos);
NewTabIndex := PageControl1.IndexOfTabAt(P.X, P.y);
if (NewTabIndex= 1) then
begin
AllowChange:= false;
Beep
end;
end;
New Attempt
TMyPageControl = Class(TPageControl)
private
FNewTabSheet: TTabSheet;
FOnMyChanging: TMyTabChangingEvent;
procedure SetOnMyChanging(const Value: TMyTabChangingEvent);
procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
procedure CMDialogKey(var Message: TCMDialogKey); message CM_DIALOGKEY;
protected
function CanChange: Boolean; Override;
public
property OnMyChanging: TMyTabChangingEvent read FOnMyChanging write SetOnMyChanging;
End;
{ TMyPageControl }
function TMyPageControl.CanChange: Boolean;
begin
Result := True;
if Assigned(FOnMyChanging) then FOnMyChanging(Self, FNewTabSheet ,Result);
end;
procedure TMyPageControl.CMDialogKey(var Message: TCMDialogKey);
begin
if (Focused or Windows.IsChild(Handle, Windows.GetFocus)) and
(Message.CharCode = VK_TAB) and (GetKeyState(VK_CONTROL) < 0) then
begin
FNewTabSheet := FindNextPage(ActivePage, GetKeyState(VK_SHIFT) >= 0,True);
SelectNextPage(GetKeyState(VK_SHIFT) >= 0);
Message.Result := 1;
end else
inherited;
end;
procedure TMyPageControl.CNNotify(var Message: TWMNotify);
var
P: TPoint;
NewTabIndex: Integer;
begin
with Message do
case NMHdr.code of
TCN_SELCHANGE:
Change;
TCN_SELCHANGING:
begin
Result := 1;
P := self.ScreenToClient(Mouse.CursorPos);
NewTabIndex := self.IndexOfTabAt(P.X, P.y);
FNewTabSheet:= self.Pages[NewTabIndex];
if CanChange then Result := 0;
end;
end;
end;
procedure TMyPageControl.SetOnMyChanging(const Value: TMyTabChangingEvent);
begin
FOnMyChanging := Value;
end;
You can show tab and effectively disable changing in OnChanging event of TPageControl. All you need to do is set AllowChange var to False.
procedure TForm1.PageControl1(Sender: TObject; var AllowChange: Boolean);
begin
AllowChange := MyCondition;
if MyCondition
ShowMessage('User doesn''t have permission to see this tab.');
end
Sometimes it is better just to hide unwanted TabSheets with something like this:
TabSheetNN.TabVisible:=Somecondition;
than trying to prevent switching to these tabs.
Sure, it would be better if Sender in OnChanging event will be TabSheet , not TPageControl.
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.