If you have code that blocks the GUI, you can use a background thread and an event to provide a non blocking timer.
Create a new Forms application and put a TMemo
component on your form.
This example will add a new line with the current time to your TMemo
.
Main form:
unit u_frm_main;
interface
uses
u_workthread,
SysUtils,
Windows,
Forms,
SyncObjs, Classes, Controls, StdCtrls;
type
TForm1 = class(TForm)
Memo1: TMemo;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
Worker : TWorkThread;
procedure ShowData;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.ShowData;
begin
// do whatever you need to do here...
// show current time in memo
Memo1.Lines.Add(FormatDateTime('HH:NN:SS', Now));
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
// create our worker thread and start it
Worker := TWorkThread.Create(3, ShowData);
Worker.Start;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
// signal our worker thread that we are done here
Worker.ThreadEvent.SetEvent;
// terminate and wait
Worker.Terminate;
Worker.WaitFor;
end;
end.
Worker Thread:
unit u_workthread;
interface
uses
SysUtils,
SyncObjs,
Classes;
type
TWorkProc = procedure of object;
TWorkThread = class(TThread)
private
{ Private declarations }
Counter : Integer;
FTimeout : Integer;
FEventProc: TWorkProc;
procedure DoWork;
protected
procedure Execute; override;
public
ThreadEvent : TEvent;
constructor Create(TimeoutSeconds : Integer; EventProc: TWorkProc ); // timeout in seconds
destructor Destroy; override;
end;
implementation
procedure TWorkThread.DoWork;
begin
// put your GUI blocking code in here. Make sure you never call GUI elements from this procedure
//DoSomeLongCalculation();
end;
procedure TWorkThread.Execute;
begin
Counter := 0;
while not Terminated do
begin
if ThreadEvent.WaitFor(FTimeout) = wrTimeout then
begin
DoWork;
// now inform our main Thread that we have data
Synchronize(FEventProc);
end;
else
// ThreadEvent has been signaled, exit our loop
Break;
end;
end;
constructor TWorkThread.Create(TimeoutSeconds : Integer; EventProc: TWorkProc);
begin
ThreadEvent := TEvent.Create(nil, True, False, '');
// Convert to milliseconds
FTimeout := TimeoutSeconds * 1000;
FEventProc:= EventProc;
// call inherited constructor with CreateSuspended as True
inherited Create(True);
end;
destructor TWorkThread.Destroy;
begin
ThreadEvent.Free;
inherited;
end;
end.