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
| const
LM_LOG = LM_USER;
A_WaitForB = 1;
A_Counter = 2;
B_Working = 3;
B_Running = 4;
B_WakeA = 5;
type
TForm1 = class(TForm)
...
private
...
procedure LMLog(var Message :TMessage); message LM_LOG;
end;
implementation
var
Wnd : THandle;
CSRunning : TCriticalSection;
WaitRunning : PRTLEvent;
WaitFinish : PRTLEvent;
procedure TForm1.FormCreate(Sender: TObject);
begin
ThreadA := TThreadA.Create(False);
Wnd := Handle;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
LeaveCriticalSection(CSRunning);
ThreadA.Free;
end;
procedure TForm1.LMLog(var Message :TMessage);
begin
case Message.WParam of
A_WaitForB : Memo1.Lines.Add('A: wait for B ...');
A_Counter : Memo1.Lines.Add(Format('A: ThreadB.Counter=%d', [Message.LParam]));
B_Working : Memo1.Lines.Add('B: Working ...');
B_Running : Memo1.Lines[Memo1.Lines.Count -1] := Memo1.Lines[Memo1.Lines.Count -1] +' ...';
B_WakeA : Memo1.Lines.Add('B: Wake A');
end;
end;
procedure TForm1.btnStartClick(Sender: TObject);
begin
LeaveCriticalSection(CSRunning);
end;
procedure TForm1.btnStopClick(Sender: TObject);
begin
EnterCriticalsection(CSRunning);
Memo1.SetFocus; // juste pour vérifier que le prog n'est pas planté
end;
{ TThreadA }
procedure TThreadA.Execute;
var
ThreadB :TThreadB;
begin
ThreadB := TThreadB.Create(False);
try
while not Terminated do
begin
// Attend Start (mais ne conserve pas le verrou)
EnterCriticalsection(CSRunning);
LeaveCriticalSection(CSRunning);
RTLEventSetEvent(WaitRunning);
// Attend la fin de B
PostMessage(Wnd, LM_LOG, A_WaitForB, 0);
RtlEventWaitFor(WaitFinish);
PostMessage(Wnd, LM_LOG, A_Counter, ThreadB.Counter);
// B terminé !
end;
finally
ThreadB.Free;
end;
end;
{ TThreadB }
procedure TThreadB.Execute;
var
i: Integer;
begin
while not Terminated do
begin
// Attend Start
RtlEventWaitFor(WaitRunning);
PostMessage(Wnd, LM_LOG, B_Working, 0);
for i := 1 to 5 do begin
Sleep(300);
PostMessage(Wnd, LM_LOG, B_Running, 0);
end;
Counter := Counter + 1;
// Signale la fin
PostMessage(Wnd, LM_LOG, B_WakeA, 1);
RTLEventSetEvent(WaitFinish);
end;
end;
initialization
InitCriticalSection(CSRunning);
WaitRunning := RTLEventCreate;
WaitFinish := RTLEventCreate;
finalization
DoneCriticalSection(CSRunning);
RTLEventDestroy(WaitRunning);
RTLEventDestroy(WaitFinish);
end. |
Répondre avec citation
Envoyé par Jipété
)
.
), ça donne ça :
) au Stop mais 
Partager