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

时间:2013-05-14 21:05:36

标签: delphi

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

1 个答案:

答案 0 :(得分: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;