Delphi 这个计划花费了太多的时间，甚至没有回应，有什么办法可以改进吗？

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;

更新至@Sertac-Akyuz

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

单元1；
接口
使用
窗户，
信息，
SysUtils，
变体，
班级，
绘图，
控制，
形式，
对话，
StdCtrls，
菜单；
类型
TForm1=类（TForm）
按钮1:t按钮；
PopupMenu1:TPopupMenu；
TestMI:TMenuItem；
程序按钮1点击（发送方：ToObject）；
程序CreMI（MI:TMenuItem）；
程序IMonClick（发送方：ToObject）；
程序添加子项（MI:TMenuItem）；
私有的
{私有声明}
公众的
{公开声明}
结束；
变量
表1:TForm1；
实施
{$R*.dfm}
程序TForm1.IMonClick（发送方：TObject）；
开始
CreMI（项目（发送方））；
结束；
程序TForm1.AddSubEmpItem（MI:TMenuItem）；
变量
EmpIM:TMenuItem；
开始
EmpIM:=TMenuItem.Create（MI）；
和EmpIM一起做
开始
标题：='（文件夹为空）'；
已启用：=假；
提示：=''；
MI.Add（EmpIM）；
结束；
结束；
程序TForm1.CreMI（MI:TMenuItem）；
变量
MItems:TMenuItem的数组；
SList:TStringList；
FileRec:TSearchrec；
i：整数；
开始
如果（MI.Items[0].Caption='（文件夹为空）和（MI.Count=1），则
开始
SList:=TStringList.Create；
如果FindFirst（MI.Hint+'\*'，faNormal或faDirectory，FileRec）=0
然后
重复
如果（FileRec.Name='.'）或（FileRec.Name='.'），则
继续；
添加（FileRec.Name）；
直到FindNext（FileRec）0；
FindClose（FileRec）；
如果SList.Count>0，则
开始
SetLength（斜切、滑动、计数）；
对于i:=0来滑动。计数-1 do
开始
MItems[i]：=TMenuItem.Create（MI）；
MItems[i]。标题：=SList[i]；
MItems[i].Hint:=MI.Hint+SList[i]+PathDelim；
新增子项目（MItems[i]）；
MItems[i].OnClick:=IMonClick；
MItems[i]。自动热键：=手动；
结束；
MI.Add（m）；
MI.自动热键：=手动；
结束；
结束；
//按钮1.标题：=IntToStr（MI.计数）；
结束；
程序TForm1.按钮1单击（发送方：TObject）；
开始
添加子项（TestMI）；
CreMI（TestMI）；
结束；
结束。

Set

TestMI.Hint:=C:\

单击该按钮，当我进入

C:\->Windows->System32时，它也没有响应。
你能给我一些建议吗？
首先，让我们假设你非常聪明，知道创建一个包含一百万个项目的菜单是愚蠢的，所以让我们借此机会讨论一下技术问题，因为正如所有评论者所说，你的想法是行不通的，但也许在你真正的程序中，你只需要在你的计算机上的文件夹中建立word文档列表，所以你选择Windows文件夹只是为了说明。那么，让我们继续：

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

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

工作线程的实现也不是那么简单，因为您正在有效地使用不应该从后台线程访问的VCL类构建菜单。如果你真的想生成一个包含100000个项目的弹出式菜单，没有快速的方法

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

工作线程，限制它将生成的项目列表的大小
当工作线程完成<代码> FindFirst < /代码>循环，并继续创建菜单项时，考虑使用<代码> Ttho.SimuleId（）/Cyto>或其他其他安全方法，以确保将从后台线程调用的菜单项添加的方法能够安全地进行。
更新对该问题的编辑已使该答案过时。遗憾的是，这个问题是一个移动的目标。
一个快速测试显示时间花在了
热键上。热键对超过3000项的菜单没有帮助。只需禁用它：

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

  end;
end;

。。
TestMI.Add（MItems）；
TestMI.AutoHotkeys:=maManual；// 你说：

当我点击按钮时，一切正常

因此，我假设文件搜索很快，而且它正在快速添加菜单选项，因此后台线程不会解决您的问题。您的问题是，您正在将数千个条目塞进一个菜单中，这是行不通的。你需要重新思考。也许一个列表框会更好。确保使用BeginUpdate/EndUpdate来封闭循环。
您可以将长时间运行的内容（文件列表获取）移动到工作线程。在此期间，您无法填充结果，因为它不会完成，但您的应用程序会开始响应。但无论如何，你确定要从3000多个项目中构建一个弹出菜单吗？这将很难击败
FindFirst
/
FindNext
。问题不在于实施。问题在于设计。这是。。。令人痛苦的是，我的w7清洁系统安装有略多于2.8k的文件，添加它们需要一些时间，而且，我认为添加这么多菜单项没有真正的价值，UI概念是有缺陷的。@ONIon-你有没有测试过像我的回答那样将自动热键设置为maManual？@SertacAkyuz see Updatea，和
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.Add(MItems);
    TestMI.AutoHotkeys := maManual; // <--

  end;
end;