使用 Thread 用 TStringList 中的项目填充 TComboBox

我正在使用一个ComboBox显示许多项目的列表（不用担心，项目之间的差异允许通过AutoComplete :-).

该列表是在创建表单 (OnCreate事件），但为了使表单在填写时不会冻结，我添加了一个TThread执行填充TStringList然后将其分配给ComboBox.Items.

它可以工作，但是当显示表单时，它不会正确绘制，直到线程完成并且组合中的内容已经显示。难道不应该使用线程来保存这个吗？

这是我的代码： （目前它不是在 IDE 中编写的，因此可能存在拼写错误...）

type
  TLoadList = class(TThread)
  public
    constructor Create;
    destructor Destroy; override;
  private
    SL: TStrings;
    procedure UpdateCombo;
    procedure Execute; override;
  end;

implementation

uses uMain, HebNumFunc; //The main form unit

constructor TLoadList.Create;
begin
  FreeOnTerminate := True;
  SL := TStringList.Create;
  inherited Create(True);
end;

procedure TLoadList.UpdateCombo;
begin
  MainFrm.YListCombo.Items := SL;
end;

procedure TLoadList.Execute;
begin
  for var I: Integer := 1 to 6000 do SL.Add(HebNumber(I));  //HebNumber This is a function that converts the value of the number to a Hebrew alphabetic value
  Synchronize(UpdateCombo);
end;  

destructor TLoadList.Destroy;
begin
  SL.Free;
  inherited;
end;

HebNumber 函数在 HebNumFunc 单元中声明如下：

function HebNumber(const Number: Integer): string;

const
  Letters1: Array of String = ['','א','ב','ג','ד','ה','ו','ז','ח','ט'];
  Letters10: Array of String = ['','י','כ','ל','מ','נ','ס','ע','פ','צ'];
  Letters100: Array of String = ['','ק','ר','ש','ת','תק','תר','תש','תת','תתק'];

  function _ThousandsConv(const Value: Integer): string;
  var
    Input, Hundreds, Tens, Some: Integer;
  begin
    if Value <= 0 then Exit('');
    
    if Value = 1 then Exit(Format('%s'' ', [Letters1[Value]]));

    if Value in [2..9] then Exit(Format('%s"א ', [Letters1[Value]]));

    if Value >= 10 then
    begin
      Input := Value;
      Hundreds := Input div 100;
      Input := Input mod 100;
      Tens := Input div 10;
      Some := Input mod 10;
      Result := Format('%s%s%s"א ', [Letters100[Hundreds], Letters10[Tens], Letters1[Some]]);
    end;
  end;

var
  Input, Thousands, Hundreds, Tens, Some: Integer;
begin
  Input := Number;
  Thousands := Input div 1000;
  if Thousands > 999 then Exit('חריגה');

  Input := Input mod 1000;
  Hundreds := Input div 100;
  Input := Input mod 100;
  Tens := Input div 10;
  Some := Input mod 10;

  if (Thousands > 0) and (Hundreds + Tens + Some = 0) then
    Exit(Format('%sתתר', [_ThousandsConv(Thousands - 1)]));

  Result := Format('%s%s%s%s', [_ThousandsConv(Thousands),
    Letters100[Hundreds], Letters10[Tens], Letters1[Some]]);

  if Result.Contains('יה') then Exit(Result.Replace('יה', 'טו'));
  if Result.Contains('יו') then Result := Result.Replace('יו', 'טז');
end;

我在 OnCreate 事件中简单地这样调用它：

var
  LoadList: TLoadList;
begin
  LoadList := TLoadList.Create;
  LoadList.Start;
  {...}
end;

里面没有别的东西了OnCreate除了调用创建和运行线程之外，导致窗体着色延迟的事件。其中也没有执行任何额外的操作。

你的代码没有任何问题。向组合框添加 6000 个项目非常慢，并且可能会干扰窗体的初始绘制，因为向组合框添加项目也在主 (GUI) 线程中运行。

您不能在后台线程中移动该分配，因为使用 GUI 控件必须在主线程中完成。

您所看到的问题的发生是因为线程内的代码运行得非常快，并且在表单有机会正确绘制自身之前将与主线程同步。

有几种可能的解决方案：

1. 由于后台线程中的代码运行速度很快，因此删除线程并直接在 ComboBox 中填充 ComboBoxOnCreate事件处理程序。

2. 将代码移自OnCreate to the OnShow事件处理程序，在接近显示表单的时间运行代码。但是，此事件可以多次触发，因此您需要额外的布尔字段来填充组合框一次。

但是，这仍然不足以防止故障。为此，请添加一个Sleep()在线程内稍微减慢其执行速度，并给窗体一些时间来完成其初始绘制。然后你可以打电话Synchronize()来填充组合框。

您可能需要尝试睡眠时间，因为速度较慢的计算机将需要更多时间来完成窗体的绘制，但不要睡眠时间太长，因为在这种情况下用户将能够访问空的 ComboBox。

procedure MainFrm.FormShow(Sender: TObject);
begin
  if not FFilled then
    begin
      FFilled := True;
      TThread.CreateAnonymousThread(
        procedure
        var
          sl: TStringList;
        begin
          sl := TStringList.Create;
          try
            for var I: Integer := 1 to 6000 do
              sl.Add(HebNumber(I));
          
            // Sleep for some small amount of time before synchronizing
            // with the main thread to allow form to fully paint itself
            Sleep(100);

            TThread.Synchronize(nil,
              procedure
              begin
                YListCombo.Items := sl;
              end);
          finally
            sl.Free;
          end;
        end).Start;
    end;
end;

注意：我使用匿名线程来填充组合框，因为这种方法不需要创建额外的类，并且代码更简单。但是，如果您不愿意，则不必更改这部分代码。