Problème mémoire sur un programme?

**theclem35** · 21/12/2007, 18h50

Bonjour!

Je débute en VB, et je viens de terminer un programme.
Ce programme analyse certaines couleurs affichées à l'écran a partir d'une position enregistrée à la souris.

Suite a ce resultat il deplace le pointeur sur tel ou tel bouton, et tant que une certaine couleur attendue n'est pas affichée il execute plusieurs clics sur d'autres boutons.

Une fois cette couleur apparue, il recommence a 0, à 1 clic sur un bouton ...

C'est un peu comme les programmes qui deplacent la souris et cliquent tout seul à l'époque des cash-barres

Le problème étant qu'au bout d'une heure environ, le programme fait n'importe quoi, il clique nimporte où, bref on dirait qu'il perd la boule !!!
Il finit par s'arreter en se figeant et laissant son empreinte à l'écran.

Je remarque aussi que a chaque action, le programme utilise 8octets de memoire de +, et ce à l'infini ....

Quelqu'un aurait -il une solution à m'apporter ? Peut etre alleger la memoire a la fin de chaque boucle ?

Merci,
CLément

**OhMonBato** · 21/12/2007, 19h11

J'espère qu'il est pas trop tard, mais j'ajoute une boule de cristal sur ma liste au Père Noël, la toutes options, celle qui permet de deviner le code à distance, un must !

**droggo** · 21/12/2007, 19h39

Diu,

Envoyé par OhMonBato

J'espère qu'il est pas trop tard, mais j'ajoute une boule de cristal sur ma liste au Père Noël, la toutes options, celle qui permet de deviner le code à distance, un must !

Peu de chance de l'avoir, il y a des années que je cherche ça !

**theclem35** · 21/12/2007, 19h40

Et.. je crois que malheuresement c'est trop tard, j'ai entendu au JT de TF1 que le pere-noel est parti aujourdui de laponie !!!

Tu ne peux compter que sur des utilisateurs coopératifs ^^

Bon alors vu que je suis débutant je pense que vous allez un peu halluciner et me dire que je peux diviser mon code par deux mais bon

La Form :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
 
 
 
'Les déclarations
 
Dim Xpos As Long, Ypos As Long, CursPos As PointAPI
Dim t As Double, reg As Integer
Dim s As String
Dim r As Integer, g As Integer, b As Integer
 
Dim APPLIx As Integer, APPLIy As Integer, MARRONx As Integer, MARRONy As Integer, ORANGEx As Integer
Dim ORANGEy As Integer, COULEURx As Integer, COULEURy As Integer, BTNAx As Integer
Dim BTNAy As Integer, BTNBx As Integer, BTNBy As Integer, BTNCx As Integer
Dim BTNCy As Integer, BTNDx As Integer, BTNDy As Integer
Dim BTNVALIDx As Integer, BTNVALIDy As Integer, BTNANNULx As Integer, BTNANNULy As Integer
 
Dim pMarron As Integer, pOrange As Integer, ProcMarron As Variant, ProcOrange As Variant
Dim ProcMarron0SautsClics As Variant, ProcOrange0SautsClics As Variant, ProcMarron2SautsClics As Variant, ProcOrange2SautsClics As Variant
Dim ProcMarron3SautsClics As Variant, ProcOrange3SautsClics As Variant, ProcMarron4SautsClics As Variant, ProcOrange4SautsClics As Variant
 
'Fin des déclarations
 
 
'Timer du clic de sélection
 
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function GetTickCount Lib "kernel32" () As Long
 
Public Sub hbwait(millisecondes As Long)
    Dim attente As Long
    attente = GetTickCount + millisecondes
    Do Until GetTickCount >= attente
    DoEvents
    Sleep 1
    Loop
End Sub
 
'Fin du timer du clic de sélection
 
 
 
'Chargement de la Form
 
Private Sub Form_Load()
    TimerMarron.Enabled = False
    TimerOrange.Enabled = False
    DetectCouleur.Enabled = False
    Status.Caption = "Cliquez sur 'Lancer la Calibration'"
    ChoixSautsClics.Enabled = False
    Deb0sautsclics.Enabled = False
    Deb2sautsclics.Enabled = False
    Deb3sautsclics.Enabled = False
    Deb4sautsclics.Enabled = False
    ChoixCouleur.Enabled = False
    BtnMarron.Enabled = False
    BtnOrange.Enabled = False
 
 
    ProcMarron0SautsClics = Array(0, "ANNULER", 1, "ANNULER", 1, "BTNA", 1, "MARRON", 1, "VALIDER", 1, _
                           "BTNA", 1, "MARRON", 2, "VALIDER", 1, _
                           "BTNA", 1, "MARRON", 4, "VALIDER", 1, _
                           "BTNB", 1, "MARRON", 1, "BTNA", 1, "MARRON", 3, "VALIDER", 1, _
                           "BTNB", 1, "MARRON", 3, "BTNA", 1, "MARRON", 1, "VALIDER", 1, _
                           "BTNC", 1, "MARRON", 1, "BTNB", 1, "MARRON", 1, "BTNA", 1, "MARRON", 2, "VALIDER", 1, _
                           "BTNC", 1, "MARRON", 2, "BTNB", 1, "MARRON", 2, "BTNA", 1, "MARRON", 4, "VALIDER", 1, _
                           "BTNC", 1, "MARRON", 5, "BTNA", 1, "MARRON", 3, "VALIDER", 1, _
                           "BTND", 1, "MARRON", 2, "BTNC", 1, "MARRON", 2, "BTNA", 1, "MARRON", 6, "VALIDER", 1, _
                           "BTND", 1, "MARRON", 5, "BTNB", 1, "MARRON", 2, "BTNA", 1, "MARRON", 2, "VALIDER", 1, _
                           "BTND", 1, "MARRON", 10, "VALIDER", 1)
 
    ProcOrange0SautsClics = Array(0, "ANNULER", 1, "ANNULER", 1, "BTNA", 1, "ORANGE", 1, "VALIDER", 1, _
                           "BTNA", 1, "ORANGE", 2, "VALIDER", 1, _
                           "BTNA", 1, "ORANGE", 4, "VALIDER", 1, _
                           "BTNB", 1, "ORANGE", 1, "BTNA", 1, "ORANGE", 3, "VALIDER", 1, _
                           "BTNB", 1, "ORANGE", 3, "BTNA", 1, "ORANGE", 1, "VALIDER", 1, _
                           "BTNC", 1, "ORANGE", 1, "BTNB", 1, "ORANGE", 1, "BTNA", 1, "ORANGE", 2, "VALIDER", 1, _
                           "BTNC", 1, "ORANGE", 2, "BTNB", 1, "ORANGE", 2, "BTNA", 1, "ORANGE", 4, "VALIDER", 1, _
                           "BTNC", 1, "ORANGE", 5, "BTNA", 1, "ORANGE", 3, "VALIDER", 1, _
                           "BTND", 1, "ORANGE", 2, "BTNC", 1, "ORANGE", 2, "BTNA", 1, "ORANGE", 6, "VALIDER", 1, _
                           "BTND", 1, "ORANGE", 5, "BTNB", 1, "ORANGE", 2, "BTNA", 1, "ORANGE", 2, "VALIDER", 1, _
                           "BTND", 1, "ORANGE", 10, "VALIDER", 1)
 
    ProcMarron2SautsClics = Array(0, "ANNULER", 1, "ANNULER", 1, _
                           "VALIDER", 1, _
                           "BTNA", 1, "MARRON", 1, "VALIDER", 1, _
                           "BTNA", 1, "MARRON", 2, "VALIDER", 1, _
                           "BTNA", 1, "MARRON", 4, "VALIDER", 1, _
                           "BTNB", 1, "MARRON", 1, "BTNA", 1, "MARRON", 3, "VALIDER", 1, _
                           "BTNB", 1, "MARRON", 3, "BTNA", 1, "MARRON", 1, "VALIDER", 1, _
                           "BTNC", 1, "MARRON", 1, "BTNB", 1, "MARRON", 1, "BTNA", 1, "MARRON", 2, "VALIDER", 1, _
                           "BTNC", 1, "MARRON", 2, "BTNB", 1, "MARRON", 2, "BTNA", 1, "MARRON", 4, "VALIDER", 1, _
                           "BTNC", 1, "MARRON", 5, "BTNA", 1, "MARRON", 3, "VALIDER", 1, _
                           "BTND", 1, "MARRON", 2, "BTNC", 1, "MARRON", 2, "BTNA", 1, "MARRON", 6, "VALIDER", 1, _
                           "BTND", 1, "MARRON", 5, "BTNB", 1, "MARRON", 2, "BTNA", 1, "MARRON", 2, "VALIDER", 1, _
                           "BTND", 1, "MARRON", 10, "VALIDER", 1)
 
    ProcOrange2SautsClics = Array(0, "ANNULER", 1, "ANNULER", 1, _
                           "VALIDER", 1, _
                           "BTNA", 1, "ORANGE", 1, "VALIDER", 1, _
                           "BTNA", 1, "ORANGE", 2, "VALIDER", 1, _
                           "BTNA", 1, "ORANGE", 4, "VALIDER", 1, _
                           "BTNB", 1, "ORANGE", 1, "BTNA", 1, "ORANGE", 3, "VALIDER", 1, _
                           "BTNB", 1, "ORANGE", 3, "BTNA", 1, "ORANGE", 1, "VALIDER", 1, _
                           "BTNC", 1, "ORANGE", 1, "BTNB", 1, "ORANGE", 1, "BTNA", 1, "ORANGE", 2, "VALIDER", 1, _
                           "BTNC", 1, "ORANGE", 2, "BTNB", 1, "ORANGE", 2, "BTNA", 1, "ORANGE", 4, "VALIDER", 1, _
                           "BTNC", 1, "ORANGE", 5, "BTNA", 1, "ORANGE", 3, "VALIDER", 1, _
                           "BTND", 1, "ORANGE", 2, "BTNC", 1, "ORANGE", 2, "BTNA", 1, "ORANGE", 6, "VALIDER", 1, _
                           "BTND", 1, "ORANGE", 5, "BTNB", 1, "ORANGE", 2, "BTNA", 1, "ORANGE", 2, "VALIDER", 1, _
                           "BTND", 1, "ORANGE", 10, "VALIDER", 1)
 
    ProcMarron3SautsClics = Array(0, "ANNULER", 1, "ANNULER", 1, _
                           "VALIDER", 1, _
                           "VALIDER", 1, _
                           "BTNA", 1, "MARRON", 1, "VALIDER", 1, _
                           "BTNA", 1, "MARRON", 2, "VALIDER", 1, _
                           "BTNA", 1, "MARRON", 4, "VALIDER", 1, _
                           "BTNB", 1, "MARRON", 1, "BTNA", 1, "MARRON", 3, "VALIDER", 1, _
                           "BTNB", 1, "MARRON", 3, "BTNA", 1, "MARRON", 1, "VALIDER", 1, _
                           "BTNC", 1, "MARRON", 1, "BTNB", 1, "MARRON", 1, "BTNA", 1, "MARRON", 2, "VALIDER", 1, _
                           "BTNC", 1, "MARRON", 2, "BTNB", 1, "MARRON", 2, "BTNA", 1, "MARRON", 4, "VALIDER", 1, _
                           "BTNC", 1, "MARRON", 5, "BTNA", 1, "MARRON", 3, "VALIDER", 1, _
                           "BTND", 1, "MARRON", 2, "BTNC", 1, "MARRON", 2, "BTNA", 1, "MARRON", 6, "VALIDER", 1, _
                           "BTND", 1, "MARRON", 5, "BTNB", 1, "MARRON", 2, "BTNA", 1, "MARRON", 2, "VALIDER", 1, _
                           "BTND", 1, "MARRON", 10, "VALIDER", 1)
 
    ProcOrange3SautsClics = Array(0, "ANNULER", 1, "ANNULER", 1, _
                           "VALIDER", 1, _
                           "VALIDER", 1, _
                           "BTNA", 1, "ORANGE", 1, "VALIDER", 1, _
                           "BTNA", 1, "ORANGE", 2, "VALIDER", 1, _
                           "BTNA", 1, "ORANGE", 4, "VALIDER", 1, _
                           "BTNB", 1, "ORANGE", 1, "BTNA", 1, "ORANGE", 3, "VALIDER", 1, _
                           "BTNB", 1, "ORANGE", 3, "BTNA", 1, "ORANGE", 1, "VALIDER", 1, _
                           "BTNC", 1, "ORANGE", 1, "BTNB", 1, "ORANGE", 1, "BTNA", 1, "ORANGE", 2, "VALIDER", 1, _
                           "BTNC", 1, "ORANGE", 2, "BTNB", 1, "ORANGE", 2, "BTNA", 1, "ORANGE", 4, "VALIDER", 1, _
                           "BTNC", 1, "ORANGE", 5, "BTNA", 1, "ORANGE", 3, "VALIDER", 1, _
                           "BTND", 1, "ORANGE", 2, "BTNC", 1, "ORANGE", 2, "BTNA", 1, "ORANGE", 6, "VALIDER", 1, _
                           "BTND", 1, "ORANGE", 5, "BTNB", 1, "ORANGE", 2, "BTNA", 1, "ORANGE", 2, "VALIDER", 1, _
                           "BTND", 1, "ORANGE", 10, "VALIDER", 1)
 
    ProcMarron4SautsClics = Array(0, "ANNULER", 1, "ANNULER", 1, _
                           "VALIDER", 1, _
                           "VALIDER", 1, _
                           "VALIDER", 1, _
                           "BTNA", 1, "MARRON", 1, "VALIDER", 1, _
                           "BTNA", 1, "MARRON", 2, "VALIDER", 1, _
                           "BTNA", 1, "MARRON", 4, "VALIDER", 1, _
                           "BTNB", 1, "MARRON", 1, "BTNA", 1, "MARRON", 3, "VALIDER", 1, _
                           "BTNB", 1, "MARRON", 3, "BTNA", 1, "MARRON", 1, "VALIDER", 1, _
                           "BTNC", 1, "MARRON", 1, "BTNB", 1, "MARRON", 1, "BTNA", 1, "MARRON", 2, "VALIDER", 1, _
                           "BTNC", 1, "MARRON", 2, "BTNB", 1, "MARRON", 2, "BTNA", 1, "MARRON", 4, "VALIDER", 1, _
                           "BTNC", 1, "MARRON", 5, "BTNA", 1, "MARRON", 3, "VALIDER", 1, _
                           "BTND", 1, "MARRON", 2, "BTNC", 1, "MARRON", 2, "BTNA", 1, "MARRON", 6, "VALIDER", 1, _
                           "BTND", 1, "MARRON", 5, "BTNB", 1, "MARRON", 2, "BTNA", 1, "MARRON", 2, "VALIDER", 1, _
                           "BTND", 1, "MARRON", 10, "VALIDER", 1)
 
    ProcOrange4SautsClics = Array(0, "ANNULER", 1, "ANNULER", 1, _
                           "VALIDER", 1, _
                           "VALIDER", 1, _
                           "VALIDER", 1, _
                           "BTNA", 1, "ORANGE", 1, "VALIDER", 1, _
                           "BTNA", 1, "ORANGE", 2, "VALIDER", 1, _
                           "BTNA", 1, "ORANGE", 4, "VALIDER", 1, _
                           "BTNB", 1, "ORANGE", 1, "BTNA", 1, "ORANGE", 3, "VALIDER", 1, _
                           "BTNB", 1, "ORANGE", 3, "BTNA", 1, "ORANGE", 1, "VALIDER", 1, _
                           "BTNC", 1, "ORANGE", 1, "BTNB", 1, "ORANGE", 1, "BTNA", 1, "ORANGE", 2, "VALIDER", 1, _
                           "BTNC", 1, "ORANGE", 2, "BTNB", 1, "ORANGE", 2, "BTNA", 1, "ORANGE", 4, "VALIDER", 1, _
                           "BTNC", 1, "ORANGE", 5, "BTNA", 1, "ORANGE", 3, "VALIDER", 1, _
                           "BTND", 1, "ORANGE", 2, "BTNC", 1, "ORANGE", 2, "BTNA", 1, "ORANGE", 6, "VALIDER", 1, _
                           "BTND", 1, "ORANGE", 5, "BTNB", 1, "ORANGE", 2, "BTNA", 1, "ORANGE", 2, "VALIDER", 1, _
                           "BTND", 1, "ORANGE", 10, "VALIDER", 1)
 
 
 
End Sub
 
'Fin de la Form
 
 
 
 
'Click sur le Bouton "Marron"
 
Private Sub BtnMarron_Click()
    pMarron = 1
    pOrange = 0
    t = 1
    Status.Caption = "Début de la procédure marron ..."
    Stopper.Caption = "Touche [ ² ] pour stopper"
    TimerMarron.Enabled = True
    ChoixSautsClics.Enabled = False
    Deb0sautsclics.Enabled = False
    Deb2sautsclics.Enabled = False
    Deb3sautsclics.Enabled = False
    Deb4sautsclics.Enabled = False
    ChoixCouleur.Enabled = False
    BtnMarron.Enabled = False
    BtnOrange.Enabled = False
 
    If Deb0sautsclics.Value = True Then
        ProcMarron = ProcMarron0SautsClics
        ProcOrange = ProcOrange0SautsClics
    End If
 
    If Deb2sautsclics.Value = True Then
        ProcMarron = ProcMarron2SautsClics
        ProcOrange = ProcOrange2SautsClics
    End If
 
    If Deb3sautsclics.Value = True Then
        ProcMarron = ProcMarron3SautsClics
        ProcOrange = ProcOrange3SautsClics
    End If
 
    If Deb4sautsclics.Value = True Then
        ProcMarron = ProcMarron4SautsClics
        ProcOrange = ProcOrange4SautsClics
    End If
 
End Sub
 
 
'Click sur le bouton "Orange"
 
Private Sub BtnOrange_Click()
    pMarron = 0: pOrange = 1: t = 1
    Status.Caption = "Début de la procédure orange ..."
    Stopper.Caption = "Touche [ ² ] pour stopper"
    TimerOrange.Enabled = True
    ChoixSautsClics.Enabled = False
    Deb0sautsclics.Enabled = False
    Deb2sautsclics.Enabled = False
    Deb3sautsclics.Enabled = False
    Deb4sautsclics.Enabled = False
    ChoixCouleur.Enabled = False
    BtnMarron.Enabled = False
    BtnOrange.Enabled = False
 
    If Deb0sautsclics.Value = True Then
        ProcMarron = ProcMarron0SautsClics
        ProcOrange = ProcOrange0SautsClics
    End If
 
    If Deb2sautsclics.Value = True Then
        ProcMarron = ProcMarron2SautsClics
        ProcOrange = ProcOrange2SautsClics
    End If
 
    If Deb3sautsclics.Value = True Then
        ProcMarron = ProcMarron3SautsClics
        ProcOrange = ProcOrange3SautsClics
    End If
 
    If Deb4sautsclics.Value = True Then
        ProcMarron = ProcMarron4SautsClics
        ProcOrange = ProcOrange4SautsClics
    End If
 
End Sub
 
 
 
 
'Mise en marche de la procédure Marron
 
Private Sub TimerMarron_Timer()
 
    If t = 0 Then
        pMarron = pMarron + 1
        t = ProcMarron(pMarron * 2)
    End If
 
    Select Case ProcMarron(pMarron * 2 - 1)
        Case "ANNULER"
            clic BTNANNULx, BTNANNULy
        Case "VALIDER"
            clic BTNVALIDx, BTNVALIDy
            TimerMarron.Enabled = False
            DetectCouleur.Enabled = True
        Case "MARRON"
            clic MARRONx, MARRONy
        Case "ORANGE"
            clic ORANGEx, ORANGEy
        Case "BTNA"
            clic BTNAx, BTNAy
        Case "BTNB"
            clic BTNBx, BTNBy
        Case "BTNC"
            clic BTNCx, BTNCy
        Case "BTND"
            clic BTNDx, BTNDy
    End Select
 
    t = t - 1
 
' Appui sur la touche ² = stop
 
    If GetAsyncKeyState(222) <> 0 Then
        Status.Caption = "Programme stoppé"
        TimerMarron.Enabled = False
        TimerOrange.Enabled = False
        DetectCouleur.Enabled = False
        ChoixSautsClics.Enabled = True
        Deb0sautsclics.Enabled = True
        Deb2sautsclics.Enabled = True
        Deb3sautsclics.Enabled = True
        Deb4sautsclics.Enabled = True
        ChoixCouleur.Enabled = True
        BtnMarron.Enabled = True
        BtnOrange.Enabled = True
    End If
 
End Sub
 
 
'Fin de la procédure Marron
 
 
 
 
 
'Mise en marche de la procédure Orange
 
Private Sub TimerOrange_Timer()
 
    If t = 0 Then
        pOrange = pOrange + 1
        t = ProcOrange(pOrange * 2)
    End If
 
    Select Case ProcOrange(pOrange * 2 - 1)
        Case "ANNULER"
            clic BTNANNULx, BTNANNULy
        Case "VALIDER"
            clic BTNVALIDx, BTNVALIDy
            TimerOrange.Enabled = False
            DetectCouleur.Enabled = True
        Case "MARRON"
            clic MARRONx, MARRONy
        Case "ORANGE"
            clic ORANGEx, ORANGEy
        Case "BTNA"
            clic BTNAx, BTNAy
        Case "BTNB"
            clic BTNBx, BTNBy
        Case "BTNC"
            clic BTNCx, BTNCy
        Case "BTND"
            clic BTNDx, BTNDy
    End Select
 
    t = t - 1
 
' Appui sur la touche ² = stop
 
    If GetAsyncKeyState(222) <> 0 Then
        Status.Caption = "Programme stoppé"
        TimerMarron.Enabled = False
        TimerOrange.Enabled = False
        DetectCouleur.Enabled = False
        ChoixSautsClics.Enabled = True
        Deb0sautsclics.Enabled = True
        Deb2sautsclics.Enabled = True
        Deb3sautsclics.Enabled = True
        Deb4sautsclics.Enabled = True
        ChoixCouleur.Enabled = True
        BtnMarron.Enabled = True
        BtnOrange.Enabled = True
    End If
 
End Sub
 
'Fin de la procédure Orange
 
 
 
 
'Détection de la couleur
 
Private Sub DetectCouleur_Timer()
 
    GetPixelScreenColor COULEURx, COULEURy, r, g, b
 
  If r > 120 And g < 30 And b < 30 Then                   'Détection du Orange
    If pMarron = 50 Then
      Status.Caption = "Echec de la procédure de détection de la couleur Marron"
      TimerMarron.Enabled = False
      TimerOrange.Enabled = False
      DetectCouleur.Enabled = False
    ElseIf pMarron > 0 Then
      t = 0
      DetectCouleur.Enabled = False
      TimerMarron.Enabled = True
    ElseIf pOrange > 0 Then
      Status.Caption = "Procédure de détection de la couleur Orange réussie !"
      TimerOrange.Enabled = False
      pMarron = 1
      pOrange = 0
      t = 1
    End If
 
  ElseIf r < 30 And g < 30 And b < 30 Then               'Détection du Marron
    If pOrange = 50 Then
      Status.Caption = "Echec de la procédure de détection de la couleur Orange"
      TimerMarron.Enabled = False
      TimerOrange.Enabled = False
      DetectCouleur.Enabled = False
    ElseIf pOrange > 0 Then
      t = 0
      DetectCouleur.Enabled = False
      TimerOrange.Enabled = True
    ElseIf pMarron > 0 Then
      Status.Caption = "Procédure de détection de la couleur Marron réussie !"
      TimerMarron.Enabled = False
      pMarron = 0
      pOrange = 1
      t = 1
    End If
 
  ElseIf r > 50 And g < 120 And b > 50 Then              'Détection du Vert
    If pOrange > 0 Then
      t = 0
      DetectCouleur.Enabled = False
      TimerOrange.Enabled = True
    ElseIf pMarron > 0 Then
      t = 0
      DetectCouleur.Enabled = False
      TimerMarron.Enabled = True
    End If
  Else
 
  'Couleur de base = bleu
 
  End If
 
End Sub
 
'Fin de la détection de la couleur
 
 
 
 
'Procédure de clic avec timer
 
Sub clic(x As Integer, y As Integer)
    SetCursorPos x, y
    hbwait (200)
    mouse_event MOUSEEVENTF_LEFTDOWN + MOUSEEVENTF_LEFTUP, x, y, 0, 0
End Sub
 
'Fin de procédure de clic
 
 
 
 
'Début de la calibration
 
Private Sub BtnCalibration_Click()
    Me.WindowState = 2
    Trans "ON", Me, 200
    reg = 1
    ChoixCouleur.Visible = False
    BtnCalibration.Visible = False
    ChoixSautsClics.Visible = False
    Status.Caption = "Cliquer en haut a gauche de l'Appli"
End Sub
 
'Après la calibration
 
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
 
    Select Case reg
        Case 0
            Exit Sub
        Case 1
            reg = 0
            APPLIx = x
            APPLIy = y + 26
            MARRONx = APPLIx + 94
            MARRONy = APPLIy + 210
            ORANGEx = APPLIx + 207
            ORANGEy = APPLIy + 370
            COULEURx = APPLIx + 539
            COULEURy = APPLIy + 325
            BTNAx = APPLIx + 521
            BTNAy = APPLIy + 456
            BTNBx = APPLIx + 553
            BTNBy = APPLIy + 456
            BTNCx = APPLIx + 584
            BTNCy = APPLIy + 456
            BTNDx = APPLIx + 614
            BTNDy = APPLIy + 456
            BTNVALIDx = APPLIx + 320
            BTNVALIDy = APPLIy + 419
            BTNANNULx = APPLIx + 386
            BTNANNULy = APPLIy + 422
            Status.Caption = "Calibration terminée, choisissez les options et la couleur"
            ChoixCouleur.Visible = True
            ChoixSautsClics.Visible = True
            BtnCalibration.Visible = True
            BtnCalibration.Enabled = False
            ChoixSautsClics.Enabled = True
            Deb0sautsclics.Enabled = True
            Deb2sautsclics.Enabled = True
            Deb3sautsclics.Enabled = True
            Deb4sautsclics.Enabled = True
            ChoixCouleur.Enabled = True
            BtnMarron.Enabled = True
            BtnOrange.Enabled = True
            Me.WindowState = 0
            Trans "OFF", Me
        Exit Sub
    End Select
 
    reg = reg + 1
    Status.Caption = s
 
End Sub

Module :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
 
 
Option Explicit
 
Global Const WS_EX_LAYERED = &H80000
Global Const LWA_COLORKEY = &H1
Global Const LWA_ALPHA = &H2
Global Const GWL_EXSTYLE = (-20)
 
Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Boolean
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
 
Public Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
 
 
 
Public Const MOUSEEVENTF_LEFTDOWN = &H2
Public Const MOUSEEVENTF_LEFTUP = &H4
 
 
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
 
Public Declare Function GetCursorPos Lib "user32" (lpPoint As PointAPI) As Long
Public Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
 
 
Public rgbpx
 
Public Type PointAPI
x As Long
y As Long
End Type
 
 
 
Public Sub Trans(Stat As String, Fenêtre As Form, Optional ByVal Alpha As Byte = 255)
Select Case UCase(Stat)
Case "ON"
    SetWindowLong Fenêtre.hWnd, GWL_EXSTYLE, GetWindowLong(Fenêtre.hWnd, GWL_EXSTYLE) Or WS_EX_LAYERED
    SetLayeredWindowAttributes Fenêtre.hWnd, 0, Alpha, LWA_ALPHA
Case "OFF"
    SetWindowLong Fenêtre.hWnd, GWL_EXSTYLE, GetWindowLong(Fenêtre.hWnd, GWL_EXSTYLE) - WS_EX_LAYERED
Case "SET"
    SetLayeredWindowAttributes Fenêtre.hWnd, 0, Alpha, LWA_ALPHA
End Select
End Sub
 
 
 
 
 
Public Sub GetPixelScreenColor(ByVal x As Long, ByVal y As Long, ByRef Red As Integer, ByRef Green As Integer, ByRef Blue As Integer)
 
rgbpx = GetPixel(GetDC(0&), x, y)
 
Red = &HFF& And rgbpx
Green = (&HFF00& And rgbpx) \ 256
Blue = (&HFF0000 And rgbpx) \ 65536
 
End Sub

et voilou !

**ucfoutu** · 21/12/2007, 21h40

Bonjour,

je ne sais pas (ou plutôt je le devine trop bien...) à quoi tu joues, là...

Je vais donc me contenter de te dire ceci :

lorsque l'on fait jouer à sa place, on le fait convenablement (en s'interrogeant, au passage, sur le temps que met un programme à parcourir un écran...)

quoi qu'il en soit :

Tu nous a montré tout sauf l'essentiel de ton code (le "parcours")... et j'ai bien l'impression que ta faille est à chercher dans cette boucle de ce "parcours"....que l'on ne voit pas dans ton code.

Si, comme je le crains, tu as mis dans ta boucle l'obtention d'un DC sans détruire ce dernier, ta saturation de mémoire m'étonne... tiens....

Amuse-toi bien, donc, mais mérite alors ta manoeuvre, hein ...

**zazaraignée** · 21/12/2007, 22h39

Comment ça une boucle... et la procédure clic, alors?

theclem35: Je soupçonne un conflit entre le timer et le sleep. Il sert à quoi au fait, le sleep?

**ucfoutu** · 21/12/2007, 22h43

Bonjour, zazaraignée;

Je lis ceci, moi :

Suite a ce resultat il deplace le pointeur sur tel ou tel bouton, et tant que une certaine couleur attendue n'est pas affichée il execute plusieurs clics sur d'autres boutons.

Une fois cette couleur apparue, il recommence a 0, à 1 clic sur un bouton ...

C'est un peu comme les programmes qui deplacent la souris et cliquent tout seul à l'époque des cash-barres

et j'interprête....

Mais même s'il cliquait manuellement (ce dont je doute), ce que j'ai écrit reste parfaitement vrai en ce qui concerne l'obtention de Device Context sans destruction...

====>> mémoire forcément saturée au bout d'un certain temps

Edit : je sais que theclem35 a longuement lu ma réponse...

**zazaraignée** · 21/12/2007, 23h16

Merci pour ces précisions. J'ai parcouru le code rapidement et j'avoue que la première chose que j'ai vu c'est le sleep assorti d'un doevents et ensuite un timer... et je doutais de l'efficacité d'un DoEvents avec le Sleep, mais n'ayant pas testé. Quant au Device Context, je n'ai jamais testé non plus. Donc je dois te croire sur parole...

**ucfoutu** · 22/12/2007, 07h29

Bon...

Moi c'est le timer qui avait échappé à mon attention et l'obtention du Device Context qui me sautait aux yeux....

Je sais donc maintenant mieux d'où viennent tous ces clics qui, chacun d'eux, entraîne l'obtention d'un DC qui, lui, n'est jamais "zigouillé"....

Voilà la raison de sa "perte de boule"....

**theclem35** · 22/12/2007, 10h40

Salut!

En fait ce qui se passe c'est que tant que le marron est pas affiché le programme va executer ceci ligne par ligne : (c'est ce qui clique 1 2 4 etc.. fois sur les boutons BTNA BTNB BTNC etc....)

et quand le orange s'affiche il passe à l'autre array en dessous et ainsi de suite indéfiniment

le fait qu'il y ait plusieurs ProcCouleur c'est pour permettreà l'utilisateur de ne pas cliquer sur les BTN tant que la couleur s'est pas affichée 3 ou 4 fois de suite par exemple...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
 
ProcMarron0SautsClics = Array(0, "ANNULER", 1, "ANNULER", 1, "BTNA", 1, "MARRON", 1, "VALIDER", 1, _
                           "BTNA", 1, "MARRON", 2, "VALIDER", 1, _
                           "BTNA", 1, "MARRON", 4, "VALIDER", 1, _
                           "BTNB", 1, "MARRON", 1, "BTNA", 1, "MARRON", 3, "VALIDER", 1, _
                           "BTNB", 1, "MARRON", 3, "BTNA", 1, "MARRON", 1, "VALIDER", 1, _
                           "BTNC", 1, "MARRON", 1, "BTNB", 1, "MARRON", 1, "BTNA", 1, "MARRON", 2, "VALIDER", 1, _
                           "BTNC", 1, "MARRON", 2, "BTNB", 1, "MARRON", 2, "BTNA", 1, "MARRON", 4, "VALIDER", 1, _
                           "BTNC", 1, "MARRON", 5, "BTNA", 1, "MARRON", 3, "VALIDER", 1, _
                           "BTND", 1, "MARRON", 2, "BTNC", 1, "MARRON", 2, "BTNA", 1, "MARRON", 6, "VALIDER", 1, _
                           "BTND", 1, "MARRON", 5, "BTNB", 1, "MARRON", 2, "BTNA", 1, "MARRON", 2, "VALIDER", 1, _
                           "BTND", 1, "MARRON", 10, "VALIDER", 1)
 
    ProcOrange0SautsClics = Array(0, "ANNULER", 1, "ANNULER", 1, "BTNA", 1, "ORANGE", 1, "VALIDER", 1, _
                           "BTNA", 1, "ORANGE", 2, "VALIDER", 1, _
                           "BTNA", 1, "ORANGE", 4, "VALIDER", 1, _
                           "BTNB", 1, "ORANGE", 1, "BTNA", 1, "ORANGE", 3, "VALIDER", 1, _
                           "BTNB", 1, "ORANGE", 3, "BTNA", 1, "ORANGE", 1, "VALIDER", 1, _
                           "BTNC", 1, "ORANGE", 1, "BTNB", 1, "ORANGE", 1, "BTNA", 1, "ORANGE", 2, "VALIDER", 1, _
                           "BTNC", 1, "ORANGE", 2, "BTNB", 1, "ORANGE", 2, "BTNA", 1, "ORANGE", 4, "VALIDER", 1, _
                           "BTNC", 1, "ORANGE", 5, "BTNA", 1, "ORANGE", 3, "VALIDER", 1, _
                           "BTND", 1, "ORANGE", 2, "BTNC", 1, "ORANGE", 2, "BTNA", 1, "ORANGE", 6, "VALIDER", 1, _
                           "BTND", 1, "ORANGE", 5, "BTNB", 1, "ORANGE", 2, "BTNA", 1, "ORANGE", 2, "VALIDER", 1, _
                           "BTND", 1, "ORANGE", 10, "VALIDER", 1)

Quand a cette petite fonction, elle sert à cliquer 200ms plus tard sur le bouton car au debut la souris se deplacer et repartais tellement vite que le bouton se mettais en surbrillance mais ca n'avait pas le temps de cliquer.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Public Sub hbwait(millisecondes As Long)
    Dim attente As Long
    attente = GetTickCount + millisecondes
    Do Until GetTickCount >= attente
    DoEvents
    Sleep 1
    Loop
End Sub

associée donc a cette procedure clic :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
'Procédure de clic avec timer
 
Sub clic(x As Integer, y As Integer)
    SetCursorPos x, y
    hbwait (200)
    mouse_event MOUSEEVENTF_LEFTDOWN + MOUSEEVENTF_LEFTUP, x, y, 0, 0
End Sub

Quant aux autres timers voici les details :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
VERSION 5.00
Begin VB.Form FormPrincipale 
   AutoRedraw      =   -1  'True
   BorderStyle     =   1  'Fixed Single
   Caption         =   "clicouille"
   ClientHeight    =   3210
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   8025
   Icon            =   "FormPrincipale.frx":0000
   LinkTopic       =   "FormPrincipale"
   MaxButton       =   0   'False
   ScaleHeight     =   214
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   535
   StartUpPosition =   3  'Windows Default
   Begin VB.Frame ChoixCouleur 
      Caption         =   "Lancement du programme"
      Height          =   975
      Left            =   4800
      TabIndex        =   8
      Top             =   1680
      Width           =   3015
      Begin VB.CommandButton BtnOrange 
         Caption         =   "Orange"
         Height          =   375
         Left            =   1680
         TabIndex        =   10
         Top             =   360
         Width           =   975
      End
      Begin VB.CommandButton BtnMarron 
         Caption         =   "Marron"
         Height          =   375
         Left            =   360
         TabIndex        =   9
         Top             =   360
         Width           =   975
      End
   End
   Begin VB.CommandButton BtnCalibration 
      Cancel          =   -1  'True
      Caption         =   "Lancer la calibration"
      CausesValidation=   0   'False
      Default         =   -1  'True
      BeginProperty Font 
         Name            =   "Trebuchet MS"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   735
      Left            =   5760
      Style           =   1  'Graphical
      TabIndex        =   7
      Top             =   360
      Width           =   1815
   End
   Begin VB.Frame ChoixSautsClics 
      Caption         =   "Nombre d'affichages a sauter avant de cliquer "
      Height          =   975
      Left            =   360
      TabIndex        =   0
      Top             =   1680
      Width           =   4095
      Begin VB.OptionButton Deb4sautsclics 
         Caption         =   "sauter 4 affichages"
         Height          =   255
         Left            =   2760
         TabIndex        =   4
         Top             =   600
         Width           =   1215
      End
      Begin VB.OptionButton Deb2sautsclics 
         Caption         =   "sauter 2 affichages"
         Height          =   375
         Left            =   2760
         TabIndex        =   3
         Top             =   240
         Width           =   855
      End
      Begin VB.OptionButton Deb3sautsclics  
         Caption         =   "sauter 3 affichages"
         Height          =   255
         Left            =   360
         TabIndex        =   2
         Top             =   600
         Width           =   1335
      End
      Begin VB.OptionButton Deb0sautsclics  
         Caption         =   "Ne pas sauter d'affichages de couleur"
         Height          =   375
         Left            =   360
         TabIndex        =   1
         Top             =   240
         Value           =   -1  'True
         Width           =   2055
      End
   End
   Begin VB.Timer TimerOrange 
      Enabled         =   0   'False
      Interval        =   200
      Left            =   1800
      Top             =   2760
   End
   Begin VB.Timer TimerMarron 
      Enabled         =   0   'False
      Interval        =   200
      Left            =   1320
      Top             =   2760
   End
   Begin VB.Frame CadreStatus 
      Caption         =   "Status du programme"
      Height          =   1335
      Left            =   360
      TabIndex        =   5
      Top             =   120
      Width           =   4935
      Begin VB.Label Status 
         Alignment       =   2  'Center
         BeginProperty Font 
            Name            =   "Trebuchet MS"
            Size            =   12
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00000000&
         Height          =   615
         Left            =   600
         TabIndex        =   6
         Top             =   240
         Width           =   3855
      End
      Begin VB.Label Stopper 
         BeginProperty Font 
            Name            =   "Trebuchet MS"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   -1  'True
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   2760
         TabIndex        =   11
         Top             =   960
         Width           =   2055
      End
   End
   Begin VB.Timer DetectCouleur 
      Enabled         =   0   'False
      Interval        =   200
      Left            =   2520
      Top             =   2760
   End
   Begin VB.Line LigneBasGauche 
      X1              =   216
      X2              =   24
      Y1              =   200
      Y2              =   200
   End
   Begin VB.Line LigneBasDroite 
      X1              =   488
      X2              =   520
      Y1              =   200
      Y2              =   200
   End
   Begin VB.Label ProgAutorise 
      Caption         =   "By TiClem"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   3360
      TabIndex        =   12
      Top             =   2880
      Width           =   3975
   End
End
Attribute VB_Name = "FormPrincipale"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Merci,
Clément

**ucfoutu** · 22/12/2007, 11h00

Mets donc un compteur dans cette procédure (avec affichage dans un label) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Public Sub GetPixelScreenColor(ByVal x As Long, ByVal y As Long, ByRef Red As Integer, ByRef Green As Integer, ByRef Blue As Integer)
  label1.caption = val(labet1.caption) + 1 
  rgbpx = GetPixel(GetDC(0&), x, y)
  Red = &HFF& And rgbpx
  Green = (&HFF00& And rgbpx) \ 256
  Blue = (&HFF0000 And rgbpx) \ 65536
 
End Sub

et dis-nous à combien il en est quand ton appli "perd la boule", comme tu dis...

**theclem35** · 22/12/2007, 11h20

Après avoir créé le label1 et essayant de compiler :

label1.Caption = Val(label1.Caption) + 1

Variable not defined

**ucfoutu** · 22/12/2007, 11h29

Hé !

Celà veut dire que ta procédure n'est pas sur la Form qui contient ton label1 ...

Je ne cesserais jamais d'être étonné par certains paradoxes (code évolué d'une part et méconnaissance des bases d'autre part ...)

Bref ...
si ton label1 est sur la Form1 et que ta procédure est dans un module, je te rappelle qu'il faut alors écrire :

Form1.label1.caption = Val(Form1.Label1.Caption) + 1

Hé bé ...
Si tu ne te montres pas au moins un peu plus à la hauteur, je n'aborderai certes pas les points plus complexes avec toi... c'est certain ...

**theclem35** · 22/12/2007, 11h33

Erf oui..

Pardon maitresse !!

Non mais comme je l'ai dis je débute en VB, j'ai toujours programmé en PHP et je suis encore dérouté par certaines subtilités !

La couleur met du temps a apparaitre, ce qui fait que le compteur s'arrete toutes les 25 .. euh 25 je sais pas quoi en tout cas c'est pas des secondes ! .. et reprend apres avoir cliqué sur les BTNx..

Je te poste le resultat du plantage dans approximativement 1h

merci!!

**theclem35** · 22/12/2007, 12h34

Ca y est ca s'est figé à 9963 avec, plus tard, le message : echec de la détection de la couleur Orange (msg de la fonction DetectCouleur en bas de la Form) qui est surement apparu suite à l'inactivité du programme.

Le programme est donc figé à l'ecran, meme en deplacant la fenetre, j'ai le forum qui s'imprime en fond de mon programme ^^

Il s'est bloqué a 8 776 Ko d'utilisation memoire alors qu'au lancement avant qu'il execute toutes les procedures il utilise 3 236 Ko

:/

edit : Il semblerai effectivement que les symptomes proviennent du fait que le handle n'a pas été libéré par ReleaseDC après l'appel de GetDC.

J'ai quelques difficultés à ecrire le code ..

Origine :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
 
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
 
Public rgbpx
 
 
Public Sub GetPixelScreenColor(ByVal x As Long, ByVal y As Long, ByRef Red As Integer, ByRef Green As Integer, ByRef Blue As Integer)
 
rgbpx = GetPixel(GetDC(0&), x, y)
 
Red = &HFF& And rgbpx
Green = (&HFF00& And rgbpx) \ 256
Blue = (&HFF0000 And rgbpx) \ 65536
 
End Sub

**ucfoutu** · 22/12/2007, 13h11

Bon, theclem35

nous allons alors tenter de parler sérieusement, maintenant :

regarde ta fonction DetectCouleur :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Private Sub DetectCouleur_Timer()
 
    GetPixelScreenColor COULEURx, COULEURy, r, g, b
 
etc...
etc...

elle appelle donc :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Public Sub GetPixelScreenColor(ByVal x As Long, ByVal y As Long, ByRef Red As Integer, ByRef Green As Integer, ByRef Blue As Integer)
  label1.caption = val(labet1.caption) + 1 
  rgbpx = GetPixel(GetDC(0&), x, y)
  Red = &HFF& And rgbpx
  Green = (&HFF00& And rgbpx) \ 256
  Blue = (&HFF0000 And rgbpx) \ 65536
 
End Sub

c'est bien ce que je te dis depuis le début, n'est-ce-pas ?

Qu'est-ce qui cloche, dans cette affaire ?

tu appelles systématiquement la fonction GetDc de l'Api de windows, qui te retourne donc, à chaque fois, un long ...

Alors tout ce qui va suivre n'a absolument plus rien à voir avec VB mais tout avec Windows (mais tu ne devrais pas avoir de problèmes puisque tu m'as exposé que tu étais bon sous php, d'une part, et que, d'autre part, tu n'as pas hésité à faire ici appel à des fonctions de l'Api de Windows, ce qui donne à penser que tu connais bien Windows... car tu n'as, j'espère, pas fait ton appli par petits morceaux de copier-coller, n'est-ce-pas, mais en parfaite connaissance de cause....)

Tu obtiens donc autant de fois ton Device Context que te l'a affiché ton compteur dans Label1 !!!!!

A ce niveau, c'est au connaisseur de Windows (plus rien à voir avec VB) que je vais donc m'adresser, en 3 questions simples :

1) Comment rend-on à nouveau disponible pour d'autres applications un Device Context que l'on a mobilisé ?
2) Comment le "zigouille"-t-on en mémoire ?
3) Est-il vraiment nécessaire de l'obtenir et de le zigouiller en boucle ? N'est-il pas plus adroit de ne l'obtenir et de s'y référer qu'une seule fois, puis de le libérer en fin d'application ?

Voilà ! Comme tu vois, je m'adresse à toi en ta qualité de connaisseur de Windows (puisque tu en utilises l'Api de façon évoluée)...

Juste une piste, dans ce cas : Existent les fonctions ReleaseDC et DeleDC de l'Api de Windows et je te conseille de voir quelle en est la vocation.

Il te faudra probablement décomposer certaines lignes de code de ta fonction GetPixelScreenColor

Bonne étude.

**theclem35** · 22/12/2007, 13h23

Tout a fait,

J'ai bien compris qu'il était important de faire appel a GetDC avant la boucle puis de releaser après la boucle.

J'ai donc essayé deux ou trois choses sans succès.
Quand aux fonction de l'API windows, je les utilise sans vraiment connaitre l'API, j'ai cherché comment capter la couleur d'un pixel sur n'importe quelle partie de l'écran et il m'a semblé que les fonctions que j'utilise sont les plus appropriées !

J'ai donc tout simplement utilisé les informations contenues dans la FAQ de votre site

http://vb.developpez.com/faq/?page=Graphisme (2eme post)

Mais je remarque qu'il ne parle, la, pas non plus de ReleaseDC ! D'où mes problèmes à régler cette affaire...

**ucfoutu** · 22/12/2007, 13h27

Je regrette avec toi certaines choses infinies...
Reste que je t'ai invité à jeter un oeil sur 2 fonctions de l'Api de Windows.

Fais-le, s'il te plait... car les copier-coller ne sont pas ma tasse de thé... au contraire des choses analysées et comprises.

**ucfoutu** · 22/12/2007, 13h38

Voilà quand même comment (par exemple.... et iici.... volontairement, je choisis un contrôle qui n'est pas le tien... juste pour que tu réfléchisses...

) :

- on détruit ce que l'on a appelé :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Private Function GetPixelColor(ByVal x As Integer, ByVal y As Integer) As Color
        Dim hdcScreen As IntPtr = GetDC(ListView1.Handle)
        Dim lacouleur As Integer = GetPixel(hdcScreen, x, y)
        DeleteDC(hdcScreen)
        'puis on travaille sur lacouleur
    End Function

et voilà comment on liobère (pour d'autres applications) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Private Function GetPixelColor(ByVal x As Integer, ByVal y As Integer) As Color
        Dim hdcScreen As IntPtr = GetDC(ListView1.Handle)
        Dim lacouleur  As Integer = GetPixel(hdcScreen, x, y)
        ReleaseDC(ListView1.Handle, hdcScreen)
        'puis on travaille sur lacouleur
    End Function

Reste que tu devrais me relire et décider s'il est ou non opportun de mobiliser mille et une fois le même contexte de dispositiof (DC) ...

Moi, je te laisse maintenant là .