使用Windows键按下以打破循环(非keyPress事件)

Question

使用Delphi 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;

Answer 1

将长时间运行的代码移动到单独的线程中.在其中,偶尔检查是否设置了某个标志.当它设置时,停止.

然后,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;