実行中の関数を中止させて新たに実行する方法

解決

---

はじめまして。

意味不明な質問タイトルで申し訳ありません。

2つのTEditがあり、それぞれのOnEnterイベントより同じ関数(Test)を実行しようとしています。

この関数(Test)は多少時間のかかるループ処理で、
既に実行中だった場合は中止してから再実行したいのですが
どのように制御してよいのかわかりません。

中止するためのフラグを持たせOnEnterイベント内でセットして
関数(Test)のループを抜けさせようというイメージで作成したのですが
どう考えてもこれでは動きません・・・

何かよい方法がないでしょうか？

//////////////////////////////////////////////////
procedure TForm1.Test(Msg: string);
var
  iCount: Integer;
  After1Sec: Cardinal;
begin
  Memo1.Lines.Add(Msg + ':ST');

  FAbort := False;
  FFind  := True;
  for iCount:=0 to 10 do
    begin
      Application.ProcessMessages;
      if FAbort then Break; // 中止する

      // 多少時間のかかる処理の代わり
      After1Sec := GetTickCount + 500;
      while GetTickCount < After1Sec do
      //

    end;
  FFind := False;

  Memo1.Lines.Add(Msg + ':END');
end;

procedure TForm1.Edit1Enter(Sender: TObject);
begin
  if FFind then FAbort := True;
  Test('Edit1Enter');
end;

procedure TForm1.Edit2Enter(Sender: TObject);
begin
  if FFind then FAbort := True;
  Test('Edit2Enter');
end;
//////////////////////////////////////////////////

このソースで実行してEdit1とEdit2を順にクリックすると、
デバッグ用メッセージは次のように表示されます。
  Edit1Enter:ST
  Edit2Enter:ST
  Edit2Enter:END
  Edit1Enter:END

実際は、このようになるよう制御したいのです。
  Edit1Enter:ST
  Edit1Enter:END
  Edit2Enter:ST
  Edit2Enter:END

よろしくお願いいたします。

編集 削除

---

スレッド化するのが適切かなぁと思います。
OnEnterはわかりづらいのでReturnキーでイベントを発生させています。

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TTestThread = class(TThread)
  private
    fProcess: TNotifyEvent;
    procedure ProcessEvent;
  public
    Name:string;
    Work:Cardinal;
    Time:Cardinal;  //Time msかかる処理
    procedure Execute; override;
    property Process:TNotifyEvent read fProcess write fProcess;
  end;

  TForm1 = class(TForm)
    Edit1: TEdit;
    Edit2: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure Edit1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    { Private 宣言 }
    fTest:TTestThread;
    fTextBuffer,fNameBuffer:string;
    procedure BeginThread;
    procedure ThreadProcess(Sender:TObject);
    procedure ThreadTerminate(Sender:TObject);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TTestThread }

procedure TTestThread.Execute;
var
  s,c,p:Cardinal;
begin
  inherited;
  s := GetTickCount;
  c := s;
  p := s;
  repeat
    if c + 200 < p then  //200ms毎に経過報告
    begin
      Synchronize(ProcessEvent);
      c := p;
    end;
    p := GetTickCount;
    Work := p - s
  until (Terminated) or (Work >= Time);
end;

procedure TTestThread.ProcessEvent;
begin
  if Assigned(fProcess) then
    fProcess(Self);
end;

{ TForm1 }

procedure TForm1.BeginThread;
begin
  fTest := TTestThread.Create(True);
  fTest.FreeOnTerminate := True;
  fTest.Time := StrToInt(fTextBuffer);
  fTextBuffer := '';
  fTest.Name := fNameBuffer;
  fTest.Process := ThreadProcess;
  fTest.OnTerminate := ThreadTerminate;
  fTest.Start;
end;

procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key=VK_RETURN then
  begin
    fTextBuffer := TEdit(Sender).Text;
    fNameBuffer := TEdit(Sender).Name;
    if fTest<>nil then
      fTest.Terminate else
      BeginThread;
  end;
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  if fTest<>nil then
    fTest.Terminate;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  //入力した秒数(ms)だけ処理する
  Edit1.Text := IntToStr(10000);
  Edit2.Text := IntToStr(20000);
end;

procedure TForm1.ThreadProcess(Sender: TObject);
begin
  Caption := fTest.Name +' '+ IntToStr(fTest.Work)+'/'+IntToStr(fTest.Time);
end;

procedure TForm1.ThreadTerminate(Sender: TObject);
begin
  fTest := nil;
  Caption := '終了';
  if fTextBuffer<>'' then
    BeginThread;
end;

end.

編集 削除

---

こんな感じ？

ExitFlag, RestartFlag: boolean;

procedure MainProc;
begin
  begin
    〜長い処理〜
    Application.ProcessMessages;
    if ExitFlag then exit;
  end;
  if RestartFlag then MainProc;
end;

１回で終えるならExitFlagのみオン、リスタートするならもう１このフラグもオン。部分的に再帰的な処理を入れてるので、無限ループに注意。

編集 削除

---

ごめんなさい。単純にループから抜けるときは、exitじゃなくてbreakですね。

編集 削除

---

PostMessageを使用する方法です。


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Memo1: TMemo;
    procedure Edit1Enter(Sender: TObject);
    procedure Edit2Enter(Sender: TObject);
    procedure WMUser(var Message: TMessage); message WM_USER;
  private
    FAbort, FFind: Boolean;
    FMsg: string;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.WMUser(var Message: TMessage);
var
  iCount: Integer;
  After1Sec: Cardinal;
  Msg: string;
begin
  Msg := FMsg;

  Memo1.Lines.Add(Msg + ':ST');

  FAbort := False;
  FFind  := True;
  for iCount:=0 to 10 do
  begin
    Application.ProcessMessages;
    if FAbort then Break; // 中止する

    // 多少時間のかかる処理の代わり
    After1Sec := GetTickCount + 500;
    while GetTickCount < After1Sec do
    //

  end;
  FFind := False;

  if FAbort then
    PostMessage(Handle, WM_USER, 0, 0);

  Memo1.Lines.Add(Msg + ':END');
end;

procedure TForm1.Edit1Enter(Sender: TObject);
begin
  FMsg := 'Edit1Enter';
  if FFind then
    FAbort := True
  else
    PostMessage(Handle, WM_USER, 0, 0);
end;

procedure TForm1.Edit2Enter(Sender: TObject);
begin
  FMsg := 'Edit2Enter';
  if FFind then
    FAbort := True
  else
    PostMessage(Handle, WM_USER, 0, 0);
end;

end.

編集 削除

---

失礼しました。
Button1: TButton;
Button2: TButton;
は余計です。

編集 削除

---

みなさんありがとうございます。

わかりやすいサンプルを載せていただきましたので
それぞれ試してみながら勉強させていただきます。

とりあえず「解決」として結果は追って報告致します。

ありがとうございました。

編集 削除

---

時間のかかる処理の部分は別オブジェクト内関数でして
その部分をスレッド化するべきか検討した結果、
PostMessageで処理させる形としました。

今回の件について、中止後の再実行処理はその関数内に入れて
おかないといけないという考えがなかったのが一番の原因でした。

スレッド化する処理については大変勉強になったので、
機会があれば使ってみようと思います。

ありがとうございました。

編集 削除

---

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

←解決時は質問者本人がここをチェックしてください。

返信する