1

1、添加弹出菜单命名PopupMenu1

2、添加菜单项命名TestMI

3、添加按钮

和代码：

procedure TForm1.Button1Click(Sender: TObject);
var
  MItems: array of TMenuItem;
  SList: TStringList;
  FileRec: TSearchrec;
  i: integer;
begin

  SList := TStringList.Create;
 //3000+ files 
  if FindFirst('C:\Windows\System32\*', faNormal or faDirectory, FileRec) = 0
    then
    repeat
      if (FileRec.Name = '.') or (FileRec.Name = '..') then
        Continue;

      SList.Add(FileRec.Name);

    until FindNext(FileRec) <> 0;
  FindClose(FileRec);

  if SList.Count > 0 then
  begin
    SetLength(MItems, SList.Count);
    for i := 0 to SList.Count - 1 do
    begin

      MItems[i] := TMenuItem.Create(TestMI);
      MItems[i].Caption := SList[i];

    end;

    TestMI.Add(MItems);

  end;
end;

当我点击按钮时，它是好的，但是当我弹出 PopupMenu1并继续时 TestMI，因为文件太多它没有响应。

有什么办法可以解决吗？

更新：

我必须使用 PopupMenu 来执行此操作。

我找了个程序，能快点，150ms

https://docs.google.com/open?id=0B1sDNMAzGE2oZWpTWlpWNHJGZzQ

它使用BarMenu 组件

但我无法在 Delphi 2009 中编译。错误：

库\栏菜单：

{$IFDEF MSWINDOWS}
  {$IFNDEF DFS_COMPILER_5_UP}
     {$MESSAGE FATAL 'You need Delphi 5 or higher in order to compile this unit.'}
  {$ENDIF}
  Windows, SysUtils, Classes, Graphics, Menus, Forms;
{$ENDIF}

更新到@Sertac Akyuz

在第一种情况下，您的解决方案很有用。非常感谢。我改变了那个案例代码：

unit Unit1;

interface

uses
  Windows,
  Messages,
  SysUtils,
  Variants,
  Classes,
  Graphics,
  Controls,
  Forms,
  Dialogs,
  StdCtrls,
  Menus;

type
  TForm1 = class(TForm)
    Button1: TButton;
    PopupMenu1: TPopupMenu;
    TestMI: TMenuItem;
    procedure Button1Click(Sender: TObject);
    procedure CreMI(MI: TMenuItem);
    procedure IMonClick(Sender: TObject);
    procedure AddSubEmpItem(MI: TMenuItem);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.IMonClick(Sender: TObject);
begin

  CreMI(TMenuItem(Sender));

end;

procedure TForm1.AddSubEmpItem(MI: TMenuItem);
var
  EmpIM: TMenuItem;
begin

  EmpIM := TMenuItem.Create(MI);
  with EmpIM do
  begin
    Caption := '(Folder empty)';
    Enabled := False;
    Hint := '';
    MI.Add(EmpIM);
  end;

end;

procedure TForm1.CreMI(MI: TMenuItem);
var
  MItems: array of TMenuItem;
  SList: TStringList;
  FileRec: TSearchrec;
  i: integer;
begin

  if (MI.Items[0].Caption = '(Folder empty)') and (MI.Count = 1) then
  begin

    SList := TStringList.Create;

    if FindFirst(MI.Hint + '\*', faNormal or faDirectory, FileRec) = 0
      then
      repeat
        if (FileRec.Name = '.') or (FileRec.Name = '..') then
          Continue;

        SList.Add(FileRec.Name);

      until FindNext(FileRec) <> 0;

    FindClose(FileRec);

    if SList.Count > 0 then
    begin

      SetLength(MItems, SList.Count);
      for i := 0 to SList.Count - 1 do
      begin

        MItems[i] := TMenuItem.Create(MI);
        MItems[i].Caption := SList[i];
        MItems[i].Hint := MI.Hint + SList[i] + PathDelim;
        AddSubEmpItem(MItems[i]);
        MItems[i].OnClick := IMonClick;
        MItems[i].AutoHotkeys := maManual;

      end;

      MI.Add(MItems);
      MI.AutoHotkeys := maManual;

    end;
  end;
  //Button1.Caption := IntToStr(MI.Count);

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

  AddSubEmpItem(TestMI);
  CreMI(TestMI);


end;

end.

放TestMI.Hint := C:\

单击按钮，当我继续前进时C:\ -> Windows -> System32 也没有响应。你能给点建议吗？

4

3 回答 3

3

快速测试显示时间花费在InternalRethinkHotkeys. 热键对超过 3000 个项目的菜单没有帮助。只需禁用它：

    ..
    TestMI.Add(MItems);
    TestMI.AutoHotkeys := maManual; // <--

  end;
end;

话虽如此，还可以考虑使用其他一些 gui 元素，如列表框等，滚动菜单中的这么多项目实际上是不可能的。

于 2012-10-29T14:28:51.390 回答
0

首先，假设你真的很聪明，知道创建一个包含一百万个项目的菜单是愚蠢的，所以让我们借此机会讨论技术问题，因为正如所有评论者所说，你的想法不是可行，但也许在您的实际程序中，您将仅在计算机上的文件夹中构建一个 word 文档列表，因此您选择 Windows 文件夹只是为了说明。那么让我们继续：

一个刚入门的 Delphi 程序员可能会在其中插入Application.ProcessMessages调用，现在，您的应用程序将不会显示“无响应”，但是您将引入一些潜在的坏事（包括崩溃）发生，这取决于您其余部分的情况应用。如果这是一个一次性程序，我会很想简单地添加“Application.ProcessMessages”调用（通过循环大约一次 100 次），并且我的应用程序不会显示“无响应”。

但是，在真正稳定的生产代码环境中，您应该将 UI 构建代码（视图构建器）与后台工作线程分开。

并且工作线程也不会很容易实现，因为您正在有效地使用不应从后台线程访问的 VCL 类构建菜单。如果你真的想生成一个包含 100,000 个项目的弹出菜单，那么没有什么好的快速方法可以做到这一点。

我建议你应该考虑一些面向对象的设计：

  1. 工作线程限制了它将构建的项目列表的大小。
  2. 当工作线程完成FindFirst循环并继续创建菜单项时，考虑使用TThread.Synchronize()或其他一些安全的方法来确保从后台线程调用的添加菜单项的方法可以安全地执行此操作。

更新对此问题的编辑使这个答案相当过时。可悲的是，这个问题是一个移动的目标。

于 2012-10-29T14:25:54.517 回答
0

你说：

当我点击按钮时，没关系

所以我假设文件搜索很快，并且它快速添加菜单选项，所以后台线程不会解决你的问题。您的问题是您将数千个条目填充到菜单中，这是行不通的。你需要重新思考。也许列表框会更好。请务必使用 BeginUpdate/EndUpdate 来封闭您的循环。

于 2012-10-29T14:33:52.187 回答