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