[SOLVED] How can I stop While Loop by Button OnClick

[nana232]

I have procedure that about repeating some work.
It is about reading data obtained from other applications every 5-10 min.

I use while loop for this.

I put this loop in Button OnClick. Then, when it started, it cannot be interrupted by any control.
If I would like to kill this process by Button. How to do it?

[Handoko]

There are many tricks for it. Below is one of the possibilities:

Code: Pascal  [Select][+][-]

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, Forms, StdCtrls;
9.  
10. type
11.  
12.   { TForm1 }
13.  
14.   TForm1 = class(TForm)
15.     btnStart: TButton;
16.     btnStop: TButton;
17.     procedure btnStartClick(Sender: TObject);
18.     procedure btnStopClick(Sender: TObject);
19.     procedure FormCreate(Sender: TObject);
20.   end;
21.  
22. var
23.   Form1: TForm1;
24.  
25. implementation
26.  
27. {$R *.lfm}
28.  
29. { TForm1 }
30.  
31. procedure TForm1.btnStartClick(Sender: TObject);
32. begin
33.   btnStart.Enabled := False;
34.   btnStop.Enabled  := True;
35.   repeat
36.     Caption := Random(9999).ToString;
37.     Sleep(100);
38.     Application.ProcessMessages;
39.     if btnStart.Enabled then Exit;
40.   until False;
41. end;
42.  
43. procedure TForm1.btnStopClick(Sender: TObject);
44. begin
45.   btnStart.Enabled := True;
46.   btnStop.Enabled  := False;
47. end;
48.  
49. procedure TForm1.FormCreate(Sender: TObject);
50. begin
51.   btnStop.Enabled := False;
52. end;
53.  
54. end.

[jamie]

aren't we better off using a timer ?

[Thaddy]

aren't we better off using a timer ?

Well, no, because a timer is not immediate, while the message loop is...
Technically a better solution is to create an event and poll the status in the loop running in a separate thread. The button can set the event as a request to end the loop immediately.
But Handoko's solution has the same effect.
One more solution is to test for a global flag from a thread and set that flag through one of the interlocked* functions or an atomic read/write (nativeint,native booleans are atomic on intel, amd and arm.)

[nana232]

There are many tricks for it. Below is one of the possibilities:

Code: Pascal  [Select][+][-]

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, Forms, StdCtrls;
9.  
10. type
11.  
12.   { TForm1 }
13.  
14.   TForm1 = class(TForm)
15.     btnStart: TButton;
16.     btnStop: TButton;
17.     procedure btnStartClick(Sender: TObject);
18.     procedure btnStopClick(Sender: TObject);
19.     procedure FormCreate(Sender: TObject);
20.   end;
21.  
22. var
23.   Form1: TForm1;
24.  
25. implementation
26.  
27. {$R *.lfm}
28.  
29. { TForm1 }
30.  
31. procedure TForm1.btnStartClick(Sender: TObject);
32. begin
33.   btnStart.Enabled := False;
34.   btnStop.Enabled  := True;
35.   repeat
36.     Caption := Random(9999).ToString;
37.     Sleep(100);
38.     Application.ProcessMessages;
39.     if btnStart.Enabled then Exit;
40.   until False;
41. end;
42.  
43. procedure TForm1.btnStopClick(Sender: TObject);
44. begin
45.   btnStart.Enabled := True;
46.   btnStop.Enabled  := False;
47. end;
48.  
49. procedure TForm1.FormCreate(Sender: TObject);
50. begin
51.   btnStop.Enabled := False;
52. end;
53.  
54. end.

Many Thanks. It works   
As I see, "Application.ProcessMassage" would be the Key Procedure for this condition.

[Nitorami]

ProcessMessage handles mouse and keyboard events. You need to understand how Lazarus works in the background.

If you make an endless loop, the program will hang in this loop, and cannot do anything else, in particular it cannot process mouse or keyboard events. You must give the program opportunity to do this. As Handoko showed, you can do this by calling ProcessMessage.

Another very simple way to run cyclic tasks is to put them into a procedure assigned to the OnIdle event of the application. OnIdle is called whenever the application has nothing else to do. You only must make sure that your Idle procedure is short and guaranteed to terminate.