1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
|
{
***************************************************************************
* *
* This source is free software; you can redistribute it and/or modify *
* it under the terms of the GNU General Public License as published by *
* the Free Software Foundation; either version 2 of the License, or *
* (at your option) any later version. *
* *
* This code is distributed in the hope that it will be useful, but *
* WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
* General Public License for more details. *
* *
* A copy of the GNU General Public License is available on the World *
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
* obtain it by writing to the Free Software Foundation, *
* Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
* *
***************************************************************************
Abstract:
Demo to show, how to start a thread and how synchronize with the main
thread.
Important: In most (all?) Unix like systems, the cthread unit must be added
to the uses section of the .lpr file. Further, cmem is likely to
be significently faster so add it as well. Due to how the units
work a sensible order is cmem, cthreads and then perhaps cwstrings.
But note that heaptrc does not work with cmem so comment it out
while testing/debugging.
}
unit MainUnit;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs;
type
{ TMyThread }
TMyThread = class(TThread)
private
fStatusText: string;
procedure ShowStatus;
protected
procedure Execute; override;
public
constructor Create(CreateSuspended: boolean);
end;
{ TForm1 }
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
public
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
var
MyThread : TMyThread;
begin
MyThread := TMyThread.Create(True); // With the True parameter it doesn't start automatically
if Assigned(MyThread.FatalException) then
raise MyThread.FatalException;
// Here the code initialises anything required before the threads starts executing
MyThread.Start;
end;
{ TMyThread }
procedure TMyThread.ShowStatus;
// this method is only called by Synchronize(@ShowStatus) and therefore
// executed by the main thread
// The main thread can access GUI elements, for example Form1.Caption.
begin
Form1.Caption := fStatusText;
end;
procedure TMyThread.Execute;
var
newStatus : string;
begin
fStatusText := 'TMyThread Starting ...';
Synchronize(@Showstatus);
fStatusText := 'TMyThread Running ...';
while (not Terminated) and (true {any condition required}) do begin
//here goes the code of the main thread loop
newStatus:='TMyThread Time: '+FormatDateTime('YYYY-MM-DD HH:NN:SS',Now);
if NewStatus <> fStatusText then begin
fStatusText := newStatus;
Synchronize(@Showstatus);
end;
sleep(50); // alternatively the thread may wait for an event. E.g., external I/O
end;
end;
constructor TMyThread.Create(CreateSuspended: boolean);
begin
FreeOnTerminate := True;
inherited Create(CreateSuspended);
end;
end.
|
