Sign in Join
Wiki copytemporary

thread event test project 1: what changed

Revision 0 to 1. Removed lines have a minus sign; added lines have a plus sign.

Title: thread event test project 1

OldNewLine
1+### TEventThread example: matrix multiplication
2+
3+A thread is created for each line of the Matrix For now only a dummy is used as an implementation of TEventThread. So the result is correct, but no Threads are used.
4+
5+#### GUI unit
6+
7+``` pascal
8+unit eventthreadtest1;
9+
10+interface
11+
12+uses
13+ Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
14+ Dialogs, StdCtrls,
15+ eventthreadtest2,
16+ eventthread_1;
17+
18+type
19+ TForm33 = class(TForm)
20+ Button1: TButton;
21+ Memo1: TMemo;
22+ procedure Button1Click(Sender: TObject);
23+ private
24+ public
25+ { Public declarations }
26+ end;
27+
28+ TMatrixMultMainEventThread = class (TMainEventThread)
29+ private
30+ { Private declarations }
31+ mm: TMatrixMult;
32+ mr: TMatrix;
33+ ThreadsRunning : Integer;
34+ procedure doit;
35+ procedure ThreadReady(Sender: TObject);
36+ procedure AllThreadsReady;
37+ end;
38+
39+var
40+ Form33: TForm33;
41+
42+implementation
43+
44+{$R *.dfm}
45+
46+var
47+ MatrixMultMainEventThread: TMatrixMultMainEventThread;
48+
49+
50+procedure SetupMatrices(var mr, m1, m2: TMatrix);
51+var
52+ i, j: Integer;
53+begin
54+ SetLength(m1, 3);
55+ SetLength(m2, 4);
56+ SetLength(mr, 3);
57+ for i := 0 to length(m1)-1 do begin
58+ SetLength(m1[i], length(m2));
59+ SetLength(mr[i], length(m1));
60+ end;
61+ for i := 0 to length(m2)-1 do begin
62+ setlength(m2[i], length(m1));
63+ end;
64+ for i := 0 to length(m1)-1 do begin
65+ for j := 0 to length(m2)-1 do begin
66+ m1 [i, j] := i+j;
67+ m2 [j, i] := 1 + 2*i + 3*j;
68+ end;
69+ end;
70+end;
71+
72+procedure TMatrixMultMainEventThread.doit;
73+type
74+ trtest = record ptr: pointer; self: TObject; end;
75+var
76+ m1, m2: TMatrix;
77+ l: Integer;
78+
79+ etest: TMultLineEvent;
80+ rtest: trtest;
81+ stest: string;
82+
83+begin
84+ Form33.Memo1.Clear;
85+ SetupMatrices(mr, m1, m2);
86+ mm := TMatrixMult.Create(length(m1), ThreadReady);
87+ ThreadsRunning := length(m1);
88+ for l := 0 to length(m1)-1 do begin
89+
90+ ///////////////////////////////////////////
91+ // just for demonstartion //////////////////
92+ // if (mm.MultLineEvent[l] is TEventThread) then begin
93+ etest := mm.MultLineEvent[l];
94+ move(etest, rtest, 8);
95+ if rtest.self is TEventThread then begin
96+ stest := 'is TEventThread';
97+ end else begin
98+ stest := 'wrong type';
99+ end;
100+ Form33.Memo1.Lines.Add(stest);
101+ ///////////////////////////////////////////
102+ ///////////////////////////////////////////
103+
104+ mm.MultLineEvent[l](mr, m1, m2, l);
105+ // doing an indirect call to a "procedure..of object"
106+ // which _is_ a TThreadEvent schedulres a thread event
107+ // instead of just calling the precudure
108+ end;
109+ // We now need to wait for all threads to be ready
110+end;
111+
112+procedure TMatrixMultMainEventThread.ThreadReady(Sender: TObject);
113+begin // this is a thread event calling the main thread. Tus the code
114+ // is always running as the Main thread. So no danger that
115+ // e.g. ThreadsRunning := ThreadsRunning - 1 suffers from
116+ // multitasking ambiguity
117+ ThreadsRunning := ThreadsRunning - 1;
118+ if ThreadsRunning <> 0 then exit;
119+ mm.Free;
120+ AllThreadsReady;
121+end;
122+
123+procedure TMatrixMultMainEventThread.AllThreadsReady;
124+var
125+ i, j: Integer;
126+ s: String;
127+begin
128+ // calculation ready
129+ for i := 0 to length(mr)-1 do begin
130+ s := '';
131+ for j := 0 to length(mr[0])-1 do begin
132+ s := s + FloatToStr(mr[i,j]) + ' ';
133+ end;
134+ Form33.Memo1.Lines.Add(s);
135+ end;
136+end;
137+
138+procedure TForm33.Button1Click(Sender: TObject);
139+begin
140+ MatrixMultMainEventThread := TMatrixMultMainEventThread.Create;
141+ MatrixMultMainEventThread.doit;
142+ MatrixMultMainEventThread.Free;
143+end;
144+
145+end.
146+```
147+
148+#### worker unit
149+
150+``` pascal
151+unit eventthreadtest2;
152+
153+interface
154+
155+uses Classes,
156+ eventthread_1; // provides a dummy impementation of TEventTrread class
157+
158+type
159+ TMatrixElement = extended;
160+ TVector = array of TMatrixElement;
161+ TMatrix = array of TVector;
162+
163+ TMultLineEvent = procedure (const mr, m1, m2: TMatrix; l: Integer) of object;
164+
165+ TMatrixMultThread = class(TEventThread)
166+ private
167+ FNotifyEvent: TNotifyEvent;
168+ FAktLine: Integer;
169+ procedure NotifyReady;
170+ public
171+ procedure MultLine(const mr, m1, m2: TMatrix; l: Integer);
172+ property NotifyEvent: TNotifyEvent read FNotifyEvent write FNotifyEvent;
173+ property AktLine: Integer read FAktLine;
174+ end;
175+
176+ TMatrixMult = Class(TObject)
177+ private
178+ FMatrixMultThread : array of TMatrixMultThread;
179+ FMultLineEvent : array of TMultLineEvent;
180+ function GetMultLineEvent(i: Integer): TMultLineEvent;
181+ procedure SetMultLineEvent(i: Integer; const Value: TMultLineEvent);
182+ procedure SetEventCount(Value: Integer; ThreadReady: TNotifyEvent);
183+ public
184+ constructor Create(Count: Integer; ThreadReady: TNotifyEvent);
185+ destructor Destroy; override;
186+ property MultLineEvent[i: Integer]: TMultLineEvent
187+ read GetMultLineEvent write SetMultLineEvent;
188+ end;
189+
190+implementation
191+
192+{ TMatrixMultThread }
193+
194+procedure TMatrixMultThread.MultLine(const mr, m1, m2: TMatrix; l: Integer);
195+var
196+ i, j: Integer;
197+ sum: TMatrixElement;
198+begin
199+ FAktLine := l;
200+ for i := 0 to length(m1)-1 do begin
201+ sum := 0;
202+ for j := 0 to length(m2)-1 do begin
203+ sum := sum + m1[l, j] * m2[j, i];
204+ end;
205+ mr[l, i] := sum;
206+ end;
207+ NotifyReady;
208+end;
209+
210+procedure TMatrixMultThread.NotifyReady;
211+begin
212+ if assigned(FNotifyEvent) then FNotifyEvent(self);
213+ // doing an indirect call to a "procedure..of object"
214+ // which _is_ a TThreadEvent schedulres a thread event
215+ // instead of just calling the procedure
216+end;
217+
218+{ TMatrixMult }
219+
220+constructor TMatrixMult.Create(Count: Integer; ThreadReady: TNotifyEvent);
221+begin
222+ inherited Create;
223+ SetEventCount(Count, ThreadReady);
224+end;
225+
226+destructor TMatrixMult.Destroy;
227+var
228+ l: Integer;
229+begin
230+ for l := 0 to length(FMatrixMultThread)-1 do begin
231+ FMatrixMultThread[l].Free;
232+ end;
233+ inherited;
234+end;
235+
236+procedure TMatrixMult.SetEventCount(Value: Integer; ThreadReady: TNotifyEvent);
237+var
238+ l: Integer;
239+begin
240+ SetLength(FMatrixMultThread, Value);
241+ SetLength(FMultLineEvent, Value);
242+ for l := 0 to Value-1 do begin
243+ FMatrixMultThread[l] := TMatrixMultThread.Create;
244+ FMatrixMultThread[l].NotifyEvent := ThreadReady;
245+ FMultLineEvent[l] := FMatrixMultThread[l].MultLine;
246+ end;
247+end;
248+
249+function TMatrixMult.GetMultLineEvent(i: Integer): TMultLineEvent;
250+begin
251+ Result := FMultLineEvent[i];
252+end;
253+
254+procedure TMatrixMult.SetMultLineEvent(i: Integer; const Value: TMultLineEvent);
255+begin
256+ FMultLineEvent[i] := Value;
257+end;
258+
259+end.
260+```
261+
262+#### TEventThread dummy unit
263+
264+``` pascal
265+unit eventthread_1;
266+
267+interface
268+
269+type
270+ TEventThread = class(TObject)
271+ end;
272+
273+ TMainEventThread = class(TObject)
274+ end;
275+
276+implementation
277+
278+end.
279+```
280+
281+---
282+*From the Free Pascal wiki, page "thread event test project 1", as it stood on 2020-03-01 after a change by GAN, out of the wiki's dump of 2024-05-26. Copyright stays with the author who wrote it, according to the old wiki's [[Licensing]] page. If you have concerns about this material, [message the admin](/wiki-contact).*
283+Category: Multitasking
284+Category: Parallel programming

Back to history