delphi - 这个程序花费太多时间，甚至没有响应，有什么办法改进吗？

Question

这个问题不太可能对任何 future 的访客有帮助；它只与一个较小的地理区域、一个特定的时间点或一个非常狭窄的情况相关，通常不适用于全世界的互联网受众。如需帮助使此问题更广泛适用， visit the help center 。

已关闭 10 年前。

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 ，因为文件太多没 react 。

有什么办法可以解决吗？

更新:

我必须使用 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 花费了时间。热键对于包含超过 3000 个项目的菜单没有帮助。只需禁用它即可:

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

  end;
end;

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