In a 32-bit Delphi 11 VCL Application on Windows 10, when RIGHT-CLICKING any menu item, I need to get the name of the clicked MenuItem.
I use a TApplicationEvents component and this code to get notified when I click on any menu item:
procedure TformMain.ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean);
begin
case Msg.message of
Winapi.Messages.WM_COMMAND:
begin
CodeSite.Send('TformMain.ApplicationEvents1Message: WM_COMMAND');
end;
end;
end;
However:
How to get notified only when RIGHT-clicking the menu item?
How to get the NAME of the clicked MenuItem?
Each TMenu (i.e. TMainMenu or TPopupMenu) offers a method FindItem, which allows you to find an item by varying criteria. In your case the correct call for the form's main menu would be
TheMenuItem := Menu.FindItem(Msg.wParam, fkCommand);
Since I have several forms in my application and several (popup) menus on each of these forms, a special solution is needed here:
procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean);
begin
case Msg.message of
Winapi.Messages.WM_COMMAND:
begin
// Todo: Check HERE for RightMouseButtonDown - BUT HOW? (Or how to check HERE for modifier keys?)
var ThisMenuItem := GetMenuItem(Msg.wParam);
if Assigned(ThisMenuItem) then
begin
CodeSite.Send('TForm1.ApplicationEvents1Message: Clicked MenuItem Name', ThisMenuItem.Name);
end;
end;
end;
end;
function TForm1.GetMenuItem(const aWParam: NativeUInt): TMenuItem;
var
ThisMenuItem: TMenuItem;
begin
Result := nil;
var ThisForm := Screen.ActiveForm; // works on any form in the application
for var i := 0 to ThisForm.ComponentCount - 1 do
begin
if ThisForm.Components[i] is TMenu then
begin
ThisMenuItem := TMenu(ThisForm.Components[i]).FindItem(aWParam, fkCommand);
if Assigned(ThisMenuItem) then
begin
Result := ThisMenuItem;
EXIT;
end;
end;
end;
end;
Related
i have an application with 2 TButton, 1 TListView. I would like display the value or content(Text) of TListViewItem inside the TButton(s) in a way that the content of the first TButton can't be the same with the 2nd one.
Steps =>>
When I click on the 1st TButton, I can select the Item text in the TListView and save it as new TButton text.
When I click on the 2nd TButton, I can select another item text in the same TListView, and it is saved as Text in the 2nd TButton.
My code:
....
ListView1: TListView;
Base: TButton;
Hypo: TButton;
....
procedure TMainForm.BaseClick(Sender: TObject);
begin
ListView1.Visible := True;
end;
procedure TMainForm.HypoClick(Sender: TObject);
begin
ListView1.Visible := True;
end;
procedure TMainForm.ListView1ItemClick(const Sender: TObject;
const AItem: TListViewItem);
begin
if Assigned(ListView1.Selected) and Assigned(Base.OnClick) then
begin
Base.Text := TListViewItem(ListView1.Selected).Text;
end else
if Assigned(ListView1.Selected) and Assigned(Hypo.OnClick) then
begin
Hypo.Text := TListViewItem(ListView1.Selected).Text;
end;
ListView1.Visible := False;
end;
I used LiveBindings to fill the TListView; when i run the app and select one item it works but it's displaying the same value/content in both TLabels
If you really have 2 selected items, then you have to iterate through the whole list view
procedure TForm3.ListView1ItemClick(const Sender: TObject;
const AItem: TListViewItem);
var elvitem : TListViewItem;
i,n : integer;
begin
n:=0;
for i:=0 to ListView1.ItemCount-1 do
begin
if ListView1.Items[i].Purpose=TListItemPurpose.None then // it's an item
begin
if ListView1.Items[i].Checked then
begin
inc(n);
case n of
1 : base.text:=ListView1.Items[i].Text;
2 : begin
hypo.text:=ListView1.Items[i].Text;
break; // don't search more
end;
end;
end;
end;
end;
Here item 2 and 8 are selected with this code
procedure TForm3.FormCreate(Sender: TObject);
begin
Listview1.Items[2].Checked:=True;
Listview1.Items[8].Checked:=True;
end;
My first reaction, if your listview is livebinded then why don't you use livebindings to link your 2 labels ?
Second one is your code, you use Selected when you have the AItem parameter
so
procedure TMainForm.ListView1ItemClick(const Sender: TObject;
const AItem: TListViewItem);
begin
Base.Text:= AItem.text;
Hypo.Text:= AItem.detail;
ListView1.Visible := False;
end;
should be sufficient if it is not a DynamicAppearance type.
I use a custom listview component and I need it to have a popupmenu item "copy data to clipboard". If there is no assigned popup, I create one and add the menuitem, if there is already a menu assigned, add the item to the current popup. Tried to put the code in the constructor, but then I realized, that popupmenu is still not created or associated to my listview. So any idea when to create my default item?
constructor TMyListView.Create(AOwner: TComponent);
var
FpopupMenu: TPopupMenu;
begin
inherited;
.....
FPopUpMenuItem := TMenuItem.Create(self);
FPopUpMenuItem.Caption := 'Copy data to clipboard';
FPopUpMenuItem.OnClick := PopupMenuItemClick;
if assigned(PopupMenu) then begin
popupMenu.Items.Add(FPopUpMenuItem);
end
else begin
FpopupMenu := TPopupMenu.Create(self);
FpopupMenu.Items.Add(FPopUpMenuItem);
PopupMenu := FpopupMenu;
end;
...
end;
Override the virtual TControl.DoContextPopup() method, eg:
type
TMyListView = class(TListView)
protected
...
procedure DoContextPopup(MousePos: TPoint; var Handled: Boolean); override;
...
end;
procedure TMyListView.DoContextPopup(MousePos: TPoint; var Handled: Boolean);
var
LPopupMenu: TPopupMenu;
LItem: TMenuItem;
function IsSameEvent(const E1, E2: TNotifyEvent): Boolean;
begin
Result := (TMethod(E1).Code = TMethod(E2).Code) and
(TMethod(E1).Data = TMethod(E2).Data);
end;
begin
inherited DoContextPopup(MousePos, Handled);
if Handled then Exit;
LPopupMenu := PopupMenu;
if not Assigned(LPopupMenu) then
begin
LPopupMenu := TPopupMenu.Create(Self);
PopupMenu := LPopupMenu;
end;
for I := 0 to LPopupMenu.Items.Count-1 do
begin
LItem := LPopupMenu.Items[I];
if IsSameEvent(LItem.OnClick, PopupMenuItemClick) then
Exit;
end;
LItem := TMenuItem.Create(Self);
LItem.Caption := 'Copy data to clipboard';
LItem.OnClick := PopupMenuItemClick;
LPopupMenu.Items.Add(LItem);
end;
The accepted answer indeed works perfectly - unless you add keyboard shortcuts to your menu item. If you do, these won't work before the popup menu has been accessed in some other way, because the items will not have been created.
If you need shortcuts, it may therefore be preferable to move the code from DoContextPopup to Loaded. Most simply,
procedure Loaded; override;
...
procedure Loaded;
var
MI: TMenuItem;
ItemCovered: boolean;
i: integer;
begin
inherited;
if not Assigned(PopupMenu) then
PopupMenu:=TPopupMenu.Create(self);
ItemCovered:=false;
for i := 0 to PopupMenu.Items.Count-1 do
if IsSameEvent(PopupMenu.Items[I].OnClick, CopyDataToClipboardClick) then begin
ItemCovered:=true;
break;
end;
if not ItemCovered then begin
MI:=TMenuItem.Create(PopupMenu);
MI.Caption:='Copy data to clipboard';
MI.OnClick:=CopyDataToClipboardClick;
MI.ShortCut:=ShortCut(Ord('C'),[ssShift,ssCtrl]);
PopupMenu.Items.Add(MI);
end;
end;
This won't check for popup menus added on runtime, but probably serve most cases better.
I have a TListview where I want to use the checkboxes to indicate whether an event has happened to an item in the list.
I can read and set the checkbox status, but what I really want to do is disable the ability of the user to change the status using a mouse click.
For a TCheckList I can set the checked state to the inverse using OnClickCheck
The same doesn't work for a TListview. At them moment I can see that the checkbox has been targeted in OnMouseDown but can't disable the click from going through..
procedure TMF.ListViewMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
MyHitTest : THitTests;
begin
MyHitTest := (Sender as TListView).GetHitTestInfoAt(X,Y);
if htOnStateIcon in MyHitTest then
(Sender as TListView).OnMouseDown := nil;
end;
Suggestions?
Use the event Onchanging and set AllowChange to False.
procedure TForm1.ListView1Changing(Sender: TObject; Item: TListItem;
Change: TItemChange; var AllowChange: Boolean);
begin
AllowChange := False;
end;
Update: OP want the user to be able to select the item. So, maybe, a little hack using OnItemChecked event can do.
procedure TForm1.ListView1ItemChecked(Sender: TObject; Item: TListItem);
begin
if TComponent(Sender).Tag = 0 then
begin
TComponent(Sender).Tag := 1;
Item.Checked := not Item.Checked;
TComponent(Sender).Tag := 0;
end;
end;
Update2: The problem using this trick is that you must disable it before you change any item status. For example:
Procedure LoadListViewItems;
begin
//Let's permit modification in ListView Items.
ListView1.OnItemChecked := nil;
try
//put Load Items code Here!
finally
//User cannot change Items statuses
ListView1.OnItemChecked := ListView1ItemChecked;
end;
end;
You could hook the window proc to force the item checked state before any VCL event handling takes place:
TForm1 = class(TForm)
...
private
fLVWndProc: TWndProc;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
// Save the original window proc and install the hook
fLVWndProc := Listview1.WindowProc;
Listview1.WindowProc := LVWndProcHook;
end;
procedure TForm1.LVWndProcHook(var aMessage: TMessage) ;
var
notify: PNMListView;
bItemState: Boolean;
begin
if (aMessage.Msg = CN_NOTIFY)
and (PNMHdr(aMessage.LParam).Code = LVN_ITEMCHANGED) then
begin
notify := PNMListView(aMessage.LParam);
if ((notify.uChanged and LVIF_STATE) <> 0) then
begin
// Determine actual item state and re-apply it before continuing
bItemState := GetUnderlyingItemState(notify.iItem);
ListView_SetCheckState(notify.hdr.hwndFrom, notify.iItem, bItemState);
end;
end;
//original ListView message handling
fLVWndProc(aMessage) ;
end;
Or you can do like this:
procedure TForm1.ListItemChecked(Sender: TObject; Item: TListItem);
begin
if not CheckBoxesEnabled then begin
List.OnItemChecked:=nil;
Item.Checked:=not Item.Checked;
List.OnItemChecked:=ListItemChecked;
end;
end;
List is your TListView, and CheckBoxesEnabled a boolean variable that enable or disable the checkboxes.
There are TPopupMenu and three buttons on the form named "AddButton", "EditButton", and "DestroyButton" and added OnClick events to all three buttons. The TPopupMenu in the PopupMenu property of the form. I have created the PopupMenuItemsClick procedure in the TForm1 type declaration so that it can be used as the method call for the menu item OnClick event.
type
TForm1 = class(TForm)
AddButton: TButton;
EditButton: TButton;
DestroyButton: TButton;
PopupMenu1: TPopupMenu;
procedure AddButtonClick(Sender: TObject);
procedure EditButtonClick(Sender: TObject);
procedure DestroyButtonClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
procedure PopupMenuItemsClick(Sender: TObject);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.AddButtonClick(Sender: TObject);
var
index: Integer;
NewItem: TMenuItem;
begin
// The owner (PopupMenu1) will clean up this menu item.
NewItem := TMenuItem.Create(PopupMenu1); // Create the new item.
index := PopupMenu1.Items.Count;
PopupMenu1.Items.Add(NewItem);// Add it to the pop-up menu.
NewItem.Caption := 'Menu Item ' + IntToStr(index);
NewItem.Tag := index;
NewItem.OnClick :=
PopupMenuItemsClick; // Assign it an event handler.
end;
procedure TForm1.PopupMenuItemsClick(Sender: TObject);
begin
with Sender as TMenuItem do
begin
case Tag of
0: ShowMessage('first item clicked');
1: ShowMessage('second item clicked');
2: ShowMessage('third item clicked');
3: ShowMessage('fourth item clicked');
end;
end;
end;
{
To edit or destroy an item, grab its pointer
using the Items property.
procedure TForm1.EditButtonClick(Sender: TObject);
var
ItemToEdit: TMenuItem;
begin
ItemToEdit := PopupMenu.Items[1];
ItemToEdit.Caption := 'Changed Caption';
end;
procedure TForm1.DestroyButtonClick(Sender: TObject);
var
ItemToDelete: TMenuItem;
begin
ItemToDelete := PopupMenu.Items[2];
ItemToDelete.Free;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
index: Integer;
NewItem: TMenuItem;
begin
for index := 0 to 3 do
begin
// The owner (PopupMenu1) will clean up this menu item.
NewItem := TMenuItem.Create(PopupMenu1); // Create the new item.
PopupMenu1.Items.Add(NewItem);// Add it to the pop-up menu.
NewItem.Caption := 'Menu Item ' + IntToStr(index);
NewItem.Tag := index;
NewItem.OnClick :=
PopupMenuItemsClick; // Assign it an event handler.
end;
end;
But PopupMenu is not appearing when I clicked on addmenu button. Anyone can find what is the reason why Popupmenu is not appearing when form is loaded or any button clicked.
your code not what you really need
use this code and it will work perfectly
procedure TForm1.PopupMenuItemsClick(Sender: TObject);
var ICount : Integer;
begin
ICount := TMenuItem(Sender).MenuIndex;
ShowMessage('Item Number '+ IntToStr(ICount+1) + ' Selected');
end;
procedure TForm1.AddClick(Sender: TObject);
var
Index: Integer;
NewItem: TMenuItem;
begin
NewItem := TMenuItem.Create(PopupMenu);
Index := PopupMenu.Items.Count;
PopupMenu.Items.Add(NewItem);
NewItem.Caption := 'Menu Item ' + IntToStr(Index);
NewItem.Tag := Index;
NewItem.OnClick := PopupMenuItemsClick;
PopupMenu.Popup(Mouse.CursorPos.X, Mouse.CursorPos.Y);
end;
I tested it with Delphi7, XE2 and XE3 its working
Add this line in the FormCreate or set this property in Object Inspector.
self.PopupMenu:=PopupMenu1;
This comments may help to solve the problem (i was having similar in old Delphi versions, i do not have XE to test on).
Never, ever create a component and let empty its .Name, allways
assign it a unique value (i see a lot of faulty interna code when let empty, since they can not be empty).
And allways assign properties and events to the componet prior to add
them onto their parent.
See this suggestions in the comments:
procedure TForm1.AddClick(Sender: TObject);
var
Index: Integer;
NewItem: TMenuItem;
begin
NewItem := TMenuItem.Create(PopupMenu);
Index := PopupMenu.Items.Count;
//PopupMenu.Items.Add(NewItem); // Not the correct place, see below
NewItem.Name : = 'SomeText' + IntToStr(Index); // Name them, with a unique name not starting with a number (also there is no need to put a number)
NewItem.Caption := 'Menu Item ' + IntToStr(Index);
NewItem.Tag := Index;
NewItem.OnClick := PopupMenuItemsClick;
PopupMenu.Items.Add(NewItem); // After properties has been set, never before
PopupMenu.Popup(Mouse.CursorPos.X, Mouse.CursorPos.Y);
// Do not forget to free such menu item somewhere on your code, obviously not here
end;
And with menus, remember to free the items created, they do not free by them selfs and names will be in use next time.
We have a combo box with more than 100 items.
We want to filter out the items as we enter characters in combo box. For example if we entered 'ac' and click on the drop down option then we want it to display items starting with 'ac' only.
How can I do this?
Maybe you'd be happier using the autocompletion features built in to the OS. I gave an outline of how to do that here previously. Create an IAutoComplete object, hook it up to your combo box's list and edit control, and the OS will display a drop-down list of potential matches automatically as the user types. You won't need to adjust the combo box's list yourself.
To expand on Rob's answer about using the OnChange event, here is an example of how to do what he suggests.
procedure TForm1.FormCreate(Sender: TObject);
begin
FComboStrings := TStringList.Create;
FComboStrings.Add('Altair');
FComboStrings.Add('Alhambra');
FComboStrings.Add('Sinclair');
FComboStrings.Add('Sirius');
FComboStrings.Add('Bernard');
FComboStrings.Sorted := True;
ComboBox1.AutoComplete := False;
ComboBox1.Items.Text := FComboStrings.Text;
ComboBox1.Sorted := True;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FreeAndNil(FComboStrings);
end;
procedure TForm1.ComboBox1Change(Sender: TObject);
var
Filter: string;
i: Integer;
idx: Integer;
begin
// Dropping down the list puts the text of the first item in the edit, this restores it
Filter := ComboBox1.Text;
ComboBox1.DroppedDown := True;
ComboBox1.Text := Filter;
ComboBox1.SelStart := Length(Filter);
for i := 0 to FComboStrings.Count - 1 do
if SameText(LeftStr(FComboStrings[i], Length(ComboBox1.Text)), ComboBox1.Text) then
begin
if ComboBox1.Items.IndexOf(FComboStrings[i]) < 0 then
ComboBox1.Items.Add(FComboStrings[i]);
end
else
begin
idx := ComboBox1.Items.IndexOf(FComboStrings[i]);
if idx >= 0 then
ComboBox1.Items.Delete(idx);
end;
end;
My brief contribution working with objects in the combobox:
procedure FilterComboBox(Combo: TComboBox; DefaultItems: TStrings);
function Origin: TStrings;
begin
if Combo.Tag = 0 then
begin
Combo.Sorted := True;
Result := TStrings.Create;
Result := Combo.Items;
Combo.Tag := Integer(Result);
end
else
Result := TStrings(Combo.Tag);
end;
var
Filter: TStrings;
I: Integer;
iSelIni: Integer;
begin
if(Combo.Text <> EmptyStr) then
begin
iSelIni:= Length(Combo.Text);
Filter := TStringList.Create;
try
for I := 0 to Origin.Count - 1 do
if AnsiContainsText(Origin[I], Combo.Text) then
Filter.AddObject(Origin[I], TObject(Origin.Objects[I]));
Combo.Items.Assign(Filter);
Combo.DroppedDown:= True;
Combo.SelStart := iSelIni;
Combo.SelLength := Length(Combo.Text);
finally
Filter.Free;
end;
end
else
Combo.Items.Assign(DefaultItems);
end;
You can handle the combo box's OnChange event. Keep a master list of all items separate from the UI control, and whenever the combo box's edit control changes, adjust the combo box's list accordingly. Remove items that don't match the current text, or re-add items from the master list that you removed previously.
As Rob already answered, you could filter on the OnChange event, see the following code example. It works for multiple ComboBoxes.
{uses}
Contnrs, StrUtils;
type
TForm1 = class(TForm)
ComboBox1: TComboBox;
ComboBox2: TComboBox;
procedure FormCreate(Sender: TObject);
procedure ComboBoxChange(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
FComboLists: TList;
procedure FilterComboBox(Combo: TComboBox);
end;
implementation
{$R *.dfm}
procedure TForm1.ComboBoxChange(Sender: TObject);
begin
if Sender is TComboBox then
FilterComboBox(TComboBox(Sender));
end;
procedure TForm1.FilterComboBox(Combo: TComboBox);
function Origin: TStrings;
begin
if Combo.Tag = 0 then
begin
Combo.Sorted := True;
Result := TStringList.Create;
Result.Assign(Combo.Items);
FComboLists.Add(Result);
Combo.Tag := Integer(Result);
end
else
Result := TStrings(Combo.Tag);
end;
var
Filter: TStrings;
I: Integer;
begin
Filter := TStringList.Create;
try
for I := 0 to Origin.Count - 1 do
if AnsiStartsText(Combo.Text, Origin[I]) then
Filter.Add(Origin[I]);
Combo.Items.Assign(Filter);
Combo.SelStart := Length(Combo.Text);
finally
Filter.Free;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FComboLists := TObjectList.Create(True);
// For Each ComboBox, set AutoComplete at design time to false:
ComboBox1.AutoComplete := False;
ComboBox2.AutoComplete := False;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FComboLists.Free;
end;