easylinux/SignauxComplexes
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

V1.3

Browse Source
This commit is contained in:
f1iwq2
2020-03-01 18:15:30 +01:00
parent 155b694a65
commit 11cc298114
25 changed files with 1769 additions and 624 deletions
Download Patch File Download Diff File Expand all files Collapse all files

251
1train.txt Normal file
View File

@@ -0,0 +1,251 @@
1 Tick=283 Det=521=0
2 Tick=283 Det=521=0
3 Tick=283 Det=524=0
4 Tick=283 Det=531=0
5 Tick=283 Det=518=0
6 Tick=283 Det=518=0
7 Tick=283 Det=519=0
8 Tick=283 Det=523=0
9 Tick=283 Det=526=0
10 Tick=283 Det=527=0
11 Tick=283 Det=526=0
12 Tick=283 Det=523=0
13 Tick=283 Det=513=1
14 Tick=283 Det=524=0
15 Tick=283 Det=515=0
16 Tick=283 Det=514=0
17 Tick=283 Det=516=1
18 Tick=283 Det=516=1
19 Tick=283 Det=515=0
20 Tick=283 Det=525=0
21 Tick=283 Det=528=0
22 Tick=283 Det=528=0
23 Tick=283 Det=522=0
24 Tick=283 Det=514=0
25 Tick=283 Det=522=0
26 Tick=283 Det=519=0
27 Tick=283 Det=527=0
28 Tick=283 Det=531=0
29 Tick=283 Det=525=0
30 Tick=283 Det=535=0
31 Tick=283 Det=535=0
32 Tick=283 Det=535=0
33 Tick=283 Det=535=0
34 Tick=284 Det=534=0
35 Tick=284 Det=534=0
36 Tick=284 Det=533=0
37 Tick=284 Det=533=0
38 Tick=284 Det=520=1
39 Tick=284 Det=520=1
40 Tick=284 Det=517=0
41 Tick=284 Det=517=0
42 Tick=284 Det=538=1
43 Tick=284 Det=538=1
44 Tick=284 Det=529=0
45 Tick=284 Det=529=0
46 Tick=284 Det=530=0
47 Tick=284 Det=530=0
48 Tick=284 Det=537=0
49 Tick=284 Det=537=0
50 Tick=284 Det=513=1
51 Tick=285 Det=518=0
52 Tick=285 Det=518=0
53 Tick=285 Det=519=1
54 Tick=285 Det=519=1
55 Tick=285 Det=520=0
56 Tick=285 Det=520=0
57 Tick=285 Det=517=0
58 Tick=285 Det=517=0
59 Tick=297 Det=518=0
60 Tick=297 Det=518=0
61 Tick=297 Det=519=0
62 Tick=297 Det=519=0
63 Tick=297 Det=520=0
64 Tick=297 Det=520=0
65 Tick=297 Det=517=0
66 Tick=297 Det=517=0
67 Tick=354 Det=513=0
68 Tick=354 Det=515=0
69 Tick=354 Det=514=0
70 Tick=354 Det=516=1
71 Tick=354 Det=516=1
72 Tick=354 Det=515=0
73 Tick=354 Det=514=0
74 Tick=354 Det=513=0
75 Tick=381 Det=531=1
76 Tick=381 Det=531=1
77 Tick=381 Det=529=0
78 Tick=381 Det=529=0
79 Tick=381 Det=530=0
80 Tick=381 Det=530=0
81 Tick=385 Det=531=0
82 Tick=385 Det=529=0
83 Tick=385 Det=529=0
84 Tick=385 Det=530=0
85 Tick=385 Det=530=0
86 Tick=390 Det=518=1
87 Tick=390 Det=518=1
88 Tick=390 Det=519=0
89 Tick=390 Det=519=0
90 Tick=390 Det=520=0
91 Tick=390 Det=520=0
92 Tick=390 Det=517=0
93 Tick=390 Det=517=0
94 Tick=399 Det=531=0
95 Tick=417 Det=518=1
96 Tick=417 Det=518=1
97 Tick=417 Det=519=1
98 Tick=417 Det=519=1
99 Tick=417 Det=520=0
100 Tick=417 Det=520=0
101 Tick=417 Det=517=0
102 Tick=417 Det=517=0
103 Tick=419 Det=518=0
104 Tick=419 Det=519=1
105 Tick=419 Det=519=1
106 Tick=419 Det=520=0
107 Tick=419 Det=520=0
108 Tick=419 Det=517=0
109 Tick=419 Det=517=0
110 Tick=423 Det=518=0
111 Tick=423 Det=518=0
112 Tick=423 Det=519=0
113 Tick=423 Det=519=0
114 Tick=423 Det=520=0
115 Tick=423 Det=520=0
116 Tick=423 Det=517=0
117 Tick=423 Det=517=0
118 Tick=439 Det=518=0
119 Tick=442 Det=521=0
120 Tick=442 Det=521=0
121 Tick=442 Det=524=0
122 Tick=442 Det=523=1
123 Tick=442 Det=523=1
124 Tick=442 Det=524=0
125 Tick=442 Det=522=0
126 Tick=442 Det=522=0
127 Tick=479 Det=521=0
128 Tick=479 Det=521=0
129 Tick=479 Det=524=0
130 Tick=479 Det=523=0
131 Tick=479 Det=524=0
132 Tick=479 Det=522=0
133 Tick=479 Det=522=0
134 Tick=482 Det=526=1
135 Tick=482 Det=527=0
136 Tick=482 Det=526=1
137 Tick=482 Det=525=0
138 Tick=482 Det=528=0
139 Tick=482 Det=528=0
140 Tick=482 Det=527=0
141 Tick=482 Det=525=0
142 Tick=493 Det=523=0
143 Tick=521 Det=527=0
144 Tick=521 Det=526=0
145 Tick=521 Det=525=0
146 Tick=521 Det=528=0
147 Tick=521 Det=528=0
148 Tick=521 Det=527=0
149 Tick=521 Det=525=0
150 Tick=534 Det=526=0
151 Tick=583 Det=513=1
152 Tick=583 Det=515=0
153 Tick=583 Det=514=0
154 Tick=583 Det=516=1
155 Tick=583 Det=516=1
156 Tick=583 Det=515=0
157 Tick=583 Det=514=0
158 Tick=583 Det=513=1
159 Tick=607 Det=515=0
160 Tick=607 Det=514=0
161 Tick=607 Det=516=1
162 Tick=607 Det=516=1
163 Tick=607 Det=515=0
164 Tick=607 Det=514=0
165 Tick=607 Det=513=0
166 Tick=618 Det=513=0
167 Tick=631 Det=531=1
168 Tick=631 Det=531=1
169 Tick=631 Det=529=0
170 Tick=631 Det=529=0
171 Tick=631 Det=530=0
172 Tick=631 Det=530=0
173 Tick=636 Det=531=0
174 Tick=636 Det=529=0
175 Tick=636 Det=529=0
176 Tick=636 Det=530=0
177 Tick=636 Det=530=0
178 Tick=640 Det=518=1
179 Tick=640 Det=518=1
180 Tick=640 Det=519=0
181 Tick=640 Det=519=0
182 Tick=640 Det=520=0
183 Tick=640 Det=520=0
184 Tick=640 Det=517=0
185 Tick=640 Det=517=0
186 Tick=645 Det=531=0
187 Tick=668 Det=518=1
188 Tick=668 Det=518=1
189 Tick=668 Det=519=1
190 Tick=668 Det=519=1
191 Tick=668 Det=520=0
192 Tick=668 Det=520=0
193 Tick=668 Det=517=0
194 Tick=668 Det=517=0
195 Tick=670 Det=518=0
196 Tick=670 Det=519=1
197 Tick=670 Det=519=1
198 Tick=670 Det=520=0
199 Tick=670 Det=520=0
200 Tick=670 Det=517=0
201 Tick=670 Det=517=0
202 Tick=672 Det=518=0
203 Tick=672 Det=518=0
204 Tick=672 Det=519=0
205 Tick=672 Det=519=0
206 Tick=672 Det=520=0
207 Tick=672 Det=520=0
208 Tick=672 Det=517=0
209 Tick=672 Det=517=0
210 Tick=690 Det=518=0
211 Tick=692 Det=521=0
212 Tick=692 Det=521=0
213 Tick=692 Det=524=0
214 Tick=692 Det=523=1
215 Tick=692 Det=523=1
216 Tick=692 Det=524=0
217 Tick=692 Det=522=0
218 Tick=692 Det=522=0
219 Tick=730 Det=521=0
220 Tick=730 Det=521=0
221 Tick=730 Det=524=0
222 Tick=730 Det=523=0
223 Tick=730 Det=524=0
224 Tick=730 Det=522=0
225 Tick=730 Det=522=0
226 Tick=733 Det=526=1
227 Tick=733 Det=527=0
228 Tick=733 Det=526=1
229 Tick=733 Det=525=0
230 Tick=733 Det=528=0
231 Tick=733 Det=528=0
232 Tick=733 Det=527=0
233 Tick=733 Det=525=0
234 Tick=744 Det=523=0
235 Tick=772 Det=527=0
236 Tick=772 Det=526=0
237 Tick=772 Det=525=0
238 Tick=772 Det=528=0
239 Tick=772 Det=528=0
240 Tick=772 Det=527=0
241 Tick=772 Det=525=0
242 Tick=785 Det=526=0
243 Tick=857 Det=513=1
244 Tick=857 Det=515=0
245 Tick=857 Det=514=0
246 Tick=857 Det=516=1
247 Tick=857 Det=516=1
248 Tick=857 Det=515=0
249 Tick=857 Det=514=0
250 Tick=857 Det=513=1

61
2 trains.txt Normal file
View File

@@ -0,0 +1,61 @@
départ depuis 2 trains en 523 et 526
1 Tick=370 Det=523=1 BB
2 Tick=370 Det=526=1 CC en tete
3 Tick=370 Det=516=1 TGV en garage
4 Tick=371 Det=520=1 ???
-------------------------------
5 Tick=505 Det=526=0 CC quitte
6 Tick=550 Det=523=0 BB quitte
7 Tick=559 Det=526=1 BB arrive
8 Tick=578 Det=513=1 CC arrive
9 Tick=606 Det=513=0 CC quitte
10 Tick=638 Det=531=1 CC arrive
11 Tick=638 Det=526=0 BB quitte
12 Tick=643 Det=531=0 CC quitte
13 Tick=649 Det=518=1 CC arrive
14 Tick=649 Det=520=0 ???
15 Tick=685 Det=518=0 CC quitte
16 Tick=712 Det=513=1 BB arrive
17 Tick=716 Det=523=1 CC arrive
18 Tick=730 Det=513=0 BB quitte
19 Tick=766 Det=531=1 BB arrive
20 Tick=766 Det=523=0 CC quitte
21 Tick=774 Det=531=0 BB quitte
22 Tick=774 Det=526=1 CC arrive
23 Tick=779 Det=518=1 BB arrive
24 Tick=809 Det=518=0 BB quitte
25 Tick=819 Det=526=0 CC quitte
26 Tick=839 Det=523=1 BB arrive
27 Tick=871 Det=523=0 BB quitte
28 Tick=876 Det=526=1 BB arrive
29 Tick=933 Det=513=1 CC arrive
trains arretés
BB CC
1 523 1
2 526 1
5 526 0
6 523 0
7 526 1
8 513 1
9 513 0
10 531 1
11 526 0
12 531 0
13 518 1
14 520???
15 518 0
16 513 1
17 523 1
18 513 0
19 531 1
20 523 0
21 531 0
22 526 1
23 518 1
24 518 0
25 526 0
26 523 1
27 523 0
28 526 1
29 513 1

306
2trains_séparés.txt Normal file
View File

@@ -0,0 +1,306 @@
1 Tick=1016 Det=521=0
2 Tick=1016 Det=521=0
3 Tick=1016 Det=524=0
4 Tick=1016 Det=531=0
5 Tick=1016 Det=518=0
6 Tick=1016 Det=518=0
7 Tick=1016 Det=519=0
8 Tick=1016 Det=523=0
9 Tick=1016 Det=526=1
10 Tick=1016 Det=527=0
11 Tick=1016 Det=526=1
12 Tick=1016 Det=523=0
13 Tick=1016 Det=513=0
14 Tick=1016 Det=524=0
15 Tick=1016 Det=515=0
16 Tick=1016 Det=514=0
17 Tick=1016 Det=516=1
18 Tick=1016 Det=516=1
19 Tick=1016 Det=515=0
20 Tick=1016 Det=525=0
21 Tick=1016 Det=528=1
22 Tick=1016 Det=528=1
23 Tick=1016 Det=522=0
24 Tick=1017 Det=514=0
25 Tick=1017 Det=522=0
26 Tick=1017 Det=519=0
27 Tick=1017 Det=527=0
28 Tick=1017 Det=531=0
29 Tick=1017 Det=525=0
30 Tick=1017 Det=535=0
31 Tick=1017 Det=535=0
32 Tick=1017 Det=535=0
33 Tick=1017 Det=535=0
34 Tick=1017 Det=534=0
35 Tick=1017 Det=534=0
36 Tick=1017 Det=533=0
37 Tick=1017 Det=533=0
38 Tick=1017 Det=520=0
39 Tick=1017 Det=520=0
40 Tick=1017 Det=517=0
41 Tick=1017 Det=517=0
42 Tick=1017 Det=538=0
43 Tick=1017 Det=538=0
44 Tick=1017 Det=529=0
45 Tick=1017 Det=529=0
46 Tick=1017 Det=530=0
47 Tick=1017 Det=530=0
48 Tick=1017 Det=537=0
49 Tick=1017 Det=537=0
50 Tick=1017 Det=513=0
51 Tick=1044 Det=526=0
52 Tick=1044 Det=527=0
53 Tick=1044 Det=526=0
54 Tick=1044 Det=525=0
55 Tick=1044 Det=528=1
56 Tick=1044 Det=528=1
57 Tick=1044 Det=527=0
58 Tick=1044 Det=525=0
59 Tick=1057 Det=526=0
60 Tick=1057 Det=527=0
61 Tick=1057 Det=526=0
62 Tick=1057 Det=525=0
63 Tick=1057 Det=528=0
64 Tick=1057 Det=528=0
65 Tick=1057 Det=527=0
66 Tick=1057 Det=525=0
67 Tick=1076 Det=531=1
68 Tick=1076 Det=531=1
69 Tick=1076 Det=529=0
70 Tick=1076 Det=529=0
71 Tick=1076 Det=530=0
72 Tick=1076 Det=530=0
73 Tick=1081 Det=531=0
74 Tick=1081 Det=529=0
75 Tick=1081 Det=529=0
76 Tick=1081 Det=530=0
77 Tick=1081 Det=530=0
78 Tick=1086 Det=518=1
79 Tick=1086 Det=518=1
80 Tick=1086 Det=519=0
81 Tick=1086 Det=519=0
82 Tick=1086 Det=520=0
83 Tick=1086 Det=520=0
84 Tick=1086 Det=517=0
85 Tick=1086 Det=517=0
86 Tick=1097 Det=531=0
87 Tick=1115 Det=518=0
88 Tick=1115 Det=519=0
89 Tick=1115 Det=519=0
90 Tick=1115 Det=520=0
91 Tick=1115 Det=520=0
92 Tick=1115 Det=517=0
93 Tick=1115 Det=517=0
94 Tick=1121 Det=518=0
95 Tick=1138 Det=521=0
96 Tick=1138 Det=521=0
97 Tick=1138 Det=524=0
98 Tick=1138 Det=523=1
99 Tick=1138 Det=523=1
100 Tick=1138 Det=524=0
101 Tick=1138 Det=522=0
102 Tick=1138 Det=522=0
103 Tick=1141 Det=513=1
104 Tick=1141 Det=515=0
105 Tick=1141 Det=514=0
106 Tick=1141 Det=516=1
107 Tick=1141 Det=516=1
108 Tick=1141 Det=515=0
109 Tick=1141 Det=514=0
110 Tick=1141 Det=513=1
111 Tick=1183 Det=521=0
112 Tick=1183 Det=521=0
113 Tick=1183 Det=524=0
114 Tick=1183 Det=523=0
115 Tick=1183 Det=524=0
116 Tick=1183 Det=522=0
117 Tick=1183 Det=522=0
118 Tick=1191 Det=526=1
119 Tick=1191 Det=527=0
120 Tick=1191 Det=526=1
121 Tick=1191 Det=525=0
122 Tick=1191 Det=528=0
123 Tick=1191 Det=528=0
124 Tick=1191 Det=527=0
125 Tick=1191 Det=525=0
126 Tick=1194 Det=513=0
127 Tick=1194 Det=515=0
128 Tick=1194 Det=514=0
129 Tick=1194 Det=516=1
130 Tick=1194 Det=516=1
131 Tick=1194 Det=515=0
132 Tick=1194 Det=514=0
133 Tick=1194 Det=513=0
134 Tick=1214 Det=523=0
135 Tick=1242 Det=531=1
136 Tick=1242 Det=531=1
137 Tick=1242 Det=529=0
138 Tick=1242 Det=529=0
139 Tick=1242 Det=530=0
140 Tick=1242 Det=530=0
141 Tick=1251 Det=531=0
142 Tick=1251 Det=529=0
143 Tick=1251 Det=529=0
144 Tick=1251 Det=530=0
145 Tick=1251 Det=530=0
146 Tick=1260 Det=518=1
147 Tick=1260 Det=518=1
148 Tick=1260 Det=519=0
149 Tick=1260 Det=519=0
150 Tick=1260 Det=520=0
151 Tick=1260 Det=520=0
152 Tick=1260 Det=517=0
153 Tick=1260 Det=517=0
154 Tick=1272 Det=531=0
155 Tick=1283 Det=527=0
156 Tick=1283 Det=526=0
157 Tick=1283 Det=525=0
158 Tick=1283 Det=528=0
159 Tick=1283 Det=528=0
160 Tick=1283 Det=527=0
161 Tick=1283 Det=525=0
162 Tick=1290 Det=526=0
163 Tick=1310 Det=518=0
164 Tick=1310 Det=519=0
165 Tick=1310 Det=519=0
166 Tick=1310 Det=520=0
167 Tick=1310 Det=520=0
168 Tick=1310 Det=517=0
169 Tick=1310 Det=517=0
170 Tick=1321 Det=518=0
171 Tick=1326 Det=513=0
172 Tick=1326 Det=515=0
173 Tick=1326 Det=514=1
174 Tick=1326 Det=516=1
175 Tick=1326 Det=516=1
176 Tick=1326 Det=515=0
177 Tick=1326 Det=514=1
178 Tick=1326 Det=513=0
179 Tick=1376 Det=513=1
180 Tick=1376 Det=515=0
181 Tick=1376 Det=514=1
182 Tick=1376 Det=516=1
183 Tick=1376 Det=516=1
184 Tick=1376 Det=515=0
185 Tick=1376 Det=514=1
186 Tick=1376 Det=513=1
187 Tick=1397 Det=521=0
188 Tick=1397 Det=521=0
189 Tick=1397 Det=524=0
190 Tick=1397 Det=523=0
191 Tick=1397 Det=523=0
192 Tick=1397 Det=524=0
193 Tick=1397 Det=522=1
194 Tick=1397 Det=522=1
195 Tick=1400 Det=515=0
196 Tick=1421 Det=514=0
197 Tick=1422 Det=513=0
198 Tick=1437 Det=531=1
199 Tick=1437 Det=531=1
200 Tick=1437 Det=529=0
201 Tick=1437 Det=529=0
202 Tick=1437 Det=530=0
203 Tick=1437 Det=530=0
204 Tick=1441 Det=531=0
205 Tick=1441 Det=531=0
206 Tick=1441 Det=529=0
207 Tick=1441 Det=529=0
208 Tick=1441 Det=530=0
209 Tick=1441 Det=530=0
210 Tick=1446 Det=518=1
211 Tick=1446 Det=518=1
212 Tick=1446 Det=519=0
213 Tick=1446 Det=519=0
214 Tick=1446 Det=520=0
215 Tick=1446 Det=520=0
216 Tick=1446 Det=517=0
217 Tick=1446 Det=517=0
218 Tick=1475 Det=518=0
219 Tick=1475 Det=519=0
220 Tick=1475 Det=519=0
221 Tick=1475 Det=520=0
222 Tick=1475 Det=520=0
223 Tick=1475 Det=517=0
224 Tick=1475 Det=517=0
225 Tick=1490 Det=518=0
226 Tick=1491 Det=521=0
227 Tick=1491 Det=521=0
228 Tick=1491 Det=524=0
229 Tick=1491 Det=523=0
230 Tick=1491 Det=523=0
231 Tick=1491 Det=524=0
232 Tick=1491 Det=522=0
233 Tick=1498 Det=521=0
234 Tick=1498 Det=521=0
235 Tick=1498 Det=524=0
236 Tick=1498 Det=523=1
237 Tick=1498 Det=523=1
238 Tick=1498 Det=524=0
239 Tick=1498 Det=522=0
240 Tick=1498 Det=522=0
241 Tick=1500 Det=522=0
242 Tick=1541 Det=521=0
243 Tick=1541 Det=521=0
244 Tick=1541 Det=524=0
245 Tick=1541 Det=526=0
246 Tick=1541 Det=527=1
247 Tick=1541 Det=526=0
248 Tick=1541 Det=523=0
249 Tick=1541 Det=524=0
250 Tick=1541 Det=525=0
251 Tick=1541 Det=528=0
252 Tick=1541 Det=528=0
253 Tick=1541 Det=522=0
254 Tick=1541 Det=522=0
255 Tick=1541 Det=527=1
256 Tick=1541 Det=525=0
257 Tick=1551 Det=526=1
258 Tick=1551 Det=527=1
259 Tick=1551 Det=526=1
260 Tick=1551 Det=525=0
261 Tick=1551 Det=528=0
262 Tick=1551 Det=528=0
263 Tick=1551 Det=527=1
264 Tick=1551 Det=525=0
265 Tick=1552 Det=523=0
266 Tick=1598 Det=527=1
267 Tick=1598 Det=526=0
268 Tick=1598 Det=525=0
269 Tick=1598 Det=528=0
270 Tick=1598 Det=528=0
271 Tick=1598 Det=527=1
272 Tick=1598 Det=525=0
273 Tick=1606 Det=526=0
274 Tick=1606 Det=526=0
275 Tick=1606 Det=525=0
276 Tick=1606 Det=528=0
277 Tick=1606 Det=528=0
278 Tick=1606 Det=527=0
279 Tick=1606 Det=525=0
280 Tick=1643 Det=518=0
281 Tick=1643 Det=518=0
282 Tick=1643 Det=519=1
283 Tick=1643 Det=519=1
284 Tick=1643 Det=520=0
285 Tick=1643 Det=520=0
286 Tick=1643 Det=517=0
287 Tick=1643 Det=517=0
288 Tick=1645 Det=527=0
289 Tick=1651 Det=526=0
290 Tick=1708 Det=513=1
291 Tick=1708 Det=515=0
292 Tick=1709 Det=514=0
293 Tick=1709 Det=516=1
294 Tick=1709 Det=516=1
295 Tick=1709 Det=515=0
296 Tick=1709 Det=514=0
297 Tick=1709 Det=513=1
298 Tick=1709 Det=518=0
299 Tick=1709 Det=518=0
300 Tick=1709 Det=519=0
301 Tick=1709 Det=519=0
302 Tick=1709 Det=520=0
303 Tick=1709 Det=520=0
304 Tick=1709 Det=517=0
305 Tick=1709 Det=517=0

3
Signaux_complexes_GL.dpr
View File

@@ -8,7 +8,7 @@ uses
UnitPilote in 'UnitPilote.pas' {FormPilote},
UnitSimule in 'UnitSimule.pas' {FormSimulation},
UnitTCO in 'UnitTCO.pas' {FormTCO},
listeusb in 'listeusb.pas';
UnitConfig in 'UnitConfig.pas' {FormConfig};
{$R *.res}
@@ -19,5 +19,6 @@ begin
Application.CreateForm(TFormPilote, FormPilote);
Application.CreateForm(TFormSimulation, FormSimulation);
Application.CreateForm(TFormTCO, FormTCO);
Application.CreateForm(TFormConfig, FormConfig);
Application.Run;
end.

BIN
Signaux_complexes_GL.exe
View File

Binary file not shown.

BIN
UnitConfig.dcu Normal file
View File

Binary file not shown.

228
UnitConfig.dfm Normal file
View File

@@ -0,0 +1,228 @@
object FormConfig: TFormConfig
Left = 316
Top = 238
Width = 598
Height = 332
Caption = 'Configuration g'#233'n'#233'rale'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnActivate = FormActivate
PixelsPerInch = 96
TextHeight = 13
object Label6: TLabel
Left = 104
Top = 232
Width = 332
Height = 13
Caption =
'Ces param'#232'tres ne sont pas modifi'#233's dans les fichiers de configu' +
'ration '
WordWrap = True
end
object LabelInfo: TLabel
Left = 14
Top = 192
Width = 3
Height = 16
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'Arial Narrow'
Font.Style = []
ParentFont = False
WordWrap = True
end
object GroupBox1: TGroupBox
Left = 8
Top = 8
Width = 265
Height = 89
Caption = 'CDM Rail'
TabOrder = 0
object Label1: TLabel
Left = 14
Top = 26
Width = 150
Height = 13
Caption = 'Adresse IP du serveur CDM rail '
end
object Label2: TLabel
Left = 14
Top = 50
Width = 115
Height = 13
Caption = 'Port du serveur CDM rail'
end
object EditAdrIPCDM: TEdit
Left = 176
Top = 24
Width = 81
Height = 21
TabStop = False
TabOrder = 0
Text = 'EditAdrIPCDM'
end
object EditPortCDM: TEdit
Left = 176
Top = 48
Width = 81
Height = 21
TabStop = False
TabOrder = 1
Text = 'EditPortCDM'
end
end
object GroupBox2: TGroupBox
Left = 280
Top = 8
Width = 290
Height = 137
Caption = 'Acc'#232's USB - S'#233'rie '#224' l'#39'interface vers la centrale LENZ'
TabOrder = 1
object Label3: TLabel
Left = 16
Top = 32
Width = 128
Height = 13
Caption = 'Protocole s'#233'rie USB (COM)'
end
object Label4: TLabel
Left = 16
Top = 56
Width = 126
Height = 26
Caption = 'Temporisation d'#39'envoi des octets de la trame (ms)'
WordWrap = True
end
object Label5: TLabel
Left = 16
Top = 88
Width = 152
Height = 26
Caption = 'Temporisation d'#39'attente de la r'#233'ponse de l'#39'interface (x 100 ms)'
WordWrap = True
end
object EditcomUSB: TEdit
Left = 160
Top = 32
Width = 121
Height = 21
TabStop = False
TabOrder = 0
Text = 'EditcomUSB'
end
object EditTempoOctetUSB: TEdit
Left = 232
Top = 64
Width = 49
Height = 21
TabStop = False
TabOrder = 1
Text = 'EditTempoOctetUSB'
end
object EditTempoReponse: TEdit
Left = 232
Top = 96
Width = 49
Height = 21
TabStop = False
TabOrder = 2
Text = 'EditTempoReponse'
end
end
object Button1: TButton
Left = 112
Top = 264
Width = 105
Height = 25
Caption = 'Appliquer et Fermer'
TabOrder = 2
OnClick = Button1Click
end
object GroupBox3: TGroupBox
Left = 8
Top = 104
Width = 265
Height = 81
Caption = 'Acc'#232's r'#233'seau '#224' l'#39'interface vers la centrale LENZ'
TabOrder = 3
object Label7: TLabel
Left = 14
Top = 24
Width = 95
Height = 13
Caption = 'Adresse IP interface'
end
object Label8: TLabel
Left = 14
Top = 50
Width = 82
Height = 13
Caption = 'Port de l'#39'interface'
end
object EditIPLenz: TEdit
Left = 176
Top = 24
Width = 81
Height = 21
TabStop = False
TabOrder = 0
Text = 'EditIPLenz'
end
object EditportLenz: TEdit
Left = 176
Top = 48
Width = 81
Height = 21
TabStop = False
TabOrder = 1
Text = 'EditportLenz'
end
end
object GroupBox4: TGroupBox
Left = 280
Top = 152
Width = 289
Height = 73
Caption = 'Ent'#234'te des trames vers l'#39'interface'
TabOrder = 4
object RadioButton1: TRadioButton
Left = 8
Top = 16
Width = 225
Height = 17
Caption = 'Sans ent'#234'te (interfaces s'#233'rie)'
TabOrder = 0
end
object RadioButton2: TRadioButton
Left = 8
Top = 32
Width = 225
Height = 17
Caption = 'Ent'#234'te FF FE (interfaces natives USB)'
TabOrder = 1
end
object RadioButton3: TRadioButton
Left = 8
Top = 48
Width = 265
Height = 17
Caption = 'Ent'#234'te E4 - Suffixe 0D 0D 0A (arduino XpressNet)'
TabOrder = 2
end
end
object Button2: TButton
Left = 336
Top = 264
Width = 113
Height = 25
Caption = 'Fermer sans appliquer'
TabOrder = 5
OnClick = Button2Click
end
end

305
UnitConfig.pas Normal file
View File

@@ -0,0 +1,305 @@
unit UnitConfig;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls ;
type
TFormConfig = class(TForm)
GroupBox1: TGroupBox;
Label1: TLabel;
EditAdrIPCDM: TEdit;
Label2: TLabel;
EditPortCDM: TEdit;
GroupBox2: TGroupBox;
Label3: TLabel;
EditcomUSB: TEdit;
Label4: TLabel;
EditTempoOctetUSB: TEdit;
Label5: TLabel;
EditTempoReponse: TEdit;
Button1: TButton;
GroupBox3: TGroupBox;
Label7: TLabel;
EditIPLenz: TEdit;
Label8: TLabel;
EditportLenz: TEdit;
GroupBox4: TGroupBox;
RadioButton1: TRadioButton;
RadioButton2: TRadioButton;
RadioButton3: TRadioButton;
Label6: TLabel;
LabelInfo: TLabel;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormActivate(Sender: TObject);
private
{ Déclarations privées }
public
{ Déclarations publiques }
end;
var
FormConfig: TFormConfig;
AdresseIPCDM,AdresseIP,PortCom,recuCDM : string;
portCDM,TempoOctet,TimoutMaxInterface,Valeur_entete,Port,protocole,NumPort : integer;
function config_com(s : string) : boolean;
function envoi_CDM(s : string) : boolean;
procedure connecte_CDM;
function place_id(s : string) : string;
implementation
uses UnitDebug,UnitPrinc;
{$R *.dfm}
// envoi d'une chaîne à CDM par socket, puis attend l'ack ou le nack
function envoi_CDM(s : string) : boolean;
var temps : integer;
begin
if parsocketCDM=false then begin envoi_CDM:=false;exit;end;
//Affiche('Envoi à CDM rail',clRed);Affiche(s,ClGreen);
Formprinc.ClientSocketCDM.Socket.SendText(s);
// attend l'ack
ackCDM:=false;nackCDM:=false;
if ParSocketCDM then
begin
temps:=0;
repeat
inc(temps);Sleep(100);
Application.processMessages;
until ferme or ackCDM or nackCDM or (temps>10); // CDM répond < 1s
if not(ackCDM) or nack then
begin
Affiche('Pas de réponse de CDM Rail',clRed);
end;
end;
envoi_CDM:=ackCDM;
end;
// insère l'id pour le serveur CDM dans une chaîne
function place_id(s : string) : string;
begin
delete(s,5,2);
insert(id_cdm,s,5);
place_id:=s;
end;
procedure connecte_CDM;
var s : string;
i : integer;
begin
// déconnexion de l'ancienne liaison éventuelle
Formprinc.ClientSocketCDM.Close;
// Initialisation de la comm socket CDM
ParSocketCDM:=false;
//if CDM_connecte then begin Affiche('CDM déja connecté',Cyan);exit;end;
if AdresseIPCDM<>'0' then
begin
// ouverture du socket CDM
with Formprinc do
begin
ClientSocketCDM.port:=portCDM;
ClientSocketCDM.Address:=AdresseIPCDM;
ClientSocketCDM.Open;
end;
i:=0;
repeat
Sleep(50);
inc(i);
Application.processMessages;
until (i>10) or ParSocketCDM;
if not(ParSocketCDM) then Affiche('Socket CDM non connecté',clOrange);
// connexion à CDM rail
recuCDM:='';
s:='C-C-00-0001-CMDGEN-_CNCT|000|';
envoi_cdm(s);
if pos('_ACK',recuCDM)<>0 then
begin
CDM_connecte:=True;
Id_CDM:=copy(recuCDM,5,2); // récupère l'ID reçu de CDM, à utiliser dans toutes les futures trames
s:='Connecté au serveur CDM rail avec l''ID='+Id_CDM;
Affiche(s,clYellow);
AfficheDebug(s,clyellow);
// demande des services : ATNT=aiguillages, ADET=détecteurs AACT=actionneurs
s:=place_id('C-C-00-0002-RQSERV-RTSIM|030|03|SRV=ATNT;SRV=ADET;SRV=AACT;');
envoi_CDM(s);
if pos('_ACK',recuCDM)<>0 then Affiche('Services acceptés: aiguillages - détecteurs - actionneurs',clYellow);
// demande les trains
////s:=place_id('C-C-01-0002-DSCTRN-DLOAD|000|');
//envoi_CDM(s);
end;
end
else
begin
Affiche('La connexion à CDM n''est pas demandée car l''adresse IP est nulle dans config.cfg',cyan);
end;
end;
function Ipok(s : string) : boolean;
var i,posp,n,octet,erreur : integer;
begin
n:=0;
for i:=1 to length(s) do
begin
posp:=pos('.',s);
if posp<>0 then
begin
inc(n);
val(s,octet,erreur);
if octet>255 then begin IpOK:=false;exit;end;
delete(s,1,posp);
end;
end;
val(s,octet,erreur);
if octet>255 then begin IpOK:=false;exit;end;
IpOk:=n=3;
end;
function config_com(s : string) : boolean;
var sa : string;
j,i,erreur : integer;
begin
sa:=s;
protocole:=-1;
// supprimer la dernier paramètre
i:=pos(',',s);
if i<>0 then
begin
delete(s,1,i);
j:=i;
i:=pos(',',s);
j:=j+i;
if i<>0 then
begin
delete(s,1,i);
i:=pos(',',s);
j:=j+i;
if i<>0 then
begin
delete(s,1,i);
i:=pos(',',s);
j:=j+i;
if i<>0 then
begin
delete(s,1,i);
Val(s,protocole,erreur);
end;
end;
end;
end;
i:=pos(':',sa);
val(copy(sa,4,i-1),Numport,erreur);
config_com:=not( (NumPort>9) or (protocole=-1) or (protocole>4) or (i=0) );
end;
procedure TFormConfig.Button1Click(Sender: TObject);
var i,erreur : integer;
s : string;
ChangeCDM,changeInterface,changeUSB : boolean;
begin
// contrôle adresse IP CDM
s:=EditAdrIPCDM.text;
if not(IpOk(s)) then begin labelInfo.Caption:='Adresse IP CDM rail incorrecte';exit;end;
ChangeCDM:=s<>AdresseIPCDM;
adresseIPCDM:=s;
// contrôle port CDM
val(EditPortCDM.Text,i,erreur);
if i>65535 then begin labelInfo.Caption:='Port CDM rail incorrect';exit;end;
changeCDM:=(portCDM<>i) or ChangeCDM;
portCDM:=i;
// contrôle adresse IP interface
s:=EditIPLenz.text;
if not(IpOk(s)) then begin labelInfo.Caption:='Adresse IP Lenz incorrecte';exit;end;
changeInterface:=s<>AdresseIP;
AdresseIP:=s;
// contrôle port interface
val(EditPortLenz.Text,i,erreur);
if i>65535 then begin labelInfo.Caption:='Port Interface incorrect';exit;end;
changeInterface:=changeInterface or (i<>port);
port:=i;
// contrôle protocole interface COM3:57600,N,8,1,2
s:=EditComUSB.Text;
if not(config_com(s)) then begin labelInfo.Caption:='Protocole série USB Interface incorrect';exit;end;
changeUSB:=portcom<>s;
portcom:=s;
val(EditTempoOctetUSB.text,i,erreur);
if erreur<>0 then begin labelInfo.Caption:='Valeur temporisation octet incorrecte';exit;end;
TempoOctet:=i;
val(EditTempoReponse.text,i,erreur);
if erreur<>0 then begin labelInfo.Caption:='Valeur temporisation de réponse interface';exit;end;
TimoutMaxInterface:=i;
if RadioButton1.checked then Valeur_entete:=0;
if RadioButton2.checked then Valeur_entete:=1;
if RadioButton3.checked then Valeur_entete:=2;
if changeCDM then connecte_CDM;
if changeInterface then
begin
if AdresseIP<>'0' then
begin
Affiche('demande connexion à la centrale Lenz par Ethernet',clyellow);
With Formprinc do
begin
ClientSocketLenz.port:=port;
ClientSocketLenz.Address:=AdresseIP;
ClientSocketLenz.Open;
end;
end
end;
if changeUSB then
begin
deconnecte_USB;
connecte_USB;
end;
formConfig.close;
end;
procedure TFormConfig.Button2Click(Sender: TObject);
begin
close;
end;
procedure TFormConfig.FormActivate(Sender: TObject);
begin
EditAdrIPCDM.text:=adresseIPCDM;
EditPortCDM.Text:=IntToSTR(portCDM);
EditIPLenz.text:=AdresseIP;
EditportLenz.text:=IntToSTR(Port);
EditComUSB.Text:=PortCom;
EditTempoOctetUSB.text:=IntToSTR(TempoOctet);
EditTempoReponse.Text:=IntToSTR(TimoutMaxInterface);
RadioButton1.checked:=false;
RadioButton2.checked:=false;
RadioButton3.checked:=false;
if Valeur_entete=0 then RadioButton1.checked:=true;
if Valeur_entete=1 then RadioButton2.checked:=true;
if Valeur_entete=2 then RadioButton3.checked:=true;
LabelInfo.Width:=253;LabelInfo.Height:=25;
if Valeur_entete=0 then RadioButton1.checked:=true;
if Valeur_entete=1 then RadioButton2.checked:=true;
if Valeur_entete=2 then RadioButton3.checked:=true;
end;
end.

BIN
UnitDebug.dcu
View File

Binary file not shown.

42
UnitDebug.dfm
View File

@@ -4,7 +4,7 @@ object FormDebug: TFormDebug
BorderStyle = bsSingle
Caption = 'Fen'#234'tre de d'#233'bug'
ClientHeight = 639
ClientWidth = 759
ClientWidth = 789
Color = clWhite
TransparentColorValue = clTeal
Font.Charset = DEFAULT_CHARSET
@@ -49,7 +49,7 @@ object FormDebug: TFormDebug
object Label3: TLabel
Left = 448
Top = 136
Width = 105
Width = 97
Height = 225
AutoSize = False
Caption = 'Label3'
@@ -79,9 +79,9 @@ object FormDebug: TFormDebug
OnKeyPress = EditNivDebugKeyPress
end
object MemoEvtDet: TMemo
Left = 560
Left = 552
Top = 368
Width = 185
Width = 233
Height = 221
Color = clBlack
Font.Charset = ANSI_CHARSET
@@ -149,28 +149,13 @@ object FormDebug: TFormDebug
TabOrder = 6
OnClick = ButtonChercheClick
end
object MemoDet: TMemo
Left = 560
Top = 136
Width = 185
Height = 225
Color = clMaroon
Font.Charset = ANSI_CHARSET
Font.Color = clYellow
Font.Height = -11
Font.Name = 'Arial'
Font.Style = []
ParentFont = False
ScrollBars = ssVertical
TabOrder = 7
end
object ButtonAffEvtChrono: TButton
Left = 448
Top = 440
Width = 97
Height = 33
Caption = 'Affiche Evts chrono d'#233'tecteurs'
TabOrder = 8
TabOrder = 7
WordWrap = True
OnClick = ButtonAffEvtChronoClick
end
@@ -187,7 +172,7 @@ object FormDebug: TFormDebug
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
TabOrder = 9
TabOrder = 8
OnClick = CheckAffAffecTrainsClick
end
object CheckBoxTraceLIste: TCheckBox
@@ -202,7 +187,7 @@ object FormDebug: TFormDebug
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
TabOrder = 10
TabOrder = 9
OnClick = CheckBoxTraceLIsteClick
end
object CheckTrame: TCheckBox
@@ -217,7 +202,7 @@ object FormDebug: TFormDebug
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
TabOrder = 11
TabOrder = 10
OnClick = CheckTrameClick
end
object ButtonCop: TButton
@@ -226,10 +211,19 @@ object FormDebug: TFormDebug
Width = 97
Height = 49
Caption = 'Copie fen'#234'te principale dans debug'
TabOrder = 12
TabOrder = 11
WordWrap = True
OnClick = ButtonCopClick
end
object RichEdit: TRichEdit
Left = 552
Top = 120
Width = 225
Height = 241
HideScrollBars = False
ScrollBars = ssVertical
TabOrder = 12
end
object SaveDialog: TSaveDialog
Left = 680
Top = 8

27
UnitDebug.pas
View File

@@ -19,12 +19,12 @@ type
CheckAffSig: TCheckBox;
ButtonRazTampon: TButton;
ButtonCherche: TButton;
MemoDet: TMemo;
ButtonAffEvtChrono: TButton;
CheckAffAffecTrains: TCheckBox;
CheckBoxTraceLIste: TCheckBox;
CheckTrame: TCheckBox;
ButtonCop: TButton;
RichEdit: TRichEdit;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure ButtonEcrLogClick(Sender: TObject);
@@ -48,7 +48,7 @@ Const Max_Event_det_tick = 10000;
var
FormDebug: TFormDebug;
NivDebug : integer;
AffSignal,AffAffect : boolean;
AffSignal,AffAffect,initform : boolean;
N_event_det : integer; // index du dernier évènement (de 1 à 20)
event_det : array[1..20] of integer;
// tick 1/10s,détecteur
@@ -59,7 +59,7 @@ var
record
tick : longint;
detecteur : array[1..1100] of integer; // état du détecteur [...]
train : integer ;
//train : integer ;
suivant : integer ; // d'ou vient le train
traite : boolean; // traité lors de a recherche d'une route
end;
@@ -68,6 +68,7 @@ var
procedure AfficheDebug(s : string;lacouleur : TColor);
procedure RE_ColorLine(ARichEdit: TRichEdit; ARow: Integer; AColor: TColor);
implementation
@@ -87,8 +88,20 @@ begin
//NivDebug:=0;
end;
procedure RE_ColorLine(ARichEdit: TRichEdit; ARow: Integer; AColor: TColor);
begin
with ARichEdit do
begin
SelStart := SendMessage(Handle, EM_LINEINDEX, ARow - 1, 0);
SelLength := Length(Lines[ARow - 1]);
SelAttributes.Color := AColor;
SelLength := 0;
end;
end;
procedure TFormDebug.FormCreate(Sender: TObject);
var s: string;
i : integer;
begin
EditNivDebug.Text:='0';
s:='Cette fenêtre permet d''afficher des informations sur le ';
@@ -96,7 +109,13 @@ begin
s:=s+' afficher des informations plus ou moins détaillées.';
Label3.caption:=s;
MemoDebug.color:=$33;
initform:=false;
MemoDebug.clear;
s:=DateToStr(date)+' '+TimeToStr(Time)+' ';
if IsWow64Process then s:=s+' OS 64 Bits' else s:=s+' OS 32 Bits';
RichEdit.color:=$111122;
MemoDebug.Lines.add(s);
end;
procedure TFormDebug.ButtonEcrLogClick(Sender: TObject);
@@ -215,4 +234,6 @@ begin
MemoDebug.Lines:=Formprinc.ListBox1.Items
end;
end.

BIN
UnitPrinc.dcu
View File

Binary file not shown.

82
UnitPrinc.dfm
View File

@@ -1,6 +1,6 @@
object FormPrinc: TFormPrinc
Left = 58
Top = 238
Left = 47
Top = 193
AutoSize = True
BorderStyle = bsSingle
Caption = 'Client TCP-IP CDM Rail ou USB - syst'#232'me LENZ'
@@ -1198,6 +1198,26 @@ object FormPrinc: TFormPrinc
0000}
Visible = False
end
object Label1: TLabel
Left = 656
Top = 116
Width = 89
Height = 13
Caption = 'Nombre de trains : '
end
object LabelNbTrains: TLabel
Left = 760
Top = 112
Width = 9
Height = 19
Caption = '0'
Font.Charset = ANSI_CHARSET
Font.Color = clBlack
Font.Height = -16
Font.Name = 'Arial'
Font.Style = [fsBold]
ParentFont = False
end
object BoutVersion: TButton
Left = 1008
Top = 16
@@ -1328,33 +1348,8 @@ object FormPrinc: TFormPrinc
Width = 81
Height = 33
Caption = 'Informations'
TabOrder = 7
OnClick = ButtonInfoClick
end
object GroupBox2: TGroupBox
Left = 982
Top = 87
Width = 211
Height = 46
Caption = 'Trains'
TabOrder = 6
Visible = False
object Label1: TLabel
Left = 16
Top = 20
Width = 89
Height = 13
Caption = 'Nombre de trains : '
end
object EditNbTrains: TEdit
Left = 112
Top = 16
Width = 89
Height = 21
TabOrder = 0
Text = 'EditNbTrains'
OnKeyPress = EditNbTrainsKeyPress
end
OnClick = ButtonInfoClick
end
object StatusBar1: TStatusBar
Left = 0
@@ -1380,7 +1375,7 @@ object FormPrinc: TFormPrinc
Width = 75
Height = 33
Caption = 'loco'
TabOrder = 10
TabOrder = 9
OnClick = locoClick
end
object ButtonAffDebug: TButton
@@ -1389,7 +1384,7 @@ object FormPrinc: TFormPrinc
Width = 89
Height = 33
Caption = 'Affiche debug'
TabOrder = 11
TabOrder = 10
OnClick = ButtonAffDebugClick
end
object ButtonReprise: TButton
@@ -1401,34 +1396,34 @@ object FormPrinc: TFormPrinc
'Relance du bus DCC apr'#232's une '#233'criture d'#39'un CV ou une mise hors t' +
'ension de la centrale'
Caption = 'Reprise DCC'
TabOrder = 12
TabOrder = 11
OnClick = ButtonRepriseClick
end
object EditGenli: TEdit
Left = 656
Top = 112
Left = 880
Top = 160
Width = 121
Height = 21
TabOrder = 13
TabOrder = 12
Visible = False
end
object Button1: TButton
Left = 784
Top = 112
Left = 1064
Top = 216
Width = 113
Height = 25
Caption = 'Envoi vers Genli'
TabOrder = 14
TabOrder = 13
Visible = False
OnClick = Button1Click
end
object Button2: TButton
Left = 1040
Top = 80
Left = 992
Top = 96
Width = 97
Height = 25
Caption = 'Demande '#233'tat CTS'
TabOrder = 15
TabOrder = 14
Visible = False
OnClick = Button2Click
end
@@ -1525,6 +1520,11 @@ object FormPrinc: TFormPrinc
end
object Divers1: TMenuItem
Caption = 'Divers'
object Config: TMenuItem
Caption = 'Configuration'
Hint = 'Modifie les variables de configuration sans sauvegarde'
OnClick = ConfigClick
end
object FichierSimu: TMenuItem
Caption = 'Ouvrir un fichier de simulation'
Hint =
@@ -1568,7 +1568,7 @@ object FormPrinc: TFormPrinc
end
object OpenDialog: TOpenDialog
Left = 1080
Top = 88
Top = 104
end
object SaveDialog: TSaveDialog
Left = 1120

496
UnitPrinc.pas
View File

@@ -15,8 +15,8 @@ interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, OleCtrls, ExtCtrls, jpeg, ComCtrls, ListeUSB,
ImgList, ScktComp, StrUtils, Menus, ActnList, MSCommLib_TLB ;
Dialogs, StdCtrls, OleCtrls, ExtCtrls, jpeg, ComCtrls,
ImgList, ScktComp, StrUtils, Menus, ActnList, MSCommLib_TLB , unitConfig ;
type
TFormPrinc = class(TForm)
@@ -35,7 +35,6 @@ type
ButtonCommande: TButton;
ButtonTest: TButton;
ButtonInfo: TButton;
GroupBox2: TGroupBox;
MainMenu1: TMainMenu;
Interface1: TMenuItem;
MenuConnecterUSB: TMenuItem;
@@ -73,8 +72,6 @@ type
Versions1: TMenuItem;
ChronoDetect: TMenuItem;
ClientSocketCDM: TClientSocket;
Label1: TLabel;
EditNbTrains: TEdit;
FichierSimu: TMenuItem;
ButtonEcrCV: TButton;
ButtonReprise: TButton;
@@ -88,6 +85,9 @@ type
EditGenli: TEdit;
Button1: TButton;
Button2: TButton;
Config: TMenuItem;
Label1: TLabel;
LabelNbTrains: TLabel;
procedure FormCreate(Sender: TObject);
procedure MSCommUSBLenzComm(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
@@ -130,7 +130,6 @@ type
procedure ClientSocketLenzDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ChronoDetectClick(Sender: TObject);
procedure EditNbTrainsKeyPress(Sender: TObject; var Key: Char);
procedure FichierSimuClick(Sender: TObject);
procedure ButtonEcrCVClick(Sender: TObject);
procedure ButtonRepriseClick(Sender: TObject);
@@ -139,6 +138,7 @@ type
procedure Quitter1Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure ConfigClick(Sender: TObject);
private
{ Déclarations privées }
@@ -159,6 +159,7 @@ const_droit=2;const_devieD=1; // positions transmises par la centrale LENZ
const_devieG=3;
MaxElParcours=4000;
EtatSign : array[0..13] of string[20] =('carré','sémaphore','sémaphore cli','vert','vert cli','violet',
'blanc','blanc cli','jaune','jaune cli','ral 30','ral 60','rappel 30','rappel 60');
@@ -204,42 +205,51 @@ TMA = (valide,devalide);
var ancien_tablo_signalCplx,EtatsignalCplx : array[0..MaxAcc] of word;
AvecInitAiguillages,tempsCli,combine,NbreFeux,pasreponse,AdrDevie,precedent ,
NombreImages,signalCpx,branche_trouve,Indexbranche_trouve,Actuel,Signal_suivant,
Nbre_recu_cdm,Tempo_chgt_feux,Adj1,Adj2,protocole,TempoOctet,TimoutMaxInterface : integer;
Nbre_recu_cdm,Tempo_chgt_feux,Adj1,Adj2,protocole : integer;
Hors_tension2,traceSign,TraceZone,Ferme,parSocket,ackCdm,
NackCDM,MsgSim : boolean;
TraceListe,clignotant,nack,Maj_feux_cours : boolean;
branche : array [1..100] of string;
Train : array [1..100,1..MaxElParcours] of integer;
const
ClBleuClair=$FF7070 ;
Cyan=$FFA0A0;
clviolet=$FF00FF;
//GrisF=$333333;
GrisF=$414141;
clOrange=$0077FF;
Feu_X=50;Feu_Y=91;
couleurTrain : array[1..8] of Tcolor = (clYellow,clLime,clOrange,clAqua,clFuchsia,clLtGray,clred,clWhite);
var
FormPrinc: TFormPrinc;
ack,portCommOuvert,trace,AffMem,AfficheDet,CDM_connecte,parSocketCDM,
DebugOuv,Raz_Acc_signaux,AvecInit,AvecTCO,terminal : boolean;
tablo : array of byte;
Enregistrement,AdresseIP,chaine_Envoi,chaine_recue,AdresseIPCDM,recuCDM,Id_CDM,Af,
ConfStCom,entete,suffixe : string;
maxaiguillage,detecteur_chgt,Temps,TpsRecuCom,NumPort,Tempo_init,Suivant,TypeGen,
NbreImagePligne,Port,NbreBranches,Index2_det,branche_det,Index_det,
portCDM,I_simule : integer;
Enregistrement,chaine_Envoi,chaine_recue,Id_CDM,Af,
entete,suffixe,ConfStCom : string;
maxaiguillage,detecteur_chgt,Temps,TpsRecuCom,Tempo_init,Suivant,TypeGen,
NbreImagePligne,NbreBranches,Index2_det,branche_det,Index_det,
I_simule : integer;
Ancien_detecteur,detecteur : array[0..1024] of boolean; // anciens état des détecteurs et adresses des détecteurs et leur état
Adresse_detecteur : array[0..60] of integer; // adresses des détecteurs par index
mem : array[0..1024] of boolean ; // mémoire des états des détecteurs
MemZone : array[0..1024,0..1024] of boolean ; // mémoires de zones
Train : array[1..30] of record
index : integer ; // nombre de routes pour ce train
route : array[1..2000] of record
Mem1,Mem2 : integer;
end;
end;
Tablo_Simule : array[0..200] of
record
tick : longint;
Detecteur,etat : integer ;
end;
N_Cv,index_simule,NDetecteurs,N_Trains : integer;
Route : array[1..2000] of record
Mem1,Mem2 : integer;
end;
N_Cv,index_simule,NDetecteurs,N_Trains,N_routes : integer;
tablo_CV : array [1..255] of integer;
couleur : Tcolor;
fichier : text;
@@ -285,7 +295,7 @@ var
{$R *.dfm}
// utilisation dans unité UnitPilote
// utilisation dans unité UnitPilote et configunit
function Index_feu(adresse : integer) : integer;
procedure dessine_feu2(Acanvas : Tcanvas;EtatSignal : word);
procedure dessine_feu3(Acanvas : Tcanvas;EtatSignal : word);
@@ -302,6 +312,9 @@ procedure Maj_Etat_Signal(adresse,aspect : integer);
procedure Affiche(s : string;lacouleur : TColor);
procedure envoi_signal(Adr : integer);
procedure pilote_direction(Adr,nbre : integer);
procedure connecte_USB;
procedure deconnecte_usb;
function IsWow64Process: Boolean;
implementation
@@ -1023,13 +1036,7 @@ begin
envoi:=ack;
end;
// insère l'id pour le serveur CDM dans une chaîne
function place_id(s : string) : string;
begin
delete(s,5,2);
insert(id_cdm,s,5);
place_id:=s;
end;
// prépare la chaîne de commande pour un accessoire via CDM
Function chaine_CDM_Acc(adresse,etat1 : integer) : string;
@@ -1059,28 +1066,7 @@ begin
chaine_CDM_Acc:=so+s;
end;
// envoi d'une chaîne à CDM par socket, puis attend l'ack ou le nack
function envoi_CDM(s : string) : boolean;
var temps : integer;
begin
if parsocketCDM=false then begin envoi_CDM:=false;exit;end;
//if NivDebug=3 then begin AfficheDebug('Envoi à CDM rail',clRed);afficheDebug(s,ClGreen);end;
Formprinc.ClientSocketCDM.Socket.SendText(s);
// attend l'ack
ackCDM:=false;nackCDM:=false;
if ParSocketCDM then
begin
temps:=0;
repeat
inc(temps);tempo(1);
until ferme or ackCDM or nackCDM or (temps>2); // CDM répond < 1s
if not(ackCDM) or nack then
begin
Affiche('Pas de réponse de CDM Rail',clRed);
end;
end;
envoi_CDM:=ackCDM;
end;
// active ou désactive une sortie. Une adresse comporte deux sorties identifiées par "octet"
// Adresse : adresse de l'accessoire
@@ -1298,6 +1284,8 @@ begin
if (EtatSignalCplx[adr]<>code) then
begin
if (traceSign) then Affiche('Signal directionnel: ad'+IntToSTR(adr)+'='+intToSTR(code),clOrange);
if AffSignal then AfficheDebug('Signal directionnel: ad'+IntToSTR(adr)+'='+intToSTR(code),clOrange);
case code of
0 : begin pilote_acc(adr,1,feu); // sortie 1 à 0
sleep(tempoFeu);
@@ -1344,6 +1332,7 @@ begin
if (EtatSignalCplx[adr]<>code) then
begin
if traceSign then Affiche('signal directionnel CDF: '+IntToSTR(adr)+' '+intToSTR(code),ClOrange);
if AffSignal then AfficheDebug('signal directionnel CDF: '+IntToSTR(adr)+' '+intToSTR(code),ClOrange);
case code of
// éteindre toutes les leds
@@ -1379,6 +1368,8 @@ begin
if (EtatSignalCplx[adr]<>code) then
begin
if traceSign then Affiche('signal directionnel LEB: '+IntToSTR(adr)+' '+intToSTR(code),ClOrange);
if aFFsIGNAL then AfficheDebug('signal directionnel LEB: '+IntToSTR(adr)+' '+intToSTR(code),ClOrange);
case code of
0 : begin pilote_acc(adr+5,2,feu) ; pilote_acc(adr+6,2,feu) ;end; //00
1 : begin pilote_acc(adr+5,1,feu) ; pilote_acc(adr+6,2,feu) ;end; //10
@@ -1402,6 +1393,8 @@ begin
ancien_tablo_signalCplx[adresse]:=EtatSignalCplx[adresse];
aspect:=code_to_aspect(code);
if traceSign then affiche('Signal CDF: '+intToSTR(adresse)+' '+intToSTR(code),clOrange);
if Affsignal then afficheDebug('Signal CDF: '+intToSTR(adresse)+' '+intToSTR(code),clOrange);
if (aspect=carre) then pilote_acc(adresse,2,feu) ;
if (aspect=semaphore) then pilote_acc(adresse,1,feu) ;
@@ -1452,6 +1445,14 @@ begin
if Combine<>0 then s:=s+' + '+etatSign[combine];
Affiche(s,clOrange);
end;
if AffSignal then
begin
s:='Signal LEB: ad'+IntToSTR(adr)+'='+etatSign[aspect];
//s:='Signal LEB: ad'+IntToSTR(adr)+' aspect='+intToSTR(aspect)+' combine='+intToSTR(combine);
if Combine<>0 then s:=s+' + '+etatSign[combine];
AfficheDebug(s,clOrange);
end;
Sleep(60); // si le feu se positionne à la suite d'un positionnement d'aiguillage, on peut avoir le message station occupée
if (Combine=0) then
@@ -1532,6 +1533,12 @@ begin
if Combine<>0 then s:=s+' + '+etatSign[combine];
Affiche(s,clOrange);
end;
if AffSignal then
begin
s:='Signal NMRA: ad'+IntToSTR(adresse)+'='+etatSign[aspect];
if Combine<>0 then s:=s+' + '+etatSign[combine];
AfficheDebug(s,clOrange);
end;
if combine=0 then
case (code) of
@@ -1588,7 +1595,13 @@ begin
if Combine<>0 then s:=s+' + '+etatSign[combine];
Affiche(s,clOrange);
end;
if AffSignal then
begin
s:='Signal UniSemaf: ad'+IntToSTR(adresse)+'='+etatSign[code];
if Combine<>0 then s:=s+' + '+etatSign[combine];
AfficheDebug(s,clOrange);
end;
// pour Unisemaf, la cible est définie dans le champ Unisemaf de la structure feux
modele:=feux[index].Unisemaf;
@@ -1881,6 +1894,8 @@ begin
ancien_tablo_signalCplx[adr]:=EtatSignalCplx[adr];
//if (tempo_ACC>0) then sleep(100); // les commandes entre 2 feux successives doivent être séparées au minimum de 100 ms
if traceSign then affiche('Signal LDT: '+IntToSTR(adr)+' '+intToSTR(mode)+' '+intTOSTR(codebin),clOrange);
if AffSignal then afficheDebug('Signal LDT: '+IntToSTR(adr)+' '+intToSTR(mode)+' '+intTOSTR(codebin),clOrange);
if (aspect=semaphore) or (aspect=vert) or (aspect=carre) or (aspect=jaune) then mode:=1 else mode:=2;
case mode of
@@ -1928,6 +1943,7 @@ begin
ancien_tablo_signalCplx[adresse]:=EtatSignalCplx[adresse];
aspect:=code_to_aspect(code); // transforme le motif de bits en numéro "code des aspects des signaux"
if (tracesign) then Affiche('Signal virtuel: ad'+intToSTR(adresse)+'='+etatSign[aspect],clOrange);
if AffSignal then AfficheDebug('Signal virtuel: ad'+intToSTR(adresse)+'='+etatSign[aspect],clOrange);
dessine_feu(adresse);
end;
end;
@@ -1959,6 +1975,12 @@ begin
if CombineLoc<>0 then s:=s+' + '+etatSign[combineLoc];
Affiche(s,clOrange);
end;
if AffSignal then
begin
s:='Signal bahn: ad'+IntToSTR(adresse)+'='+etatSign[aspect];
if CombineLoc<>0 then s:=s+' + '+etatSign[combineLoc];
AfficheDebug(s,clOrange);
end;
// spécifique au décodeur digital bahn:
// si le signal affichait un signal combiné, il faut éteindre le signal avec un sémaphore
// avant d'afficher le nouvel état non combiné
@@ -3017,40 +3039,8 @@ begin
// adresse ip et port de la centrale
// AfficheDet:=true;
s:=lit_ligne;
i:=pos(':',s);
if i<>0 then begin adresseIP:=copy(s,1,i-1);Delete(s,1,i);port:=StrToINT(s);end
else begin adresseIP:='0';parSocket:=false;end;
// configuration du port com
s:=lit_ligne; // COM3:57600,N,8,1,2
sa:=s;
protocole:=-1;
// supprimer la dernier paramètre
i:=pos(',',s);
if i<>0 then
begin
delete(s,1,i);
j:=i;
i:=pos(',',s);
j:=j+i;
if i<>0 then
begin
delete(s,1,i);
i:=pos(',',s);
j:=j+i;
if i<>0 then
begin
delete(s,1,i);
i:=pos(',',s);
j:=j+i;
if i<>0 then
begin
delete(s,1,i);
Val(s,protocole,erreur);
end;
end;
end;
end;
i:=pos(':',s);
if i<>0 then begin adresseIP:=copy(s,1,i-1);Delete(s,1,i);port:=StrToINT(s);end
else begin adresseIP:='0';parSocket:=false;end;
// configuration du port com
@@ -3064,14 +3054,14 @@ begin
if erreur<>0 then Affiche('Erreur temporisation entre 2 octets',clred);
// temporisation attente maximale interface
s:=lit_ligne;
s:=lit_ligne;
val(s,TimoutMaxInterface,erreur);
if erreur<>0 then Affiche('Erreur temporisation maximale interface',clred);
if erreur<>0 then Affiche('Erreur temporisation maximale interface',clred);
//entete
s:=lit_ligne;
val(s,Valeur_entete,erreur);
entete:='';
entete:='';
case Valeur_entete of
0 : begin entete:='';suffixe:='';end;
1 : begin entete:=#$FF+#$FE;suffixe:='';end;
@@ -4890,17 +4880,18 @@ end;
// transmis dans le tableau Event_det
// Variable globale: El_suivant : adresse du détecteur suivant le détecteur "actuel"
// Actuel,Suivant : nouveaux détecteurs du canton suivant
// Résultat:
// si 0 : pas de route
// si 1 : détecteur det1 non trouvé
// si 2 : détecteur det2 non trouvé
// si 3 : erreur fatale
// si 3 : erreur fatale
// si 10 : ok route trouvée
function calcul_zones_det(det1,det2 : integer) : integer;
function calcul_zones_det(det1,det2 : integer) : integer;
var
i,i1,i2,j,k,IndexBranche_det1,IndexBranche_det2,index_i1,index_i2,
branche_trouve_det1,branche_trouve_det2,Adr,AdrPrec,position,Btype,BTypePrec,
AdrFonc,TypePrec,TypeSuiv,TypeFonc,AdrSuiv : integer;
branche_trouve_det1,branche_trouve_det2,Adr,AdrPrec,position,Btype,BTypePrec,
AdrFonc,TypePrec,TypeSuiv,TypeFonc,AdrSuiv,Train_Courant : integer;
t,sortie,trouve : boolean;
s,ss : string;
@@ -4960,8 +4951,10 @@ begin
TypeSuiv:=Btype; // si aiguillage bis
//Affiche(intToSTR(adr)+'/'+intToStr(Btype),clorange);
AdrPrec:=AdrFonc;AdrFonc:=Adr;
TypePrec:=TypeFonc;TypeFonc:=typeGen;
i:=i+1;
TypePrec:=TypeFonc;TypeFonc:=typeGen;
i:=i+1;
sortie:=(Btype=1) or (Btype=4) or (i=20) or (Adr=0);
until (sortie) ; // boucle de parcours
end;
if (i=20) then
@@ -4985,8 +4978,8 @@ begin
begin
// trouvé la route si j=2 : - si j=3 : +
if (TraceListe) then AfficheDebug('Route trouvée',clyellow);
AdrSuiv:=detecteur_suivant_El(det1,1,det2,1);
AdrSuiv:=detecteur_suivant_El(det1,1,det2,1);
AdrPrec:=detecteur_suivant_El(det2,1,det1,1);
// le train vient de det1, quitte det2 et va vers Adr
@@ -5014,15 +5007,59 @@ begin
if TraceListe then AfficheDebug('route ok car '+IntToStr(AdrPrec)+'=0 à l''index '+intToSTR(i),clyellow);
Mem[AdrPrec]:=false; // inutile
//marquer l'adresse précédente comme traitée
//marquer l'adresse précédente comme traitée
event_det_tick[i].traite:=true;
if traceListe then AfficheDebug('Mise à 1 mémoire traitée pour l''index '+intToSTR(i),clyellow);
MemZone[det1,det2]:=FALSE; // efface zone précédente
MemZone[det2,AdrSuiv]:=TRUE; // valide la nouveau zone
//if N_trains=0 then inc(N_trains);
// ajouter la route dans le tableau des routes
if N_routes<2000 then inc(N_routes);
Route[N_routes].Mem1:=det2;Route[N_routes].Mem2:=AdrSuiv;
// affecter la route à un train
if N_trains=0 then N_trains:=1;
// premier train
if (N_trains=1) and (Train[1].index=0) then
begin
Train[1].index:=1;Train[1].route[1].Mem1:=det2;Train[1].route[1].Mem2:=AdrSuiv;
if traceListe then AfficheDebug('Mise à 1 mémoire traitée pour l''index '+intToSTR(i),clyellow);
MemZone[det1,det2]:=FALSE; // efface zone précédente
Train_Courant:=1;
//FormDebug.MemoDet.lines.add('Premier train');
Formprinc.LabelNbTrains.caption:='1';
end
else
begin
// parcourir les trains pour voir si det2 correspond à la derniere route du train exploré
i:=1;
repeat
j:=Train[i].index;
trouve:=Train[i].route[j].mem2=det2 ;
inc(i);
until (i>N_Trains) or trouve;
if trouve then
begin
dec(i);
//FormDebug.MemoDet.lines.add('route train '+intToSTR(i));
train_courant:=i;
inc(j);
Train[i].index:=j;Train[i].route[j].Mem1:=det2;Train[i].route[j].Mem2:=AdrSuiv;
end
else
// nouveau train
begin
//FormDebug.MemoDet.lines.add('Nouveau train');
With FormDebug.MemoDet do
begin
inc(N_Trains);
Train[N_trains].index:=1;Train[N_trains].route[1].Mem1:=det2;Train[N_trains].route[1].Mem2:=AdrSuiv;
Train_courant:=N_trains;
Formprinc.LabelNbTrains.caption:=IntToSTR(N_trains);
end;
end;
With FormDebug.RichEdit do
begin
s:='train '+IntToSTR(Train_Courant)+' '+intToStr(det1)+' à '+intToStr(det2)+' => Mem '+IntToSTR(det2)+' à '+IntTOStr(AdrSuiv);
Lines.Add(s);
RE_ColorLine(FormDebug.RichEdit,lines.count,CouleurTrain[((Train_Courant - 1) mod 8)+1 ]);
end;
@@ -5034,12 +5071,12 @@ begin
repeat
trouve:=Event_det[i]=Det1;
if not(trouve) then inc(i);
until (i>N_event_det) or trouve;
until (i>N_event_det) or trouve;
if trouve then
begin
supprime_event(i);
supprime_event(i);
if TraceListe then AfficheDebug('Efface index '+IntToSTR(i),clyellow);
end;
end;
calcul_zones_det:=10; // route trouvée et cohérente
exit;
@@ -5063,8 +5100,7 @@ var i,j,k1,k2,BtypeSuiv,Adr_det,etat,Adr,Aig,DetPrec1,DetPrec2,Detprec3,Detprec4
// mise à jour de l'état d'un feu en fontion de son environnement et affiche le feu
procedure Maj_Feu(Adrfeu : integer);
var i,j,k1,k2,BtypeSuiv,Adr_det,etat,Adr,Aig,DetPrec1,DetPrec2,Detprec3,Detprec4,Adr_El_Suiv,
Btype_el_suivant,det_initial,bt,el_suiv,modele : integer ;
var i,j,k1,k2,BtypeSuiv,Adr_det,etat,Adr,Aig,DetPrec1,DetPrec2,Detprec3,Detprec4,Adr_El_Suiv,
Btype_el_suivant,det_initial,bt,el_suiv,modele : integer ;
PresTrain,Aff_semaphore,car : boolean;
s : string;
@@ -5086,13 +5122,13 @@ begin
Signal_direction(AdrFeu);
exit;
end;
etat:=etat_signal_suivant(AdrFeu,1) ; // état du signal suivant + adresse du signal suivant dans Signal_Suivant
// signaux traités spécifiquement
if (AdrFeu=201) then
begin
//sprintf(Affiche,"Aiguille 27=%d \r\n",aiguillage[27].position);Display(Affiche);
etat:=etat_signal_suivant(AdrFeu,1) ; // état du signal suivant + adresse du signal suivant dans Signal_Suivant
// signaux traités spécifiquement
if (AdrFeu=201) then
begin
//sprintf(Affiche,"Aiguille 27=%d \r\n",aiguillage[27].position);Display(Affiche);
// sprintf(Affiche,"Aiguille 31=%d \r\n",aiguillage[31].position);Display(Affiche);
if ((aiguillage[28].position<>const_droit) and (aiguillage[29].position<>const_droit) and
(aiguillage[31].position=2)) then // attention spécial
@@ -5109,22 +5145,20 @@ begin
end;
if (Feux[i].aspect=2) then //or (feux[i].check<>nil) then // si carré violet
begin
if (Feux[i].aspect=2) then //or (feux[i].check<>nil) then // si carré violet
begin
if carre_signal(AdrFeu) and (Feux[i].aspect=2) then
begin Maj_Etat_Signal(AdrFeu,violet) ; Envoi_signauxCplx;
begin Maj_Etat_Signal(AdrFeu,violet) ; Envoi_signauxCplx;
exit;
end
else if not(carre_signal(AdrFeu)) then //ici ya pas de check and feux[i].check.checked then
begin Maj_Etat_Signal(AdrFeu,blanc);Envoi_signauxCplx;
else if not(carre_signal(AdrFeu)) then //ici ya pas de check and feux[i].check.checked then
begin Maj_Etat_Signal(AdrFeu,blanc);Envoi_signauxCplx;
exit;
end;
end;
//if AffSignal then AfficheDebug('Debut du traitement général',clYellow);
// traitement des feux >3 feux différents de violet (cas général)
if (Feux[i].aspect>=3) and (EtatSignalCplx[AdrFeu]<>violet_F) then
// traitement des feux >3 feux différents de violet (cas général)
if (Feux[i].aspect>=3) and (EtatSignalCplx[AdrFeu]<>violet_F) then
begin
// détecteurs précédent le feu , pour déterminer si leurs mémoires de zones sont à 1 pour libérer le carré
@@ -5162,7 +5196,7 @@ begin
det_initial:=feux[i].Adr_det4;Adr_El_Suiv:=feux[i].Adr_el_suiv4;
if feux[i].Btype_suiv1=1 then Btype_el_suivant:=1;
if feux[i].Btype_suiv1=2 then Btype_el_suivant:=2;
if feux[i].Btype_suiv1=5 then Btype_el_suivant:=3; // le type du feu 1=détécteur 2=aig 5=bis
if feux[i].Btype_suiv1=5 then Btype_el_suivant:=3; // le type du feu 1=détécteur 2=aig 5=bis
end;
if (det_initial<>0) then
begin
@@ -5170,7 +5204,7 @@ begin
if DetPrec1<9997 then // route bloquée par aiguillage mal positionné
begin
DetPrec2:=detecteur_suivant_El(det_initial,1,DetPrec1,1);
if DetPrec2<9997 then
if DetPrec2<9997 then
begin
DetPrec3:=detecteur_suivant_El(DetPrec1,1,DetPrec2,1);
if DetPrec3<9997 then
@@ -5180,13 +5214,13 @@ begin
PresTrain:=//MemZone[DetPrec4,detPrec3] or
MemZone[DetPrec3,detPrec2] or MemZone[DetPrec2,detPrec1] or MemZone[DetPrec1,Det_initial] or presTrain ;
// Affiche('MemZone'+intToSTR(DetPrec3)+' '+IntToSTR(detPrec2) = '+MemZone[DetPrec3,detPrec2]
end;
end;
end;
end;
end;
end;
inc(j);
until (j>=5);
if presTrain and AffSignal Then affiche('présence train feu '+intToSTR(AdrFeu),clorange);
if presTrain and AffSignal Then afficheDebug('présence train feu '+intToSTR(AdrFeu),clorange);
end;
if AffSignal then afficheDebug('Fin de la recherche des 4 détecteurs précédents-----',clOrange);
// si le signal peut afficher un carré et les aiguillages après le signal sont mal positionnées ou que pas présence train avant signal et signal
@@ -5194,13 +5228,11 @@ begin
car:=carre_signal(AdrFeu);
if AffSignal and car then AfficheDebug('le signal a des aiguilles en talon aval mal positionnées',clYellow);
if (NivDebug>=1) and car then AfficheDebug('le signal a des aiguilles en talon aval mal positionnées',clYellow);
if (Feux[i].aspect>=4) and ( (not(PresTrain) and Feux[i].VerrouCarre) or car) then Maj_Etat_Signal(AdrFeu,carre)
else
if (Feux[i].aspect>=4) and ( (not(PresTrain) and Feux[i].VerrouCarre) or car) then Maj_Etat_Signal(AdrFeu,carre)
else
begin
// si on quitte le détecteur on affiche un sémaphore : attention tester le sens de circulation
// trouver la mémoire de zone MemZone[Adr_det,?] qui a déclenché le feu rouge
if AffSignal then Affiche('test du sémaphore',clYellow);
// pour ne pas passer au rouge un feu à contresens.
// trouver la mémoire de zone MemZone[Adr_det,?] qui a déclenché le feu rouge
if AffSignal then AfficheDebug('test du sémaphore',clYellow);
Aff_semaphore:=test_memoire_zones(AdrFeu); // test si présence train après signal
@@ -5209,8 +5241,7 @@ begin
if AffSignal then AfficheDebug('train après signal-> sémaphore ou carré',clYellow);
if testBit(EtatSignalCplx[Adrfeu],carre)=FALSE then Maj_Etat_Signal(AdrFeu,semaphore);
end
else
begin
else
begin
// si aiguille locale déviée
Aig:=Aiguille_deviee(Adrfeu);
@@ -5228,8 +5259,7 @@ begin
begin
// sinon si signal suivant=jaune
if (TestBit(etat,jaune)) then Maj_Etat_Signal(AdrFeu,jaune_cli);
end;
end
end;
end
else
// aiguille locale non déviée
@@ -5251,10 +5281,10 @@ begin
end;
end
else
// si le signal suivant est jaune
// si le signal suivant est jaune
if TestBit(etat,jaune) then Maj_Etat_Signal(AdrFeu,jaune_cli)
end;
else Maj_Etat_Signal(AdrFeu,vert)
end;
end;
end;
end;
@@ -5426,6 +5456,7 @@ end;
Affiche('Demande état des aiguillages',ClYellow);
for i:=1 to maxaiguillage do
begin
demande_info_acc(i);
end;
end;
@@ -5454,6 +5485,7 @@ begin
event_det_tick[N_event_tick].suivant:=AdresseActuel;
//event_det_tick[i].train:=0; // traité
end;
end
else
if AffAffect then AfficheDebug('Pas trouvé',clyellow);
@@ -5490,7 +5522,7 @@ begin
inc(N_event_det);
event_det[N_event_det]:=Adresse;
calcul_zones; // en avant les calculs
end;
end;
// stocke les changements d'état des détecteurs dans le tableau chronologique
if (N_Event_tick<Max_Event_det_tick) then
@@ -5499,10 +5531,11 @@ begin
// event_det_tick[N_event_tick].train:=0;
event_det_tick[N_event_tick].tick:=tick;
event_det_tick[N_event_tick].detecteur[Adresse]:=etat01;
// Affiche('stockage de '+intToSTR(N_event_tick)+' à '+intToSTR(etat01),clyellow);
end;
exit;
//------------------------plus utilisé ----------------
{
// front descendant
@@ -5527,7 +5560,7 @@ begin
if AffAffect then
begin
s:='Nouveau train sur '+intToSTR(Adresse)+'='+intToSTR(N_trains);
affiche(s,clyellow);
affiche(s,clyellow);
afficheDebug(s,clyellow);
end;
event_det_tick[N_event_tick].train:=N_trains;
@@ -5537,7 +5570,7 @@ var i,index1,index2,AdresseE,Adet,det_suiv,pos,Btype,BtypeE,train1,train2,train,
end;
// évènement d'aiguillage
procedure Event_Aig(adresse : integer);
procedure Event_Aig(adresse : integer);
var i,index1,index2,AdresseE,Adet,det_suiv,pos,Btype,BtypeE,train1,train2,train,
index : integer;
trouve,trouve1,trouve2 : boolean;
@@ -5575,7 +5608,7 @@ begin
end;
if (i>20) then begin Affiche('Erreur 671',clRed);exit;end;
Affiche('le détecteur suivant sur aiguillage '+intToSTR(adresse)+' est '+intToSTR(Adet),clyellow);
// étape 2 : trouver si un train est sur le détecteur dans le tableau event_det_tick
i:=N_Event_tick;
repeat
@@ -5618,7 +5651,7 @@ begin
if trouve2 and (train2=train) then
begin
Affiche(' détecteur Adj2='+intToSTR(Adj2)+' train='+intToSTR(train),clyellow);
event_det_tick[index2].suivant:=Adet;
event_det_tick[index2].suivant:=Adet;
event_det_tick[index].suivant:=Adj1;
end;
@@ -5991,6 +6024,42 @@ begin
i:=1;
repeat
val('$'+copy(s,i,2),v,erreur);
st:=st+char(v);
inc(i,3);
until (i>=long);
HexToStr:=st;
end;
procedure deconnecte_CDM;
begin
with Formprinc do
begin
ClientSocketCDM.close;
end;
end;
{$J+}
function IsWow64Process: Boolean;
type
TIsWow64Process = function(hProcess: THandle; var Wow64Process: Boolean): Boolean; stdcall;
var
DLL: THandle;
pIsWow64Process: TIsWow64Process;
const
IsWow64: Boolean = False;
begin
IsWow64:=false;
DLL:=LoadLibrary('kernel32.dll');
if (DLL<>0) then
begin
pIsWow64Process:=GetProcAddress(DLL,'IsWow64Process');
if (Assigned(pIsWow64Process)) then
begin
pIsWow64Process(GetCurrentProcess,IsWow64);
end;
FreeLibrary(DLL);
end;
Result:=IsWow64;
@@ -6043,79 +6112,6 @@ begin
DeConnecterCDMRail.enabled:=false;
end;
end
else
begin
Affiche('port COM'+intToSTR(NumPort)+' NON ouvert',clRed) ;
end;
end;
procedure deconnecte_CDM;
begin
with Formprinc do
begin
ClientSocketCDM.close;
end;
end;
procedure connecte_CDM;
var s : string;
begin
// Initialisation de la comm socket CDM
if CDM_connecte then begin Affiche('CDM déja connecté',Cyan);exit;end;
if AdresseIPCDM<>'0' then
begin
with Formprinc do
begin
ClientSocketCDM.port:=portCDM;
ClientSocketCDM.Address:=AdresseIPCDM;
ClientSocketCDM.Open;
end;
tempo(5);
// connexion à CDM rail
s:='C-C-00-0001-CMDGEN-_CNCT|000|';
envoi_cdm(s);
if pos('_ACK',recuCDM)<>0 then
begin
CDM_connecte:=True;
Id_CDM:=copy(recuCDM,5,2); // récupère l'ID reçu de CDM, à utiliser dans toutes les futures trames
s:='Connecté au serveur CDM rail avec l''ID='+Id_CDM;
Affiche(s,clYellow);
AfficheDebug(s,clyellow);
// demande des services : ATNT=aiguillages, ADET=détecteurs AACT=actionneurs
s:=place_id('C-C-00-0002-RQSERV-RTSIM|030|03|SRV=ATNT;SRV=ADET;SRV=AACT;');
envoi_CDM(s);
if pos('_ACK',recuCDM)<>0 then Affiche('Services acceptés: aiguillages - détecteurs - actionneurs',clYellow);
// demande les trains
////s:=place_id('C-C-01-0002-DSCTRN-DLOAD|000|');
//envoi_CDM(s);
end;
end
else
begin
Affiche('La connexion à CDM n''est pas demandée car l''adresse IP est nulle dans config.cfg',cyan);
end;
end;
{$J+}
function IsWow64Process: Boolean;
type
TIsWow64Process = function(hProcess: THandle; var Wow64Process: Boolean): Boolean; stdcall;
var
DLL: THandle;
pIsWow64Process: TIsWow64Process;
const
IsWow64: Boolean = False;
begin
IsWow64:=false;
DLL:=LoadLibrary('kernel32.dll');
if (DLL<>0) then
begin
pIsWow64Process:=GetProcAddress(DLL,'IsWow64Process');
if (Assigned(pIsWow64Process)) then
begin
pIsWow64Process(GetCurrentProcess,IsWow64);
end;
else
begin
Affiche('port COM'+intToSTR(NumPort)+' NON ouvert',clRed) ;
@@ -6129,6 +6125,11 @@ begin
s,s2,Url,LocalFile : string;
trouve,AvecMaj : Boolean;
V_utile,V_publie : real;
begin
//AvecMaj:=false;
TraceSign:=True;
AF:='Client TCP-IP CDM Rail ou USB - système LENZ - Version '+Version;
Caption:=AF;
Application.onHint:=doHint;
// version d'OS pour info
@@ -6145,25 +6146,22 @@ begin
N_Trains:=0;
NivDebug:=0;
DebugOuv:=True;
//LireunaccessoireversunfichierdeCV1.Visible:=false;
AvecInit:=true; //&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
AvecTCO:=false;
EditNbTrains.Text:=IntToSTR(N_Trains);
// créée la fenetre vérification de version
AvecInit:=true; //&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
AvecTCO:=false;
// créée la fenetre vérification de version
FormVersion:=TformVersion.Create(Self);
ferme:=false;
CDM_connecte:=false;
pasreponse:=0;
Nbre_recu_cdm:=0;
AffMem:=true;
pasreponse:=0;
N_routes:=0;
N_trains:=0;
Train[1].index:=0;
@@ -6172,9 +6170,11 @@ begin
// TCO
if avectco then
begin
//créée la fenêtre TCO
FormTCO:=TformTCO.Create(Self);
FormTCO:=TformTCO.Create(Self);
FormTCO.show;
construit_TCO;
affiche_TCO;
//Formprinc.Hide;
end;
@@ -6197,7 +6197,7 @@ begin
if AdresseIP<>'0' then
begin
Affiche('demande connexion à la centrale Lenz par Ethernet',clyellow);
ClientSocketLenz.port:=port;
ClientSocketLenz.port:=port;
ClientSocketLenz.Address:=AdresseIP;
ClientSocketLenz.Open;
end
@@ -6278,7 +6278,7 @@ begin
//NivDebug:=3;
//test_memoire_zones(218);
//Det_Adj(520);
//Affiche(' Adj1='+intToStr(Adj1)+' Adj2='+intToStr(Adj2),clyellow);
//Affiche(' Adj1='+intToStr(Adj1)+' Adj2='+intToStr(Adj2),clyellow);
//trace:=true;
//TraceListe:=true;
@@ -6554,16 +6554,29 @@ begin
Affiche('En jaune : rétrosignalisation reçue depuis l''interface',ClWhite);
end;
procedure TFormPrinc.MenuConnecterUSBClick(Sender: TObject);
procedure TFormPrinc.MenuConnecterUSBClick(Sender: TObject);
begin
Hors_tension2:=false;
connecte_USB;
connecte_USB;
end;
procedure deconnecte_usb;
begin
Ferme:=true;
if portCommOuvert then
procedure TFormPrinc.DeconnecterUSBClick(Sender: TObject);
begin
Ferme:=true;
if portCommOuvert then begin portCommOuvert:=false;MSCommUSBLenz.Portopen:=false; end;
begin
portCommOuvert:=false;
Formprinc.MSCommUSBLenz.Portopen:=false;
end;
portCommOuvert:=false;
with formprinc do
begin
ClientSocketLenz.close;
MenuConnecterUSB.enabled:=true;
DeConnecterUSB.enabled:=false;
ConnecterCDMRail.enabled:=true;
DeConnecterCDMRail.enabled:=false;
end;
end;
@@ -6691,7 +6704,7 @@ end;
ButtonEcrCV.Enabled:=true;
LireunfichierdeCV1.enabled:=true;
LireunaccessoireversunfichierdeCV1.Enabled:=true;
LabelTitre.caption:=titre+' Interface connectée par Ethernet';
LabelTitre.caption:=titre+' Interface connectée par Ethernet';
end;
procedure TFormPrinc.ClientSocketCDMConnect(Sender: TObject;Socket: TCustomWinSocket);
@@ -6711,7 +6724,7 @@ begin
// réception d'un message de CDM rail
procedure TFormPrinc.ClientSocketCDMRead(Sender: TObject;Socket: TCustomWinSocket);
var i,j,k,erreur, adr,adr2,etat,etataig : integer ;
s,ss : string;
s,ss : string;
traite,sort : boolean;
begin
inc(Nbre_recu_cdm);
@@ -6765,7 +6778,7 @@ begin
j:=pos('CMDACC-ST_DT',recuCDM);
if j<>0 then
begin
i:=posEx('AD=',recuCDM,j);ss:=copy(recuCDM,i+3,10);
i:=posEx('AD=',recuCDM,j);ss:=copy(recuCDM,i+3,10);
val(ss,adr,erreur);
i:=posEx('STATE=',recuCDM,j);ss:=copy(recuCDM,i+6,10);
Delete(recuCDM,j,i+5-j);
@@ -6860,6 +6873,8 @@ begin
Affiche('Version 1.02 : vérification automatique des versions',clLime);
Affiche('Version 1.1 : gestion des tableaux indicateurs de direction',clLime);
Affiche(' gestion du décodeur de signaux Unisemaf Paco (expérimental)',clLime);
Affiche(' changement dynamique des feux en cliquant sur son image',clLime);
Affiche('Version 1.11 : compatibilité pour la rétrosignalisation non XpressNet (intellibox)',clLime);
Affiche(' verrouillages routes pour trains consécutifs',clLime);
Affiche('Version 1.2 : Renforcement de l''algorithme de suivi des trains',clLime);
Affiche('Version 1.3 : Décodeur Unisemaf fonctionnel - Lecture/écriture des CV',clLime);
@@ -6883,7 +6898,7 @@ begin
begin
s:=IntToSTR(i)+' Tick='+IntToSTR(event_det_tick[i].tick)+' Det=';
trouve:=false;
for j:=1 to 1100 do
for j:=1 to 1100 do
begin
etat:=event_det_tick[i].detecteur[j];
if etat<>-1 then
@@ -6894,15 +6909,6 @@ begin
trouve:=true;
end;
end;
if trouve then Affiche(s,clyellow);
end;
end;
procedure TFormPrinc.EditNbTrainsKeyPress(Sender: TObject; var Key: Char);
begin
if ord(Key) = VK_RETURN then
end;
if trouve then Affiche(s,clyellow);
end;
@@ -7086,5 +7092,13 @@ begin
end;
procedure TFormPrinc.Button2Click(Sender: TObject);
begin
if MSCommUSBLenz.CTSHolding=true then Affiche('CTS=1',Clyellow)
else Affiche('CTS=0',clyellow);
end;
procedure TFormPrinc.ConfigClick(Sender: TObject);
begin
Tformconfig.create(self);
formconfig.showmodal;

BIN
UnitSimule.dcu
View File

Binary file not shown.

20
UnitSimule.dfm
View File

@@ -27,7 +27,7 @@ object FormSimulation: TFormSimulation
Font.Style = []
ParentFont = False
end
object Button1: TButton
object ButtonCharge: TButton
Left = 160
Top = 96
Width = 105
@@ -35,7 +35,7 @@ object FormSimulation: TFormSimulation
Caption = 'Charger un fichier de simulation'
TabOrder = 0
WordWrap = True
OnClick = Button1Click
OnClick = ButtonChargeClick
end
object EditIntervalle: TEdit
Left = 352
@@ -43,11 +43,19 @@ object FormSimulation: TFormSimulation
Width = 49
Height = 21
TabOrder = 1
Text = '2'
OnChange = EditIntervalleChange
Text = '1'
OnKeyPress = EditIntervalleKeyPress
end
object CheckBoxRapide: TCheckBox
Left = 56
Top = 56
Width = 97
Height = 17
Caption = 'Mode rapide'
TabOrder = 2
end
object OpenDialog: TOpenDialog
Left = 40
Top = 64
Left = 48
Top = 96
end
end

22
UnitSimule.pas
View File

@@ -8,13 +8,14 @@ uses
type
TFormSimulation = class(TForm)
Button1: TButton;
ButtonCharge: TButton;
OpenDialog: TOpenDialog;
EditIntervalle: TEdit;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
CheckBoxRapide: TCheckBox;
procedure ButtonChargeClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure EditIntervalleChange(Sender: TObject);
procedure EditIntervalleKeyPress(Sender: TObject; var Key: Char);
private
{ Déclarations privées }
public
@@ -29,7 +30,7 @@ implementation
{$R *.dfm}
procedure TFormSimulation.Button1Click(Sender: TObject);
procedure TFormSimulation.ButtonChargeClick(Sender: TObject);
var s : string;
fte : textFile;
i,k,erreur : integer;
@@ -54,7 +55,8 @@ begin
begin
Delete(s,1,i+4);
val(s,k,erreur);
k:=Index_Simule*Intervalle*10+tick+80; // démarre dans 8s
if intervalle<>0 then k:=Index_Simule*Intervalle*10+tick+80 else // démarre dans 8s
k:=Index_Simule+tick+80 ;
Tablo_simule[index_simule].tick:=k;
i:=pos('Det=',s);
if i<>0 then
@@ -91,16 +93,16 @@ end;
procedure TFormSimulation.FormCreate(Sender: TObject);
begin
Intervalle:=2;
Intervalle:=1;
EditIntervalle.Text:=IntToSTR(Intervalle);
end;
procedure TFormSimulation.EditIntervalleChange(Sender: TObject);
var i, erreur : integer;
procedure TFormSimulation.EditIntervalleKeyPress(Sender: TObject;var Key: Char);
var erreur : integer;
begin
Val(EditIntervalle.Text,i,erreur);
if erreur=0 then Intervalle:=i;
Val(EditIntervalle.Text,intervalle,erreur);
if (intervalle<0) then Intervalle:=1;
end;
end.

BIN
UnitTCO.dcu
View File

Binary file not shown.

44
UnitTCO.dfm
View File

@@ -1,6 +1,6 @@
object FormTCO: TFormTCO
Left = 1549
Top = 156
Left = 267
Top = 203
Width = 928
Height = 590
Caption = 'FormTCO'
@@ -10,9 +10,12 @@ object FormTCO: TFormTCO
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
KeyPreview = True
OldCreateOrder = False
Position = poDefault
OnActivate = FormActivate
OnCreate = FormCreate
OnKeyDown = FormKeyDown
PixelsPerInch = 96
TextHeight = 13
object LabelX: TLabel
@@ -55,18 +58,12 @@ object FormTCO: TFormTCO
Font.Style = [fsBold]
ParentFont = False
end
object DrawGrid: TDrawGrid
Left = 48
Top = 408
Width = 521
Height = 137
Color = clBlack
DefaultColWidth = 30
DefaultRowHeight = 30
FixedCols = 0
FixedRows = 0
TabOrder = 0
OnDrawCell = DrawGridDrawCell
object Label1: TLabel
Left = 496
Top = 8
Width = 32
Height = 13
Caption = 'Label1'
end
object Button1: TButton
Left = 320
@@ -74,20 +71,20 @@ object FormTCO: TFormTCO
Width = 75
Height = 25
Caption = 'Button1'
TabOrder = 1
TabOrder = 0
OnClick = Button1Click
end
object ScrollBox: TScrollBox
Left = 16
Top = 40
Width = 865
Height = 353
TabOrder = 2
Height = 433
TabOrder = 1
object ImageTCO: TImage
Left = 0
Top = 0
Width = 857
Height = 345
Height = 425
PopupMenu = PopupMenu1
OnClick = ImageTCOClick
OnContextPopup = ImageTCOContextPopup
@@ -102,5 +99,16 @@ object FormTCO: TFormTCO
object N1: TMenuItem
Caption = '-'
end
object Insrer1: TMenuItem
Caption = 'Ins'#233'rer'
object aiguillageG_PG: TMenuItem
Caption = 'Aiguillage gauche ; pointe '#224' gauche'
OnClick = aiguillageG_PGClick
end
object aiguillageD_PD: TMenuItem
Caption = 'Aiguillage droit ; pointe '#224' droite'
OnClick = aiguillageD_PDClick
end
end
end
end

280
UnitTCO.pas
View File

@@ -8,7 +8,6 @@ uses
type
TFormTCO = class(TForm)
DrawGrid: TDrawGrid;
Button1: TButton;
LabelX: TLabel;
Label2: TLabel;
@@ -19,14 +18,25 @@ type
PopupMenu1: TPopupMenu;
Position1: TMenuItem;
N1: TMenuItem;
Insrer1: TMenuItem;
aiguillageG_PG: TMenuItem;
Label1: TLabel;
aiguillageD_PD: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure DrawGridDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
procedure Button1Click(Sender: TObject);
procedure ImageTCOClick(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure ImageTCOContextPopup(Sender: TObject; MousePos: TPoint;
var Handled: Boolean);
procedure aiguillageG_PGClick(Sender: TObject);
procedure dessin_AigPG_AG(x,y : integer;couleur : Tcolor);
procedure dessin_AigPD_AD(x,y : integer;couleur : Tcolor);
procedure dessin_cbgd(x,y : integer;couleur : Tcolor);
procedure dessin_cdbas(x,y : integer;couleur : Tcolor);
procedure Entoure_cell(x,y : integer);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure aiguillageD_PDClick(Sender: TObject);
private
{ Déclarations privées }
public
@@ -36,8 +46,9 @@ type
var
FormTCO: TFormTCO;
Forminit : boolean;
NbreCellX,NbreCellY,HtImageTCO,LargImageTCO,XclicCell,YclicCell : integer;
LargeurCell,HauteurCell,Xclic,Yclic : integer;
LargeurCell,HauteurCell,Xclic,Yclic,XClicCellInserer,YClicCellInserer : integer;
tco : array[1..20,1..20] of Tbranche;
procedure construit_TCO;
@@ -80,6 +91,7 @@ begin
end;
end;
// élément de voie horizontale
procedure dessin_voie(x,y : integer);
var x1,y1 : integer;
r : Trect;
@@ -91,25 +103,25 @@ begin
end;
with formTCO.ImageTCO.canvas do
begin
r:=Rect(x1,y1+(HauteurCell div 2)-5,x1+LargeurCell,y1 + (HauteurCell div 2)+5);
r:=Rect(x1,y1+(HauteurCell div 2)-3,x1+LargeurCell,y1 + (HauteurCell div 2)+3);
Brush.COlor:=ClRed;
FillRect(r);
end;
end;
// aiguillage pointe à gauche, monte gauche
procedure dessin_AigPGMG(x,y : integer;couleur : Tcolor);
// aiguillage pointe à gauche, aiguillage gauche
procedure TFormTCO.dessin_AigPG_AG(x,y : integer;couleur : Tcolor);
var x0,y0,x1,y1,x2,y2,x3,y3,x4,y4,jy1,jy2 : integer;
r : Trect;
begin
x0:=x*LargeurCell;
y0:=y*HauteurCell;
x0:=(x-1)*LargeurCell;
y0:=(y-1)*HauteurCell;
with formTCO.ImageTCO.canvas do
with ImageTCO.canvas do
begin
Brush.COlor:=couleur;
Brush.Color:=couleur;
pen.color:=couleur;
Pen.Mode:=PmCopy;
jy1:=y0+(HauteurCell div 2)-3; // pos Y de la bande sup
jy2:=y0+(HauteurCell div 2)+3; // pos Y de la bande inf
@@ -131,18 +143,50 @@ begin
end;
end;
// aiguillage pointe à droite, aiguillage droit
procedure TFormTCO.dessin_AigPD_AD(x,y : integer;couleur : Tcolor);
var x0,y0,x1,y1,x2,y2,x3,y3,x4,y4,jy1,jy2 : integer;
r : Trect;
begin
x0:=(x-1)*LargeurCell;
y0:=(y-1)*HauteurCell;
with ImageTCO.canvas do
begin
Brush.COlor:=couleur;
Pen.Mode:=PmCopy;
pen.color:=couleur;
jy1:=y0+(HauteurCell div 2)-3; // pos Y de la bande sup
jy2:=y0+(HauteurCell div 2)+3; // pos Y de la bande inf
r:=Rect(x0,jy1,x0+LargeurCell,jy2);
FillRect(r);
//brush.color:=clblue;
x1:=x0+(largeurCell div 2); y1:=jy1;
x2:=x0+3; y2:=y0;
x3:=x0; y3:=y0+3;
x4:=x0+(largeurCell div 2); y4:=jy2;
Polygon([point(x1,y1),Point(x2,y2),Point(x3,y3),Point(x4-1,y4-1)]);
end;
end;
// courbe bas gauche vers droit
procedure dessin_cbgd(x,y : integer;couleur : Tcolor);
procedure TFormTCO.dessin_cbgd(x,y : integer;couleur : Tcolor);
var jy1,jy2,x0,y0,i,x1,y1,x2,y2,x3,y3,x4,y4 : integer;
r : Trect;
begin
x0:=x*LargeurCell;
y0:=y*HauteurCell;
x0:=(x-1)*LargeurCell;
y0:=(y-1)*HauteurCell;
with formTCO.ImageTCO.canvas do
with ImageTCO.canvas do
begin
Brush.COlor:=Couleur;
pen.color:=Couleur;
Pen.Mode:=PmCopy;
jy1:=y0+(HauteurCell div 2)-3; // pos Y de la bande sup
jy2:=y0+(HauteurCell div 2)+3; // pos Y de la bande inf
@@ -163,7 +207,41 @@ begin
end;
end;
// courbe: droit vers bas -\
procedure TFormTCO.dessin_cdbas(x,y : integer;couleur : Tcolor);
var jy1,jy2,x0,y0,i,x1,y1,x2,y2,x3,y3,x4,y4 : integer;
r : Trect;
begin
x0:=(x-1)*LargeurCell;
y0:=(y-1)*HauteurCell;
with ImageTCO.canvas do
begin
Brush.COlor:=Couleur;
Pen.Mode:=PmCopy;
pen.color:=Couleur;
jy1:=y0+(HauteurCell div 2)-3; // pos Y de la bande sup
jy2:=y0+(HauteurCell div 2)+3; // pos Y de la bande inf
r:=Rect(x0,jy1,x0+(LargeurCell div 2),jy2);
FillRect(r);
// brush.color:=clblue;
x1:=x0+(LargeurCell div 2) ;
y1:=jy1;
x2:=x0+LargeurCell;
y2:=y0+HauteurCell-3;
x3:=x0+LargeurCell -2;
y3:=y0+HauteurCell;
x4:=x0+(LargeurCell div 2);
y4:=jy2;
Polygon([point(x1,y1),Point(x2,y2),Point(x3,y3),Point(x4,y4)]);
end;
end;
// transforme les branches en TCO
// à voir, trop compliqué. Il faudra dessiner son TCO soit meme
procedure construit_TCO;
var x,y,i,j,Max,indexMax : integer;
begin
@@ -193,8 +271,6 @@ begin
TCO[i,5].Adresse:=BrancheN[IndexMax,i].Adresse;
TCO[i,5].Btype:=BrancheN[IndexMax,i].Btype;
end;
end;
procedure Affiche_TCO ;
@@ -220,7 +296,7 @@ begin
if Btype=2 then s:='A'+s;
if Btype=3 then s:='A'+s+'B';
Textout(Xorg+2,Yorg+2,s);
if i<>0 then Textout(Xorg+2,Yorg+2,s);
end;
end;
end;
@@ -228,114 +304,146 @@ end;
procedure TFormTCO.FormCreate(Sender: TObject);
begin
caption:='TCO';
NbreCellX:=20;
NbreCellY:=10;
LargeurCell:=35;
HauteurCell:=35;
//grille;
// HtImageTCO:=ImageTCO.Height;
XclicCell:=1;
YclicCell:=1;
KeyPreview:=true; // valide les évènements clavier
// grille;
// Entoure_cell(XclicCell,YclicCell);
end;
// x y = numéro cellule
Procedure dessine(x,y : integer);
Var Xorg,Yorg : integer;
begin
Xorg:=x*LargeurCell;
Yorg:=y*HauteurCell;
with FormTCO.DrawGrid.Canvas do
begin
Pen.width:=3;
Pen.Color:=clyellow;
Brush.Style:=bsSolid;
MoveTo(xorg,yorg);LineTo(xorg+120,yorg+150) ;
Pen.Color:=clred;
MoveTo(1,1);LineTo(120,160) ;
end;
formTCO.refresh;
end;
procedure TFormTCO.DrawGridDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
var s : string;
aCanvas : Tcanvas;
begin
exit;
dessine(2,2);
if (Acol=3) and (ARow=3) then with Sender as TDrawGrid do Canvas.Draw(Rect.left,Rect.Top,Formprinc.Image6Dir.picture.bitmap);
if (Acol=2) and (Arow=1) then
begin
with Sender as TDrawGrid do
begin
//Canvas.Pen:=psSolid;
With canvas do
begin
Pen.width:=3;
Pen.Color:=clyellow;
MoveTo(1,1);LineTo(150,150) ;
end;
end;
end;
end;
procedure TFormTCO.Button1Click(Sender: TObject);
begin
grille;
dessin_voie(3,3);
dessin_voie(10,4);
dessin_AigPGMG(7,6,clyellow);
repaint;
end;
// clic gauche sur image
procedure TFormTCO.ImageTCOClick(Sender: TObject);
var Position: TPoint;
begin
Entoure_cell(XclicCell,YclicCell);
GetCursorPos(Position);
Position:=ImageTCO.screenToCLient(Position);
Xclic:=position.X;YClic:=position.Y;
XclicCell:=Xclic div largeurCell +1;
YclicCell:=Yclic div hauteurCell +1;
LabelX.caption:=IntToSTR(XclicCell);
LabelY.caption:=IntToSTR(YclicCell);
label1.caption:='clicContext';
XclicCellInserer:=XClicCell;
YclicCellInserer:=YClicCell;
Entoure_cell(XclicCellInserer,YclicCellInserer);
end;
procedure TformTCO.Entoure_cell(x,y : integer);
var r : Trect;
x0,y0 : integer;
begin
x0:=(x-1)*LargeurCell+1;
y0:=(y-1)*HauteurCell+1;
with ImageTCO.canvas do
begin
Pen.width:=3;
Pen.Color:=clyellow;
Brush.Color:=clBlack;
Brush.Style:=bsSolid;
Pen.Mode:=PmXor;
r:=Rect(x0,y0,x0+largeurCell,y0+LargeurCell);
Rectangle(r);
// FillRect(r);
end;
end;
procedure TFormTCO.FormActivate(Sender: TObject);
begin
grille;
if not(Forminit) then
begin
FormInit:=true;
grille;
Entoure_cell(XclicCell,YclicCell);
end;
{
dessin_voie(3,3);
dessin_voie(10,4);
dessin_AigPGMG(7,6,clyellow);
dessin_AigPG_AG(7,6,clyellow);
dessin_AigPD_AD(12,6,clyellow);
dessin_cbgd(8,5,clyellow);
formprinc.Hide;
dessin_voie(9,5);dessin_voie(10,5);
dessin_cdbas(11,5,clyellow); }
//formprinc.Hide;
end;
// evt qui se produit quand on clic droit dans l'image
procedure TFormTCO.ImageTCOContextPopup(Sender: TObject; MousePos: TPoint; var Handled: Boolean);
var Position: TPoint;
begin
// efface le carré pointeur
Entoure_cell(XclicCell,YclicCell);
GetCursorPos(Position);
Position:=ImageTCO.screenToCLient(Position);
Xclic:=position.X;YClic:=position.Y;
XclicCell:=Xclic div largeurCell +1;
YclicCell:=Yclic div hauteurCell +1;
LabelX.caption:=IntToSTR(XclicCell);
LabelY.caption:=IntToSTR(YclicCell);
label1.caption:='clicContext';
XclicCellInserer:=XClicCell;
YclicCellInserer:=YClicCell;
Entoure_cell(XclicCellInserer,YclicCellInserer);
end;
// menu droit "clic aiguillage G PG"
procedure TFormTCO.aiguillageG_PGClick(Sender: TObject);
var Position: TPoint;
begin
// effacer le carré pointeur
Entoure_cell(XclicCell,YclicCell);
GetCursorPos(Position);
// dessine le dessin
dessin_AigPG_AG(XClicCellInserer,YClicCellInserer,clyellow);
// remet le carré pointeur
Entoure_cell(XclicCell,YclicCell);
GetCursorPos(Position);
end;
// menu droit "clic aiguillage D PD"
procedure TFormTCO.aiguillageD_PDClick(Sender: TObject);
var Position: TPoint;
begin
// effacer le carré pointeur
Entoure_cell(XclicCell,YclicCell);
GetCursorPos(Position);
// dessine le dessin
dessin_AigPD_AD(XClicCellInserer,YClicCellInserer,clyellow);
// remet le carré pointeur
Entoure_cell(XclicCell,YclicCell);
GetCursorPos(Position);
end;
procedure TFormTCO.FormKeyDown(Sender: TObject; var Key: Word;Shift: TShiftState);
begin
Entoure_cell(XclicCell,YclicCell);
case Key of
VK_right : if XClicCell<NbreCellX then inc(XClicCell);
VK_left : if XClicCell>1 then dec(XClicCell);
VK_down : if YClicCell<NbreCellY then inc(YClicCell);
VK_up : if YClicCell>1 then dec(YClicCell);
end;
LabelX.caption:=IntToSTR(XClicCell);
LabelY.caption:=IntToSTR(YClicCell);
Entoure_cell(XclicCell,YclicCell);
end;
end.

1
client-GL.cfg
View File

@@ -22,6 +22,7 @@
/
/ Adresse IP V4 du PC sur lequel s'execute CDM : port
127.0.0.1:9999
/
/ ==========================================================================
/ D é f i n i t i o n de l'interface XpressNet pour utilisation en mode autonome
/ Adresse IP V4 de l'interface LI-USB Ethernet : port

BIN
listeusb.dcu
View File

Binary file not shown.

167
listeusb.pas
View File

@@ -1,167 +0,0 @@
unit listeusb;
//=================================================//
// Nicolas Paglieri (ni69) //
// www.ni69.info //
// & www.delphifr.com //
//=================================================//
// Merci à DelphiProg pour son aide précieuse ! ;) //
//=================================================//
interface
uses Registry,ShellAPI, ComCtrls,
Windows, Messages, SysUtils, Variants, Classes;// Graphics, Controls,
var
line : array of string;
NumLine : integer;
procedure EnumerateDevices;
implementation
//============================================================================//
// Fonction de traduction en français des noms anglais des catégories de périphériques
// On ajoute ici l'index de l'icône de catégorie après un # pour gérer l'affichage
//============================================================================//
function Translate(English: string): string;
begin
if English = 'CDROM' then result := 'Lecteurs de CD-ROM/DVD-ROM#09'
else if English = 'Computer' then result := 'Ordinateur#14'
else if English = 'DiskDrive' then result := 'Lecteurs de disque#10'
else if English = 'Display' then result := 'Cartes Graphiques#01'
else if English = 'fdc' then result := 'Contrôleur de lecteur de disquettes#04'
else if English = 'FloppyDisk' then result := 'Lecteurs de disquettes#11'
else if English = 'hdc' then result := 'Contrôleurs ATA/ATAPI IDE#05'
else if English = 'Image' then result := 'Périphériques d''image#15'
else if English = 'Keyboard' then result := 'Claviers#03'
else if English = 'LegacyDriver' then result := 'Pilotes non Plug-and-Play#17'
else if English = 'MEDIA' then result := 'Contrôleurs audio, vidéo et jeu#06'
else if English = 'Modem' then result := 'Modems#12'
else if English = 'Monitor' then result := 'Moniteurs#13'
else if English = 'Mouse' then result := 'Souris et autres périphériques de pointage#20'
else if English = 'Net' then result := 'Cartes réseau#02'
else if English = 'NtApm' then result := 'Prise en charge NT APM/hérité#19'
else if English = 'Ports' then result := 'Ports (COM et LPT)#18'
else if English = 'Printer' then result := 'Imprimantes#08'
else if English = 'System' then result := 'Périphériques Système#14'
else if English = 'USB' then result := 'Contrôleurs de bus USB#07'
else if English = 'Volume' then result := 'Volumes de stockage#21'
else result := English+'#22'; // Périphérique inconnu
end;
//============================================================================//
//============================================================================//
// PROCEDURE D'ENUMERATION DES PERIPHERIQUES SUR WINDOWS XP-7 //
// ne marche pas avec W10
//============================================================================//
procedure EnumerateDevices;
var
CategoriesList, SubCatList, SubSubCatList, FinalList : TStringList;
nb, nb2, nb3 ,num: integer;
Reg1, Reg2, Reg3 : TRegistry;
HasBeenFound : boolean;
listeCles : Tstrings;
begin
CategoriesList := TStringList.Create; // Liste des catégories principales du registre
SubCatList := TStringList.Create; // Liste intermédiaire
SubSubCatList := TStringList.Create; // Liste intermédiaire
FinalList := TStringList.Create; // Liste finale comprenant les périphériques
// On crée les objets TRegistry qui serviront à parcourir l'arborescence
Reg1 := TRegistry.Create;
Reg2 := TRegistry.Create;
Reg3 := TRegistry.Create;
try
// Définition de la clé racine
Reg1.RootKey := HKEY_LOCAL_MACHINE;
Reg2.RootKey := HKEY_LOCAL_MACHINE;
Reg3.RootKey := HKEY_LOCAL_MACHINE;
//----------------------------------------------------------------------------------------
// 1ère ETAPE : ENUMARTION DES CATEGORIES DU REGISTRE (différentes des catégories finales)
with TRegistry.Create do try
RootKey := HKEY_LOCAL_MACHINE;
//! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
// IMPORTANT : DROITS D'ACCES
// On ouvre les clés en lecture seule avec OpenKeyReadOnly
// car on dispose de la valeur de sécurité d'accès KEY_READ.
// En effet, seul SYSTEM a le droit d'ouvrir cette clé en écriture en temps normal.
//! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
OpenKeyReadOnly('SYSTEM\CurrentControlSet\Enum');
GetKeyNames(CategoriesList); // Récupération des catégories
CloseKey;
finally
free;
end;
num:=1;Setlength(line,num+1);
//-----------------------------------------------------------------------------------------------------------------------------------
// 2eme ETAPE : PARCOURS DE L'ARBORESCENCE DU REGISTRE (les clés contenant les informations utiles sont contenues dans d'autres clés)
for nb := 0 to CategoriesList.Count-1 do begin
Reg1.OpenKeyReadOnly('SYSTEM\CurrentControlSet\Enum\'+CategoriesList[nb]);
Reg1.GetKeyNames(SubCatList);
Reg1.CloseKey;
for nb2 := 0 to SubCatList.Count-1 do begin
Reg2.OpenKeyReadOnly('SYSTEM\CurrentControlSet\Enum\'+CategoriesList[nb]+'\'+SubCatList[nb2]);
Reg2.GetKeyNames(SubSubCatList);
Reg2.CloseKey;
for nb3 := 0 to SubSubCatList.Count-1 do begin
Reg3.OpenKeyReadOnly('SYSTEM\CurrentControlSet\Enum\'+CategoriesList[nb]+'\'+SubCatList[nb2]+'\'+SubSubCatList[nb3]);
// Si on ne dispose ni du type de périphérique, ni de son nom,
// Ou alors si le périphérique n'est plus disponible (si la clé "Control" n'est pas présente), on ne l'ajoute pas
if ((Reg3.ReadString('Class')='') and (Reg3.ReadString('DeviceDesc')='')) or (not Reg3.KeyExists('Control')) then begin
Reg3.CloseKey;
continue;
// Si il s'agit d'un lecteur CD, d'un disque dur ou d'un port (COM ou LPT), on remplace la description du périphérique par un nom plus parlant
end else if (Reg3.ReadString('Class')='CDROM') or (Reg3.ReadString('Class')='DiskDrive') or (Reg3.ReadString('Class')='Ports') then
line[num] := Translate(Reg3.ReadString('Class'))+'|'+Reg3.ReadString('FriendlyName')
else line[num] := Translate(Reg3.ReadString('Class'))+'|'+Reg3.ReadString('DeviceDesc');
// Ajout des informations si elles sont présentes dans le registre
if Reg3.ValueExists('DeviceDesc') then Line[num] := Line[num] + '§Description@'+Reg3.ReadString('DeviceDesc');
if Reg3.ValueExists('FriendlyName') then Line[num] := Line[num] + '§FriendlyName@'+Reg3.ReadString('FriendlyName');
if Reg3.ValueExists('Mfg') then Line[num] := Line[num] + '§Fabriquant@'+Reg3.ReadString('Mfg');
if Reg3.ValueExists('Service') then Line[num] := Line[num] + '§Service@'+Reg3.ReadString('Service');
if Reg3.ValueExists('LocationInformation') then Line[num] := Line[num] + '§Emplacement@'+Reg3.ReadString('LocationInformation');
if Reg3.ValueExists('Class') then Line[num] := Line[num] + '§Enumérateur@'+Reg3.ReadString('Class');
FinalList.Add(line[num]);
inc(num);
//Affiche(line,clyellow);
Reg3.CloseKey;Setlength(line,num+1);
end;
end;
end;
NumLine:=num-1;
finally
// On libère les éléments créés au départ
Reg3.Free;
Reg2.Free;
Reg1.Free;
FinalList.Free;
SubSubCatList.Free;
SubCatList.Free;
CategoriesList.Free;
end;
end;
end.

BIN
verif_version.dcu
View File

Binary file not shown.

58
verif_version.pas
View File

@@ -62,6 +62,7 @@ var
Fs:TFileStream;
lpBuffer: array[0..1024 + 1] of byte;
dwBytesRead: DWORD;
dwTimeout : integer;
begin
Result:=False;
@@ -70,6 +71,9 @@ begin
try
if Assigned(hSession) then
begin
// fonction longue
dwTimeout:=2000; //2s
InternetSetOption(hSession,INTERNET_OPTION_CONNECT_TIMEOUT,@dwTimeOut, SizeOf(dwTimeOut));
hService:=InternetOpenUrl(hSession, PChar(aUrl), nil, 0, INTERNET_FLAG_RELOAD, 0);
if Assigned(hService) then
try
@@ -126,34 +130,34 @@ begin
if trouve_zip then s3:=s;
end;
// Aff(s)
end;
closefile(fichier);
if trouve_version then
begin
// isoler le champ version
i:=pos('version ',s2);
delete(s2,1,i+7);
j:=pos(' ',s2);
Version_p:=copy(s2,1,j-1); // version dans version_p
// isoler l'url du zip
i:=pos('href="',s3);
delete(s3,1,i+5);
j:=pos('"',s3);
s3:=copy(s3,1,j-1);
i:=pos('.',s3);
if i<>0 then delete(s3,i,1); // supprimer le .
s3:='http://cdmrail.free.fr/ForumCDR'+s3 ;
aff(s3); // lien dans s3
end;
closefile(fichier);
if trouve_version then
begin
// isoler le champ version
i:=pos('version ',s2);
delete(s2,1,i+7);
j:=pos(' ',s2);
Version_p:=copy(s2,1,j-1); // version dans version_p
// isoler l'url du zip
i:=pos('href="',s3);
delete(s3,1,i+5);
j:=pos('"',s3);
s3:=copy(s3,1,j-1);
i:=pos('.',s3);
if i<>0 then delete(s3,i,1); // supprimer le .
s3:='http://cdmrail.free.fr/ForumCDR'+s3 ;
aff(s3); // lien dans s3
// changer le . en ,
s:=Version_p;
// i:=pos('.',s);if i<>0 then s[i]:=',';
s2:=version;
// i:=pos('.',s2);if i<>0 then s2[i]:=',';
val(s,V_publie,erreur); if erreur<>0 then exit;
val(s2,V_utile,erreur); if erreur<>0 then exit;
// changer le . en ,
s:=Version_p;
// i:=pos('.',s);if i<>0 then s[i]:=',';
s2:=version;
// i:=pos('.',s2);if i<>0 then s2[i]:=',';
val(s,V_publie,erreur); if erreur<>0 then exit;
val(s2,V_utile,erreur); if erreur<>0 then exit;
if V_utile<V_publie then
begin
FormVersion.show;
@@ -182,7 +186,7 @@ begin
end
else
begin
//Aff('Pas d''accès au site CDM rail');
//Affiche('Pas d''accès au site CDM rail',clorange);
end;
end;