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

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

View File

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

Binary file not shown.

BIN
UnitConfig.dcu Normal 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.

Binary file not shown.

View File

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

View File

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

Binary file not shown.

View File

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

View File

@@ -15,8 +15,8 @@ interface
uses uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, OleCtrls, ExtCtrls, jpeg, ComCtrls, ListeUSB, Dialogs, StdCtrls, OleCtrls, ExtCtrls, jpeg, ComCtrls,
ImgList, ScktComp, StrUtils, Menus, ActnList, MSCommLib_TLB ; ImgList, ScktComp, StrUtils, Menus, ActnList, MSCommLib_TLB , unitConfig ;
type type
TFormPrinc = class(TForm) TFormPrinc = class(TForm)
@@ -35,7 +35,6 @@ type
ButtonCommande: TButton; ButtonCommande: TButton;
ButtonTest: TButton; ButtonTest: TButton;
ButtonInfo: TButton; ButtonInfo: TButton;
GroupBox2: TGroupBox;
MainMenu1: TMainMenu; MainMenu1: TMainMenu;
Interface1: TMenuItem; Interface1: TMenuItem;
MenuConnecterUSB: TMenuItem; MenuConnecterUSB: TMenuItem;
@@ -73,8 +72,6 @@ type
Versions1: TMenuItem; Versions1: TMenuItem;
ChronoDetect: TMenuItem; ChronoDetect: TMenuItem;
ClientSocketCDM: TClientSocket; ClientSocketCDM: TClientSocket;
Label1: TLabel;
EditNbTrains: TEdit;
FichierSimu: TMenuItem; FichierSimu: TMenuItem;
ButtonEcrCV: TButton; ButtonEcrCV: TButton;
ButtonReprise: TButton; ButtonReprise: TButton;
@@ -88,6 +85,9 @@ type
EditGenli: TEdit; EditGenli: TEdit;
Button1: TButton; Button1: TButton;
Button2: TButton; Button2: TButton;
Config: TMenuItem;
Label1: TLabel;
LabelNbTrains: TLabel;
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure MSCommUSBLenzComm(Sender: TObject); procedure MSCommUSBLenzComm(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure FormClose(Sender: TObject; var Action: TCloseAction);
@@ -130,7 +130,6 @@ type
procedure ClientSocketLenzDisconnect(Sender: TObject; procedure ClientSocketLenzDisconnect(Sender: TObject;
Socket: TCustomWinSocket); Socket: TCustomWinSocket);
procedure ChronoDetectClick(Sender: TObject); procedure ChronoDetectClick(Sender: TObject);
procedure EditNbTrainsKeyPress(Sender: TObject; var Key: Char);
procedure FichierSimuClick(Sender: TObject); procedure FichierSimuClick(Sender: TObject);
procedure ButtonEcrCVClick(Sender: TObject); procedure ButtonEcrCVClick(Sender: TObject);
procedure ButtonRepriseClick(Sender: TObject); procedure ButtonRepriseClick(Sender: TObject);
@@ -139,6 +138,7 @@ type
procedure Quitter1Click(Sender: TObject); procedure Quitter1Click(Sender: TObject);
procedure Button1Click(Sender: TObject); procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject); procedure Button2Click(Sender: TObject);
procedure ConfigClick(Sender: TObject);
private private
{ Déclarations privées } { Déclarations privées }
@@ -159,6 +159,7 @@ const_droit=2;const_devieD=1; // positions transmises par la centrale LENZ
const_devieG=3; const_devieG=3;
MaxElParcours=4000; MaxElParcours=4000;
EtatSign : array[0..13] of string[20] =('carré','sémaphore','sémaphore cli','vert','vert cli','violet', 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'); '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; var ancien_tablo_signalCplx,EtatsignalCplx : array[0..MaxAcc] of word;
AvecInitAiguillages,tempsCli,combine,NbreFeux,pasreponse,AdrDevie,precedent , AvecInitAiguillages,tempsCli,combine,NbreFeux,pasreponse,AdrDevie,precedent ,
NombreImages,signalCpx,branche_trouve,Indexbranche_trouve,Actuel,Signal_suivant, 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, Hors_tension2,traceSign,TraceZone,Ferme,parSocket,ackCdm,
NackCDM,MsgSim : boolean; NackCDM,MsgSim : boolean;
TraceListe,clignotant,nack,Maj_feux_cours : boolean; TraceListe,clignotant,nack,Maj_feux_cours : boolean;
branche : array [1..100] of string; branche : array [1..100] of string;
Train : array [1..100,1..MaxElParcours] of integer;
const const
ClBleuClair=$FF7070 ; ClBleuClair=$FF7070 ;
Cyan=$FFA0A0; Cyan=$FFA0A0;
clviolet=$FF00FF; clviolet=$FF00FF;
//GrisF=$333333;
GrisF=$414141; GrisF=$414141;
clOrange=$0077FF; clOrange=$0077FF;
Feu_X=50;Feu_Y=91; Feu_X=50;Feu_Y=91;
couleurTrain : array[1..8] of Tcolor = (clYellow,clLime,clOrange,clAqua,clFuchsia,clLtGray,clred,clWhite);
var var
FormPrinc: TFormPrinc; FormPrinc: TFormPrinc;
ack,portCommOuvert,trace,AffMem,AfficheDet,CDM_connecte,parSocketCDM, ack,portCommOuvert,trace,AffMem,AfficheDet,CDM_connecte,parSocketCDM,
DebugOuv,Raz_Acc_signaux,AvecInit,AvecTCO,terminal : boolean; DebugOuv,Raz_Acc_signaux,AvecInit,AvecTCO,terminal : boolean;
tablo : array of byte; tablo : array of byte;
Enregistrement,AdresseIP,chaine_Envoi,chaine_recue,AdresseIPCDM,recuCDM,Id_CDM,Af, Enregistrement,chaine_Envoi,chaine_recue,Id_CDM,Af,
ConfStCom,entete,suffixe : string; entete,suffixe,ConfStCom : string;
maxaiguillage,detecteur_chgt,Temps,TpsRecuCom,NumPort,Tempo_init,Suivant,TypeGen, maxaiguillage,detecteur_chgt,Temps,TpsRecuCom,Tempo_init,Suivant,TypeGen,
NbreImagePligne,Port,NbreBranches,Index2_det,branche_det,Index_det, NbreImagePligne,NbreBranches,Index2_det,branche_det,Index_det,
portCDM,I_simule : integer; I_simule : integer;
Ancien_detecteur,detecteur : array[0..1024] of boolean; // anciens état des détecteurs et adresses des détecteurs et leur état 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 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 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 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 Tablo_Simule : array[0..200] of
record record
tick : longint; tick : longint;
Detecteur,etat : integer ; Detecteur,etat : integer ;
end; 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; tablo_CV : array [1..255] of integer;
couleur : Tcolor; couleur : Tcolor;
fichier : text; fichier : text;
@@ -285,7 +295,7 @@ var
{$R *.dfm} {$R *.dfm}
// utilisation dans unité UnitPilote // utilisation dans unité UnitPilote et configunit
function Index_feu(adresse : integer) : integer; function Index_feu(adresse : integer) : integer;
procedure dessine_feu2(Acanvas : Tcanvas;EtatSignal : word); procedure dessine_feu2(Acanvas : Tcanvas;EtatSignal : word);
procedure dessine_feu3(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 Affiche(s : string;lacouleur : TColor);
procedure envoi_signal(Adr : integer); procedure envoi_signal(Adr : integer);
procedure pilote_direction(Adr,nbre : integer); procedure pilote_direction(Adr,nbre : integer);
procedure connecte_USB;
procedure deconnecte_usb;
function IsWow64Process: Boolean;
implementation implementation
@@ -1023,13 +1036,7 @@ begin
envoi:=ack; envoi:=ack;
end; 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 // prépare la chaîne de commande pour un accessoire via CDM
Function chaine_CDM_Acc(adresse,etat1 : integer) : string; Function chaine_CDM_Acc(adresse,etat1 : integer) : string;
@@ -1059,28 +1066,7 @@ begin
chaine_CDM_Acc:=so+s; chaine_CDM_Acc:=so+s;
end; 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" // active ou désactive une sortie. Une adresse comporte deux sorties identifiées par "octet"
// Adresse : adresse de l'accessoire // Adresse : adresse de l'accessoire
@@ -1298,6 +1284,8 @@ begin
if (EtatSignalCplx[adr]<>code) then if (EtatSignalCplx[adr]<>code) then
begin begin
if (traceSign) then Affiche('Signal directionnel: ad'+IntToSTR(adr)+'='+intToSTR(code),clOrange); 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 case code of
0 : begin pilote_acc(adr,1,feu); // sortie 1 à 0 0 : begin pilote_acc(adr,1,feu); // sortie 1 à 0
sleep(tempoFeu); sleep(tempoFeu);
@@ -1344,6 +1332,7 @@ begin
if (EtatSignalCplx[adr]<>code) then if (EtatSignalCplx[adr]<>code) then
begin begin
if traceSign then Affiche('signal directionnel CDF: '+IntToSTR(adr)+' '+intToSTR(code),ClOrange); 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 case code of
// éteindre toutes les leds // éteindre toutes les leds
@@ -1379,6 +1368,8 @@ begin
if (EtatSignalCplx[adr]<>code) then if (EtatSignalCplx[adr]<>code) then
begin begin
if traceSign then Affiche('signal directionnel LEB: '+IntToSTR(adr)+' '+intToSTR(code),ClOrange); 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 case code of
0 : begin pilote_acc(adr+5,2,feu) ; pilote_acc(adr+6,2,feu) ;end; //00 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 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]; ancien_tablo_signalCplx[adresse]:=EtatSignalCplx[adresse];
aspect:=code_to_aspect(code); aspect:=code_to_aspect(code);
if traceSign then affiche('Signal CDF: '+intToSTR(adresse)+' '+intToSTR(code),clOrange); 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=carre) then pilote_acc(adresse,2,feu) ;
if (aspect=semaphore) then pilote_acc(adresse,1,feu) ; if (aspect=semaphore) then pilote_acc(adresse,1,feu) ;
@@ -1452,6 +1445,14 @@ begin
if Combine<>0 then s:=s+' + '+etatSign[combine]; if Combine<>0 then s:=s+' + '+etatSign[combine];
Affiche(s,clOrange); Affiche(s,clOrange);
end; 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 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 if (Combine=0) then
@@ -1532,6 +1533,12 @@ begin
if Combine<>0 then s:=s+' + '+etatSign[combine]; if Combine<>0 then s:=s+' + '+etatSign[combine];
Affiche(s,clOrange); Affiche(s,clOrange);
end; 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 if combine=0 then
case (code) of case (code) of
@@ -1588,6 +1595,12 @@ begin
if Combine<>0 then s:=s+' + '+etatSign[combine]; if Combine<>0 then s:=s+' + '+etatSign[combine];
Affiche(s,clOrange); Affiche(s,clOrange);
end; 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 // pour Unisemaf, la cible est définie dans le champ Unisemaf de la structure feux
@@ -1881,6 +1894,8 @@ begin
ancien_tablo_signalCplx[adr]:=EtatSignalCplx[adr]; 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 (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 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; if (aspect=semaphore) or (aspect=vert) or (aspect=carre) or (aspect=jaune) then mode:=1 else mode:=2;
case mode of case mode of
@@ -1928,6 +1943,7 @@ begin
ancien_tablo_signalCplx[adresse]:=EtatSignalCplx[adresse]; ancien_tablo_signalCplx[adresse]:=EtatSignalCplx[adresse];
aspect:=code_to_aspect(code); // transforme le motif de bits en numéro "code des aspects des signaux" 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 (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); dessine_feu(adresse);
end; end;
end; end;
@@ -1959,6 +1975,12 @@ begin
if CombineLoc<>0 then s:=s+' + '+etatSign[combineLoc]; if CombineLoc<>0 then s:=s+' + '+etatSign[combineLoc];
Affiche(s,clOrange); Affiche(s,clOrange);
end; 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: // spécifique au décodeur digital bahn:
// si le signal affichait un signal combiné, il faut éteindre le signal avec un sémaphore // si le signal affichait un signal combiné, il faut éteindre le signal avec un sémaphore
// avant d'afficher le nouvel état non combiné // avant d'afficher le nouvel état non combiné
@@ -3017,40 +3039,8 @@ begin
// adresse ip et port de la centrale // adresse ip et port de la centrale
// AfficheDet:=true; // AfficheDet:=true;
s:=lit_ligne; s:=lit_ligne;
i:=pos(':',s); i:=pos(':',s);
if i<>0 then begin adresseIP:=copy(s,1,i-1);Delete(s,1,i);port:=StrToINT(s);end 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;
else begin adresseIP:='0';parSocket:=false;end; else begin adresseIP:='0';parSocket:=false;end;
// configuration du port com // configuration du port com
@@ -3064,14 +3054,14 @@ begin
if erreur<>0 then Affiche('Erreur temporisation entre 2 octets',clred); if erreur<>0 then Affiche('Erreur temporisation entre 2 octets',clred);
// temporisation attente maximale interface // temporisation attente maximale interface
s:=lit_ligne; s:=lit_ligne;
val(s,TimoutMaxInterface,erreur); 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 //entete
s:=lit_ligne; s:=lit_ligne;
val(s,Valeur_entete,erreur); val(s,Valeur_entete,erreur);
entete:=''; entete:='';
case Valeur_entete of case Valeur_entete of
0 : begin entete:='';suffixe:='';end; 0 : begin entete:='';suffixe:='';end;
1 : begin entete:=#$FF+#$FE;suffixe:='';end; 1 : begin entete:=#$FF+#$FE;suffixe:='';end;
@@ -4890,13 +4880,14 @@ end;
// transmis dans le tableau Event_det // transmis dans le tableau Event_det
// Variable globale: El_suivant : adresse du détecteur suivant le détecteur "actuel" // Variable globale: El_suivant : adresse du détecteur suivant le détecteur "actuel"
// Actuel,Suivant : nouveaux détecteurs du canton suivant // Actuel,Suivant : nouveaux détecteurs du canton suivant
// Résultat:
// si 0 : pas de route // si 0 : pas de route
// si 1 : détecteur det1 non trouvé // si 1 : détecteur det1 non trouvé
// si 2 : détecteur det2 non trouvé // si 2 : détecteur det2 non trouvé
// si 3 : erreur fatale // 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 var
i,i1,i2,j,k,IndexBranche_det1,IndexBranche_det2,index_i1,index_i2, i,i1,i2,j,k,IndexBranche_det1,IndexBranche_det2,index_i1,index_i2,
branche_trouve_det1,branche_trouve_det2,Adr,AdrPrec,position,Btype,BTypePrec, branche_trouve_det1,branche_trouve_det2,Adr,AdrPrec,position,Btype,BTypePrec,
@@ -4960,8 +4951,10 @@ begin
TypeSuiv:=Btype; // si aiguillage bis TypeSuiv:=Btype; // si aiguillage bis
//Affiche(intToSTR(adr)+'/'+intToStr(Btype),clorange); //Affiche(intToSTR(adr)+'/'+intToStr(Btype),clorange);
AdrPrec:=AdrFonc;AdrFonc:=Adr; AdrPrec:=AdrFonc;AdrFonc:=Adr;
TypePrec:=TypeFonc;TypeFonc:=typeGen; TypePrec:=TypeFonc;TypeFonc:=typeGen;
i:=i+1; i:=i+1;
sortie:=(Btype=1) or (Btype=4) or (i=20) or (Adr=0);
until (sortie) ; // boucle de parcours
end; end;
if (i=20) then if (i=20) then
@@ -4985,8 +4978,8 @@ begin
begin begin
// trouvé la route si j=2 : - si j=3 : + // trouvé la route si j=2 : - si j=3 : +
if (TraceListe) then AfficheDebug('Route trouvée',clyellow); 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); AdrPrec:=detecteur_suivant_El(det2,1,det1,1);
// le train vient de det1, quitte det2 et va vers Adr // le train vient de det1, quitte det2 et va vers Adr
@@ -5014,13 +5007,57 @@ begin
if TraceListe then AfficheDebug('route ok car '+IntToStr(AdrPrec)+'=0 à l''index '+intToSTR(i),clyellow); if TraceListe then AfficheDebug('route ok car '+IntToStr(AdrPrec)+'=0 à l''index '+intToSTR(i),clyellow);
Mem[AdrPrec]:=false; // inutile 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; Route[N_routes].Mem1:=det2;Route[N_routes].Mem2:=AdrSuiv;
if traceListe then AfficheDebug('Mise à 1 mémoire traitée pour l''index '+intToSTR(i),clyellow);
// affecter la route à un train
MemZone[det1,det2]:=FALSE; // efface zone précédente 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;
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 begin
With FormDebug.MemoDet do //FormDebug.MemoDet.lines.add('Nouveau train');
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 begin
s:='train '+IntToSTR(Train_Courant)+' '+intToStr(det1)+' à '+intToStr(det2)+' => Mem '+IntToSTR(det2)+' à '+IntTOStr(AdrSuiv); s:='train '+IntToSTR(Train_Courant)+' '+intToStr(det1)+' à '+intToStr(det2)+' => Mem '+IntToSTR(det2)+' à '+IntTOStr(AdrSuiv);
Lines.Add(s); Lines.Add(s);
@@ -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 // mise à jour de l'état d'un feu en fontion de son environnement et affiche le feu
procedure Maj_Feu(Adrfeu : integer); procedure Maj_Feu(Adrfeu : integer);
var i,j,k1,k2,BtypeSuiv,Adr_det,etat,Adr,Aig,DetPrec1,DetPrec2,Detprec3,Detprec4,Adr_El_Suiv, 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 ;
Btype_el_suivant,det_initial,bt,el_suiv,modele : integer ; Btype_el_suivant,det_initial,bt,el_suiv,modele : integer ;
PresTrain,Aff_semaphore,car : boolean; PresTrain,Aff_semaphore,car : boolean;
s : string; s : string;
@@ -5115,16 +5151,14 @@ begin
begin Maj_Etat_Signal(AdrFeu,violet) ; Envoi_signauxCplx; begin Maj_Etat_Signal(AdrFeu,violet) ; Envoi_signauxCplx;
exit; exit;
end end
else if not(carre_signal(AdrFeu)) then //ici ya pas de check and feux[i].check.checked then 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;
begin Maj_Etat_Signal(AdrFeu,blanc);Envoi_signauxCplx; begin Maj_Etat_Signal(AdrFeu,blanc);Envoi_signauxCplx;
exit; exit;
end; end;
end; end;
//if AffSignal then AfficheDebug('Debut du traitement général',clYellow); //if AffSignal then AfficheDebug('Debut du traitement général',clYellow);
// traitement des feux >3 feux différents de violet (cas général) // traitement des feux >3 feux différents de violet (cas général)
if (Feux[i].aspect>=3) and (EtatSignalCplx[AdrFeu]<>violet_F) then
if (Feux[i].aspect>=3) and (EtatSignalCplx[AdrFeu]<>violet_F) then if (Feux[i].aspect>=3) and (EtatSignalCplx[AdrFeu]<>violet_F) then
begin begin
// détecteurs précédent le feu , pour déterminer si leurs mémoires de zones sont à 1 pour libérer le carré // détecteurs précédent le feu , pour déterminer si leurs mémoires de zones sont à 1 pour libérer le carré
@@ -5170,7 +5204,7 @@ begin
if DetPrec1<9997 then // route bloquée par aiguillage mal positionné if DetPrec1<9997 then // route bloquée par aiguillage mal positionné
begin begin
DetPrec2:=detecteur_suivant_El(det_initial,1,DetPrec1,1); DetPrec2:=detecteur_suivant_El(det_initial,1,DetPrec1,1);
if DetPrec2<9997 then if DetPrec2<9997 then
begin begin
DetPrec3:=detecteur_suivant_El(DetPrec1,1,DetPrec2,1); DetPrec3:=detecteur_suivant_El(DetPrec1,1,DetPrec2,1);
if DetPrec3<9997 then if DetPrec3<9997 then
@@ -5180,13 +5214,13 @@ begin
PresTrain:=//MemZone[DetPrec4,detPrec3] or PresTrain:=//MemZone[DetPrec4,detPrec3] or
MemZone[DetPrec3,detPrec2] or MemZone[DetPrec2,detPrec1] or MemZone[DetPrec1,Det_initial] or presTrain ; MemZone[DetPrec3,detPrec2] or MemZone[DetPrec2,detPrec1] or MemZone[DetPrec1,Det_initial] or presTrain ;
// Affiche('MemZone'+intToSTR(DetPrec3)+' '+IntToSTR(detPrec2) = '+MemZone[DetPrec3,detPrec2] // Affiche('MemZone'+intToSTR(DetPrec3)+' '+IntToSTR(detPrec2) = '+MemZone[DetPrec3,detPrec2]
end; end;
end; end;
end; end;
end; end;
inc(j); inc(j);
until (j>=5); 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; end;
if AffSignal then afficheDebug('Fin de la recherche des 4 détecteurs précédents-----',clOrange); 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 // 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); car:=carre_signal(AdrFeu);
if AffSignal and car then AfficheDebug('le signal a des aiguilles en talon aval mal positionnées',clYellow); 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 (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) if (Feux[i].aspect>=4) and ( (not(PresTrain) and Feux[i].VerrouCarre) or car) then Maj_Etat_Signal(AdrFeu,carre)
else
else else
begin begin
// si on quitte le détecteur on affiche un sémaphore : attention tester le sens de circulation // 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 // pour ne pas passer au rouge un feu à contresens.
if AffSignal then Affiche('test du sémaphore',clYellow);
// trouver la mémoire de zone MemZone[Adr_det,?] qui a déclenché le feu rouge // 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); if AffSignal then AfficheDebug('test du sémaphore',clYellow);
Aff_semaphore:=test_memoire_zones(AdrFeu); // test si présence train après signal 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 AffSignal then AfficheDebug('train après signal-> sémaphore ou carré',clYellow);
if testBit(EtatSignalCplx[Adrfeu],carre)=FALSE then Maj_Etat_Signal(AdrFeu,semaphore); if testBit(EtatSignalCplx[Adrfeu],carre)=FALSE then Maj_Etat_Signal(AdrFeu,semaphore);
end end
else else
begin
begin begin
// si aiguille locale déviée // si aiguille locale déviée
Aig:=Aiguille_deviee(Adrfeu); Aig:=Aiguille_deviee(Adrfeu);
@@ -5228,8 +5259,7 @@ begin
begin begin
// sinon si signal suivant=jaune // sinon si signal suivant=jaune
if (TestBit(etat,jaune)) then Maj_Etat_Signal(AdrFeu,jaune_cli); if (TestBit(etat,jaune)) then Maj_Etat_Signal(AdrFeu,jaune_cli);
end; end;
end
end end
else else
// aiguille locale non déviée // aiguille locale non déviée
@@ -5426,6 +5456,7 @@ end;
Affiche('Demande état des aiguillages',ClYellow); Affiche('Demande état des aiguillages',ClYellow);
for i:=1 to maxaiguillage do for i:=1 to maxaiguillage do
begin begin
demande_info_acc(i);
end; end;
end; end;
@@ -5454,6 +5485,7 @@ begin
event_det_tick[N_event_tick].suivant:=AdresseActuel; event_det_tick[N_event_tick].suivant:=AdresseActuel;
//event_det_tick[i].train:=0; // traité //event_det_tick[i].train:=0; // traité
end;
end end
else else
if AffAffect then AfficheDebug('Pas trouvé',clyellow); if AffAffect then AfficheDebug('Pas trouvé',clyellow);
@@ -5490,7 +5522,7 @@ begin
inc(N_event_det); inc(N_event_det);
event_det[N_event_det]:=Adresse; event_det[N_event_det]:=Adresse;
calcul_zones; // en avant les calculs calcul_zones; // en avant les calculs
end; end;
// stocke les changements d'état des détecteurs dans le tableau chronologique // stocke les changements d'état des détecteurs dans le tableau chronologique
if (N_Event_tick<Max_Event_det_tick) then 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].train:=0;
event_det_tick[N_event_tick].tick:=tick; 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); // Affiche('stockage de '+intToSTR(N_event_tick)+' à '+intToSTR(etat01),clyellow);
end; end;
exit;
//------------------------plus utilisé ---------------- //------------------------plus utilisé ----------------
{ {
// front descendant // front descendant
@@ -5527,7 +5560,7 @@ begin
if AffAffect then if AffAffect then
begin begin
s:='Nouveau train sur '+intToSTR(Adresse)+'='+intToSTR(N_trains); s:='Nouveau train sur '+intToSTR(Adresse)+'='+intToSTR(N_trains);
affiche(s,clyellow); affiche(s,clyellow);
afficheDebug(s,clyellow); afficheDebug(s,clyellow);
end; end;
event_det_tick[N_event_tick].train:=N_trains; 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; end;
// évènement d'aiguillage // é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, var i,index1,index2,AdresseE,Adet,det_suiv,pos,Btype,BtypeE,train1,train2,train,
index : integer; index : integer;
trouve,trouve1,trouve2 : boolean; trouve,trouve1,trouve2 : boolean;
@@ -5575,7 +5608,7 @@ begin
end; end;
if (i>20) then begin Affiche('Erreur 671',clRed);exit;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); 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 // étape 2 : trouver si un train est sur le détecteur dans le tableau event_det_tick
i:=N_Event_tick; i:=N_Event_tick;
repeat repeat
@@ -5618,7 +5651,7 @@ begin
if trouve2 and (train2=train) then if trouve2 and (train2=train) then
begin begin
Affiche(' détecteur Adj2='+intToSTR(Adj2)+' train='+intToSTR(train),clyellow); 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; event_det_tick[index].suivant:=Adj1;
end; end;
@@ -5991,6 +6024,42 @@ begin
i:=1; i:=1;
repeat repeat
val('$'+copy(s,i,2),v,erreur); 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); FreeLibrary(DLL);
end; end;
Result:=IsWow64; Result:=IsWow64;
@@ -6043,79 +6112,6 @@ begin
DeConnecterCDMRail.enabled:=false; DeConnecterCDMRail.enabled:=false;
end; end;
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 else
begin begin
Affiche('port COM'+intToSTR(NumPort)+' NON ouvert',clRed) ; Affiche('port COM'+intToSTR(NumPort)+' NON ouvert',clRed) ;
@@ -6129,6 +6125,11 @@ begin
s,s2,Url,LocalFile : string; s,s2,Url,LocalFile : string;
trouve,AvecMaj : Boolean; trouve,AvecMaj : Boolean;
V_utile,V_publie : real; 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; Application.onHint:=doHint;
// version d'OS pour info // version d'OS pour info
@@ -6145,21 +6146,18 @@ begin
N_Trains:=0; N_Trains:=0;
NivDebug:=0; NivDebug:=0;
DebugOuv:=True; DebugOuv:=True;
//LireunaccessoireversunfichierdeCV1.Visible:=false; //LireunaccessoireversunfichierdeCV1.Visible:=false;
AvecInit:=true; //&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
AvecTCO:=false;
EditNbTrains.Text:=IntToSTR(N_Trains);
// créée la fenetre vérification de version
AvecInit:=true; //&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& AvecInit:=true; //&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
AvecTCO:=false; AvecTCO:=false;
// créée la fenetre vérification de version // créée la fenetre vérification de version
FormVersion:=TformVersion.Create(Self); FormVersion:=TformVersion.Create(Self);
ferme:=false;
CDM_connecte:=false;
pasreponse:=0; pasreponse:=0;
Nbre_recu_cdm:=0; Nbre_recu_cdm:=0;
AffMem:=true; AffMem:=true;
@@ -6172,9 +6170,11 @@ begin
// TCO // TCO
if avectco then if avectco then
begin
//créée la fenêtre TCO //créée la fenêtre TCO
FormTCO:=TformTCO.Create(Self); FormTCO:=TformTCO.Create(Self);
FormTCO.show; FormTCO.show;
construit_TCO;
affiche_TCO; affiche_TCO;
//Formprinc.Hide; //Formprinc.Hide;
end; end;
@@ -6554,17 +6554,30 @@ begin
Affiche('En jaune : rétrosignalisation reçue depuis l''interface',ClWhite); Affiche('En jaune : rétrosignalisation reçue depuis l''interface',ClWhite);
end; end;
procedure TFormPrinc.MenuConnecterUSBClick(Sender: TObject); procedure TFormPrinc.MenuConnecterUSBClick(Sender: TObject);
begin begin
Hors_tension2:=false; Hors_tension2:=false;
connecte_USB; connecte_USB;
end;
procedure deconnecte_usb;
begin
Ferme:=true;
if portCommOuvert then
begin
portCommOuvert:=false;
Formprinc.MSCommUSBLenz.Portopen:=false; Formprinc.MSCommUSBLenz.Portopen:=false;
end; end;
portCommOuvert:=false; portCommOuvert:=false;
with formprinc do with formprinc do
begin begin
ClientSocketLenz.close;
MenuConnecterUSB.enabled:=true;
DeConnecterUSB.enabled:=false;
ConnecterCDMRail.enabled:=true;
DeConnecterCDMRail.enabled:=false;
end;
end; end;
procedure TFormPrinc.DeconnecterUSBClick(Sender: TObject); procedure TFormPrinc.DeconnecterUSBClick(Sender: TObject);
@@ -6691,7 +6704,7 @@ end;
ButtonEcrCV.Enabled:=true; ButtonEcrCV.Enabled:=true;
LireunfichierdeCV1.enabled:=true; LireunfichierdeCV1.enabled:=true;
LireunaccessoireversunfichierdeCV1.Enabled:=true; LireunaccessoireversunfichierdeCV1.Enabled:=true;
LabelTitre.caption:=titre+' Interface connectée par Ethernet'; LabelTitre.caption:=titre+' Interface connectée par Ethernet';
end; end;
procedure TFormPrinc.ClientSocketCDMConnect(Sender: TObject;Socket: TCustomWinSocket); procedure TFormPrinc.ClientSocketCDMConnect(Sender: TObject;Socket: TCustomWinSocket);
@@ -6711,7 +6724,7 @@ begin
// réception d'un message de CDM rail // réception d'un message de CDM rail
procedure TFormPrinc.ClientSocketCDMRead(Sender: TObject;Socket: TCustomWinSocket); procedure TFormPrinc.ClientSocketCDMRead(Sender: TObject;Socket: TCustomWinSocket);
var i,j,k,erreur, adr,adr2,etat,etataig : integer ; var i,j,k,erreur, adr,adr2,etat,etataig : integer ;
s,ss : string; s,ss : string;
traite,sort : boolean; traite,sort : boolean;
begin begin
inc(Nbre_recu_cdm); inc(Nbre_recu_cdm);
@@ -6765,7 +6778,7 @@ begin
j:=pos('CMDACC-ST_DT',recuCDM); j:=pos('CMDACC-ST_DT',recuCDM);
if j<>0 then if j<>0 then
begin 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); val(ss,adr,erreur);
i:=posEx('STATE=',recuCDM,j);ss:=copy(recuCDM,i+6,10); i:=posEx('STATE=',recuCDM,j);ss:=copy(recuCDM,i+6,10);
Delete(recuCDM,j,i+5-j); Delete(recuCDM,j,i+5-j);
@@ -6860,6 +6873,8 @@ begin
Affiche('Version 1.02 : vérification automatique des versions',clLime); Affiche('Version 1.02 : vérification automatique des versions',clLime);
Affiche('Version 1.1 : gestion des tableaux indicateurs de direction',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(' 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(' verrouillages routes pour trains consécutifs',clLime);
Affiche('Version 1.2 : Renforcement de l''algorithme de suivi des trains',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); Affiche('Version 1.3 : Décodeur Unisemaf fonctionnel - Lecture/écriture des CV',clLime);
@@ -6883,7 +6898,7 @@ begin
begin begin
s:=IntToSTR(i)+' Tick='+IntToSTR(event_det_tick[i].tick)+' Det='; s:=IntToSTR(i)+' Tick='+IntToSTR(event_det_tick[i].tick)+' Det=';
trouve:=false; trouve:=false;
for j:=1 to 1100 do for j:=1 to 1100 do
begin begin
etat:=event_det_tick[i].detecteur[j]; etat:=event_det_tick[i].detecteur[j];
if etat<>-1 then if etat<>-1 then
@@ -6894,15 +6909,6 @@ begin
trouve:=true; trouve:=true;
end; 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; end;
if trouve then Affiche(s,clyellow); if trouve then Affiche(s,clyellow);
end; end;
@@ -7086,5 +7092,13 @@ begin
end; end;
procedure TFormPrinc.Button2Click(Sender: TObject); 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); Tformconfig.create(self);
formconfig.showmodal; formconfig.showmodal;

Binary file not shown.

View File

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

View File

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

Binary file not shown.

View File

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

View File

@@ -8,7 +8,6 @@ uses
type type
TFormTCO = class(TForm) TFormTCO = class(TForm)
DrawGrid: TDrawGrid;
Button1: TButton; Button1: TButton;
LabelX: TLabel; LabelX: TLabel;
Label2: TLabel; Label2: TLabel;
@@ -19,14 +18,25 @@ type
PopupMenu1: TPopupMenu; PopupMenu1: TPopupMenu;
Position1: TMenuItem; Position1: TMenuItem;
N1: TMenuItem; N1: TMenuItem;
Insrer1: TMenuItem;
aiguillageG_PG: TMenuItem;
Label1: TLabel;
aiguillageD_PD: TMenuItem;
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure DrawGridDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
procedure Button1Click(Sender: TObject); procedure Button1Click(Sender: TObject);
procedure ImageTCOClick(Sender: TObject); procedure ImageTCOClick(Sender: TObject);
procedure FormActivate(Sender: TObject); procedure FormActivate(Sender: TObject);
procedure ImageTCOContextPopup(Sender: TObject; MousePos: TPoint; procedure ImageTCOContextPopup(Sender: TObject; MousePos: TPoint;
var Handled: Boolean); 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 private
{ Déclarations privées } { Déclarations privées }
public public
@@ -36,8 +46,9 @@ type
var var
FormTCO: TFormTCO; FormTCO: TFormTCO;
Forminit : boolean;
NbreCellX,NbreCellY,HtImageTCO,LargImageTCO,XclicCell,YclicCell : integer; 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; tco : array[1..20,1..20] of Tbranche;
procedure construit_TCO; procedure construit_TCO;
@@ -80,6 +91,7 @@ begin
end; end;
end; end;
// élément de voie horizontale
procedure dessin_voie(x,y : integer); procedure dessin_voie(x,y : integer);
var x1,y1 : integer; var x1,y1 : integer;
r : Trect; r : Trect;
@@ -91,25 +103,25 @@ begin
end; end;
with formTCO.ImageTCO.canvas do with formTCO.ImageTCO.canvas do
begin 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; Brush.COlor:=ClRed;
FillRect(r); FillRect(r);
end; end;
end; end;
// aiguillage pointe à gauche, monte gauche // aiguillage pointe à gauche, aiguillage gauche
procedure dessin_AigPGMG(x,y : integer;couleur : Tcolor); procedure TFormTCO.dessin_AigPG_AG(x,y : integer;couleur : Tcolor);
var x0,y0,x1,y1,x2,y2,x3,y3,x4,y4,jy1,jy2 : integer; var x0,y0,x1,y1,x2,y2,x3,y3,x4,y4,jy1,jy2 : integer;
r : Trect; r : Trect;
begin begin
x0:=x*LargeurCell; x0:=(x-1)*LargeurCell;
y0:=y*HauteurCell; y0:=(y-1)*HauteurCell;
with formTCO.ImageTCO.canvas do with ImageTCO.canvas do
begin begin
Brush.COlor:=couleur; Brush.Color:=couleur;
pen.color:=couleur; pen.color:=couleur;
Pen.Mode:=PmCopy;
jy1:=y0+(HauteurCell div 2)-3; // pos Y de la bande sup jy1:=y0+(HauteurCell div 2)-3; // pos Y de la bande sup
jy2:=y0+(HauteurCell div 2)+3; // pos Y de la bande inf jy2:=y0+(HauteurCell div 2)+3; // pos Y de la bande inf
@@ -131,18 +143,50 @@ begin
end; end;
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 // 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; var jy1,jy2,x0,y0,i,x1,y1,x2,y2,x3,y3,x4,y4 : integer;
r : Trect; r : Trect;
begin begin
x0:=x*LargeurCell; x0:=(x-1)*LargeurCell;
y0:=y*HauteurCell; y0:=(y-1)*HauteurCell;
with formTCO.ImageTCO.canvas do with ImageTCO.canvas do
begin begin
Brush.COlor:=Couleur; Brush.COlor:=Couleur;
pen.color:=Couleur; pen.color:=Couleur;
Pen.Mode:=PmCopy;
jy1:=y0+(HauteurCell div 2)-3; // pos Y de la bande sup jy1:=y0+(HauteurCell div 2)-3; // pos Y de la bande sup
jy2:=y0+(HauteurCell div 2)+3; // pos Y de la bande inf jy2:=y0+(HauteurCell div 2)+3; // pos Y de la bande inf
@@ -163,7 +207,41 @@ begin
end; end;
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; procedure construit_TCO;
var x,y,i,j,Max,indexMax : integer; var x,y,i,j,Max,indexMax : integer;
begin begin
@@ -193,8 +271,6 @@ begin
TCO[i,5].Adresse:=BrancheN[IndexMax,i].Adresse; TCO[i,5].Adresse:=BrancheN[IndexMax,i].Adresse;
TCO[i,5].Btype:=BrancheN[IndexMax,i].Btype; TCO[i,5].Btype:=BrancheN[IndexMax,i].Btype;
end; end;
end; end;
procedure Affiche_TCO ; procedure Affiche_TCO ;
@@ -220,7 +296,7 @@ begin
if Btype=2 then s:='A'+s; if Btype=2 then s:='A'+s;
if Btype=3 then s:='A'+s+'B'; 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; end;
end; end;
@@ -228,114 +304,146 @@ end;
procedure TFormTCO.FormCreate(Sender: TObject); procedure TFormTCO.FormCreate(Sender: TObject);
begin begin
caption:='TCO'; caption:='TCO';
NbreCellX:=20; NbreCellX:=20;
NbreCellY:=10; NbreCellY:=10;
LargeurCell:=35; LargeurCell:=35;
HauteurCell:=35; HauteurCell:=35;
XclicCell:=1;
YclicCell:=1;
KeyPreview:=true; // valide les évènements clavier
// grille; // grille;
// HtImageTCO:=ImageTCO.Height; // Entoure_cell(XclicCell,YclicCell);
end; 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); procedure TFormTCO.Button1Click(Sender: TObject);
begin begin
grille; repaint;
dessin_voie(3,3);
dessin_voie(10,4);
dessin_AigPGMG(7,6,clyellow);
end; end;
// clic gauche sur image
procedure TFormTCO.ImageTCOClick(Sender: TObject); procedure TFormTCO.ImageTCOClick(Sender: TObject);
var Position: TPoint; var Position: TPoint;
begin begin
Entoure_cell(XclicCell,YclicCell);
GetCursorPos(Position); GetCursorPos(Position);
Position:=ImageTCO.screenToCLient(Position); Position:=ImageTCO.screenToCLient(Position);
Xclic:=position.X;YClic:=position.Y; Xclic:=position.X;YClic:=position.Y;
XclicCell:=Xclic div largeurCell +1; XclicCell:=Xclic div largeurCell +1;
YclicCell:=Yclic div hauteurCell +1; YclicCell:=Yclic div hauteurCell +1;
LabelX.caption:=IntToSTR(XclicCell); LabelX.caption:=IntToSTR(XclicCell);
LabelY.caption:=IntToSTR(YclicCell); 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; end;
procedure TFormTCO.FormActivate(Sender: TObject); procedure TFormTCO.FormActivate(Sender: TObject);
begin begin
if not(Forminit) then
begin
FormInit:=true;
grille; grille;
Entoure_cell(XclicCell,YclicCell);
end;
{
dessin_voie(3,3); dessin_voie(3,3);
dessin_voie(10,4); dessin_voie(10,4);
dessin_AigPGMG(7,6,clyellow); dessin_AigPG_AG(7,6,clyellow);
dessin_cbgd(8,5,clyellow); dessin_AigPD_AD(12,6,clyellow);
formprinc.Hide; dessin_cbgd(8,5,clyellow);
dessin_voie(9,5);dessin_voie(10,5);
dessin_cdbas(11,5,clyellow); }
//formprinc.Hide;
end; end;
// evt qui se produit quand on clic droit dans l'image
procedure TFormTCO.ImageTCOContextPopup(Sender: TObject; MousePos: TPoint; var Handled: Boolean); procedure TFormTCO.ImageTCOContextPopup(Sender: TObject; MousePos: TPoint; var Handled: Boolean);
var Position: TPoint; var Position: TPoint;
begin begin
// efface le carré pointeur
Entoure_cell(XclicCell,YclicCell);
GetCursorPos(Position); GetCursorPos(Position);
Position:=ImageTCO.screenToCLient(Position); Position:=ImageTCO.screenToCLient(Position);
Xclic:=position.X;YClic:=position.Y; Xclic:=position.X;YClic:=position.Y;
XclicCell:=Xclic div largeurCell +1; XclicCell:=Xclic div largeurCell +1;
YclicCell:=Yclic div hauteurCell +1; YclicCell:=Yclic div hauteurCell +1;
LabelX.caption:=IntToSTR(XclicCell); LabelX.caption:=IntToSTR(XclicCell);
LabelY.caption:=IntToSTR(YclicCell); 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;
end. end.

View File

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

Binary file not shown.

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.

Binary file not shown.

View File

@@ -62,6 +62,7 @@ var
Fs:TFileStream; Fs:TFileStream;
lpBuffer: array[0..1024 + 1] of byte; lpBuffer: array[0..1024 + 1] of byte;
dwBytesRead: DWORD; dwBytesRead: DWORD;
dwTimeout : integer;
begin begin
Result:=False; Result:=False;
@@ -70,6 +71,9 @@ begin
try try
if Assigned(hSession) then if Assigned(hSession) then
begin 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); hService:=InternetOpenUrl(hSession, PChar(aUrl), nil, 0, INTERNET_FLAG_RELOAD, 0);
if Assigned(hService) then if Assigned(hService) then
try try
@@ -182,7 +186,7 @@ begin
end end
else else
begin begin
//Aff('Pas d''accès au site CDM rail'); //Affiche('Pas d''accès au site CDM rail',clorange);
end; end;
end; end;