我已将 TPopupMenu
添加到 TControlList
,右键单击时 ItemIndex 不会更新以反射(reflect)单击的项目。有没有办法让右键单击以与左键单击类似的方式响应?
这很好,这样用户右键单击特定项目,PopupMenu 与该项目关联,而不是当前聚焦的项目。
最佳答案
您可以使用 OnPopupMenu 事件中的 HotItemIndex 属性并将其保存到变量中。然后对于弹出菜单项事件,您可以使用它。
示例代码:
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Menus, Vcl.ControlList, Vcl.StdCtrls;
type
TForm1 = class(TForm)
ControlList1: TControlList;
PopupMenu1: TPopupMenu;
TestPopupMnu: TMenuItem;
Label1: TLabel;
Memo1: TMemo;
procedure ControlList1BeforeDrawItem(AIndex: Integer; ACanvas: TCanvas; ARect:
TRect; AState: TOwnerDrawState);
procedure ControlList1Click(Sender: TObject);
procedure TestPopupMnuClick(Sender: TObject);
procedure PopupMenu1Popup(Sender: TObject);
private
FPopupItemIndex : Integer;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.ControlList1BeforeDrawItem(AIndex: Integer; ACanvas: TCanvas;
ARect: TRect; AState: TOwnerDrawState);
begin
Label1.Caption := AIndex.ToString;
end;
procedure TForm1.ControlList1Click(Sender: TObject);
begin
Memo1.Lines.Add('Clicked item ' + ControlList1.ItemIndex.ToString);
end;
procedure TForm1.TestPopupMnuClick(Sender: TObject);
begin
Memo1.Lines.Add('Test PopupMenu item ' + FPopupItemIndex.ToString);
end;
procedure TForm1.PopupMenu1Popup(Sender: TObject);
begin
FPopupItemIndex := ControlList1.HotItemIndex;
end;
end.
表单本身:
object Form1: TForm1
Left = 0
Top = 0
Caption = 'Form1'
ClientHeight = 299
ClientWidth = 635
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object ControlList1: TControlList
Left = 24
Top = 20
Width = 317
Height = 200
ItemCount = 5
ItemMargins.Left = 0
ItemMargins.Top = 0
ItemMargins.Right = 0
ItemMargins.Bottom = 0
ParentColor = False
PopupMenu = PopupMenu1
TabOrder = 0
OnBeforeDrawItem = ControlList1BeforeDrawItem
OnClick = ControlList1Click
object Label1: TLabel
Left = 92
Top = 20
Width = 31
Height = 13
Caption = 'Label1'
end
end
object Memo1: TMemo
Left = 368
Top = 24
Width = 241
Height = 201
Lines.Strings = (
'Memo1')
TabOrder = 1
end
object PopupMenu1: TPopupMenu
OnPopup = PopupMenu1Popup
Left = 436
Top = 128
object TestPopupMnu: TMenuItem
Caption = 'Test'
OnClick = TestPopupMnuClick
end
end
end
关于delphi - 右键单击不会更新 TControlList 中的 ItemIndex,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/66863625/