-3

使用德尔福 2010

嗨，我正在寻找一种使用按键来打破循环的方法（例如“x”）

procedure TfrmMain.btnSpinClick(Sender: TObject);

function IsControlKeyPressed: Boolean;
begin
  Result := GetKeyState(Ord('x')) < 0;
end;

var
 ProductList: TStringList;
 I, Integer;
begin
  Screen.Cursor:= crHourGlass;
  Spinning:= True;
  UpdateAll;
  Application.ProcessMessages;
  //create a product list
  ProductList:= TStringList.Create;
  ProductList.LoadFromFile(edtProductsFile.Text);
  Progressbar1.Min:= 1;
  Progressbar1.Max:= ProductList.Count - 1;
  //interate through the product list
  //skip first line (its the field names) and start at the second line
  for I:=  1 to ProductList.Count - 1 do
  begin
    //***************
   //other code here
   //***************
   Progressbar1.Position:= Progressbar1.Position + 1;
   ***if IsControlKeyPressed then Break;
   Application.ProcessMessages;***
  end; //for I:=  1 to ProductList.Count - 1 do
  ProductList.Clear;
  ProductList.Free;
  Thesaurus.Clear;
  Thesaurus.Free;
  Screen.Cursor:= crDefault;
  Spinning:= False;
  UpdateAll;
  Application.ProcessMessages;
end;
4

1 回答 1

11

将长时间运行的代码移到单独的线程中。在其中，偶尔检查是否设置了某个标志。设置好后，停止。

然后，为您的表单编写一个OnKeyPress事件处理程序。当该事件处理程序检测到已按下魔术键组合时，设置标志。这将导致线程停止工作。

它可以像这样工作：

type
  TProcessProductListThread = class(TThread)
  private
    FFileName: string;
    FProgressBar: TProgressBar;
    FMax: Integer;
    procedure SetProgressBarRange;
    procedure IncrementProgressBar;
    procedure ProcessProduct(const AProduct: string);
  protected
    procedure Execute; override;
  public
    constructor Create(const AFileName: string; AProgressBar: TProgressBar;
      OnThreadTerminate: TNotifyEvent);
  end;

构造函数接收完成工作所需的所有信息，但实际上并没有开始做任何事情。这是为方法保留的Execute。我们设置FreeOnTerminate := False是因为主线程在开始运行后需要继续访问线程对象。

constructor TProcessProductListThread.Create(const AFileName: string;
  AProgressBar: TProgressBar; OnThreadTerminate: TNotifyEvent);
begin
  inherited Create(False);
  FFileName := AFileName;
  FProgressBar := AProgressBar;
  OnTerminate := OnThreadTerminate;
  FreeOnTerminate := False;
end;

您的代码在几个地方与 GUI 交互。这需要从 GUI 线程中进行，因此我们将该代码提取到可以传递给的单独方法中Synchronize：

procedure TProcessProductList.SetProgressBarRange);
begin
  FProgressBar.Min := 1;
  FProgressBar.Position := FProgressBar.Min;
  FProgressBar.Max := FMax;
end;

procedure TProcessProduceList.IncrementProgressBar;
begin
  FProgressBar.Position := FProgressBar.Position + 1;
end;

您会注意到该Execute方法看起来与您的原始代码相似。注意它是如何使用之前从构造函数中保存的值的。

procedure TProcessProductList.Execute;
var
  ProductList: TStringList;
  I: Integer;
begin
  ProductList := TStringList.Create;
  try
    ProductList.LoadFromFile(FFileName);
    FMax := ProductList.Count - 1;
    Synchronize(SetProgressBarRange);

    // skip first line (it's the field names) and start at the second line
    for I := 1 to ProductList.Count - 1 do begin
      ProcessProduct(ProductList[I]);

      Synchronize(IncrementProgressBar);
      if Terminated then
        exit;
    end;
  finally
    ProductList.Free;
  end;
end;

要启动线程，请像这样创建它：

ProcessThread := TProcessProductList.Create(edtProductsFile.Text, Progressbar1,
  OnProcessProductListTerminate);

使用如下事件处理程序处理终止。它主要是原始代码尾声中的内容，但也很清楚ProcessThread；这样，它的值可以指示线程是否仍在运行。

procedure TForm1.OnProcessProductListTerminate(Sender: TObject);
begin
  Thesaurus.Clear;
  Thesaurus.Free;
  UpdateAll;
  ProcessThread := nil;
end;

还记得我说过你应该在按键时设置一个标志吗？在上面的代码中，它检查的标志只是线程自己的Terminated属性。要设置它，请调用线程的Terminate方法。

procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
  if Char = 'X' then begin
    ProcessThread.Terminate;
    ProcessThread.Free;
    Char := #0;
  end;
end;
于 2013-05-14T21:32:53.420 回答