103 lines
2 KiB
ObjectPascal
103 lines
2 KiB
ObjectPascal
unit main;
|
|
|
|
interface
|
|
|
|
uses
|
|
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
|
|
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls, Vcl.ComCtrls, System.Threading;
|
|
|
|
type
|
|
TfrmMain = class(TForm)
|
|
btnStart: TButton;
|
|
progressBar: TProgressBar;
|
|
lblStatus: TLabel;
|
|
procedure FormCreate(Sender: TObject);
|
|
procedure btnStartClick(Sender: TObject);
|
|
|
|
private
|
|
{ Private declarations }
|
|
FMyTask : ITask ;
|
|
procedure startTask ;
|
|
procedure stopTask ;
|
|
public
|
|
{ Public declarations }
|
|
end;
|
|
|
|
var
|
|
frmMain : TfrmMain ;
|
|
direction : Boolean ;
|
|
runIt : Boolean ;
|
|
|
|
implementation
|
|
|
|
{$R *.dfm}
|
|
|
|
|
|
|
|
|
|
procedure TfrmMain.FormCreate(Sender: TObject);
|
|
begin
|
|
direction := False ;
|
|
runIt := False ;
|
|
end;
|
|
|
|
|
|
|
|
procedure TfrmMain.btnStartClick(Sender: TObject);
|
|
begin
|
|
runIt := NOT runIt ;
|
|
if runIt then
|
|
begin
|
|
btnStart.Caption := 'Stop Monitoring' ;
|
|
startTask ;
|
|
end
|
|
else
|
|
begin
|
|
btnStart.Caption := 'Start Monitoring' ;
|
|
stopTask ;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TfrmMain.startTask;
|
|
begin
|
|
lblStatus.Caption := 'Measuring' ;
|
|
// Create and start the background task
|
|
FMyTask := TTask.Run(
|
|
procedure
|
|
begin
|
|
// Check if the Stop button was clicked
|
|
if TTask.CurrentTask.Status = TTaskStatus.Canceled then
|
|
Exit; // Gracefully exit the thread loop
|
|
|
|
|
|
// Simulate work (e.g., 500ms step)
|
|
while runIt do
|
|
begin
|
|
|
|
Sleep(1000);
|
|
|
|
// 2. Safely update the UI progress
|
|
TThread.Queue(nil,
|
|
procedure
|
|
begin
|
|
direction := Not direction ;
|
|
if direction then
|
|
mouse.CursorPos := Point( mouse.CursorPos.X + 2, mouse.CursorPos.Y + 2 )
|
|
else
|
|
mouse.CursorPos := Point( mouse.CursorPos.X - 2, mouse.CursorPos.Y - 2 )
|
|
end);
|
|
end;
|
|
end);
|
|
end;
|
|
|
|
procedure TfrmMain.stopTask;
|
|
begin
|
|
if (FMyTask <> nil ) then
|
|
begin
|
|
lblStatus.Caption := '' ;
|
|
FMyTask.Cancel ;
|
|
end;
|
|
end;
|
|
|
|
end.
|