Question

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 Components

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

LIB \ BarMenus：

{$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时，它也没有响应。你能给点建议吗？

Answer 1

快速测试显示InternalRethinkHotkeys花费的时间。使用＆gt;菜单的热键无效3000项。只需禁用它：

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

  end;
end;

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

Answer 2

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

一个刚开始的Delphi程序员可能会在那里插入Application.ProcessMessages调用，现在，你的应用程序不会显示“没有响应”，但是你会引入一些可能发生的坏事（包括崩溃），具体取决于在你的应用程序的其余部分中发生了什么。如果这是一次性程序，我很想简单地添加“Application.ProcessMessages”调用（通过循环一次100次），我的应用程序不会显示“没有响应”。

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

工作线程也不会轻易实现，因为你正在使用不应该从后台线程访问的VCL类来有效地构建菜单。如果你真的想要生成一个包含100,000个项目的弹出菜单，那么就没有很好的快速方法。

我建议您考虑一些面向对象的设计：

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

更新对此问题的修改已使此答案过时了。可悲的是，问题是一个不断变化的目标。

Answer 3

你说：

当我点击按钮时，没关系

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

这个项目花了太多时间，甚至没有回应，有没有办法改善它？

3 个答案: