Problème Saturation mémoire [Résolu]

icks99 9 Messages postés samedi 28 janvier 2006Date d'inscription 21 septembre 2006 Dernière intervention - 21 sept. 2006 à 13:39 - Dernière réponse : icks99 9 Messages postés samedi 28 janvier 2006Date d'inscription 21 septembre 2006 Dernière intervention
- 21 sept. 2006 à 16:10
Bonjour,

J'ai un problème avec un formulaire vba fait sous excel.
Le programme sert à surveiller la couleur de 2 points choisis à l'écran. Si les points deviennent rouge, ça envoie un netsend pour prévenir.

Le problème est que quand la vérification des points est lancée la mémoire utilisée par excel augmente de 4 octets toutes les secondes pour une raison que je ne comprend pas.

Je pense que c'est à cause de la fonction getdc qui doit cumuler les infos sur les pixels chaque fois qu'il vérifie, mais je n'en suis pas sûr.
Et je ne sais pas comment utiliser la fonction ReleaseDC dans mon code, si le problème vient de là.

Est-ce que quelqu'un pourrait m'aider pliiiize ?????  J'ai cherché, mais je ne trouve pas la solution.

Merci d'avance à mon sauveur

Guillaume,

Pour un infos, voilà le code correspondant :

'code pour la vérification en boucle de la couleur de pixels définis
' : si ils prennent la valeur rouge, un net send est envoyé
 
Dim rgbvalue As Long
Dim Coord As PointAPI
Dim x1 As Integer
Dim y1 As Integer
Dim x2 As Integer
Dim y2 As Integer
Dim x3 As Integer
Dim y3 As Integer
Dim x4 As Integer
Dim y4 As Integer
Dim keystate As Byte
 
Dim Retour As Long
Dim xTimer As Single
Dim xStop As Single
 
Dim Finboucle As String
 
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal uAction As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As PointAPI) As Long
Private Declare Function GetPixel Lib "gdi32.dll" (ByVal hdc As Long, ByVal nXPos As Long, ByVal nYPos As Long) As Long
Private Declare Function GetDC Lib "user32.dll" (ByVal hwnd As Long) As Long
 
 
 
' 1er bouton pour la surveillance du 1er point
Private Sub CommandButton_Click()
 
TextBox3 = ""
TextBox1 = "Mettez la souris au dessus du point à surveiller et appuyez sur [Entrée]"
TextBox2.BackColor = "0"
 
'la case Textbox2 est noire tant qu'entrée n'a pas été enfoncé et la case TextBox3 est vide
If GetAsyncKeyState(13) = 0 Then
TextBox2.BackColor = "0"
TextBox3 = ""
 
' quand entrée est enfoncée au dessus du point voulu
' des cases prennent la couleur noire et se remplisse avec des textes
' et les coordonnées du point 1 sont récupérées dans X1 et Y1,
 
ElseIf GetKeyState(13) <> 0 Then
GetCursorPos Coord
rgbvalue = GetPixel(GetDC(stdout), Coord.x, Coord.y)
x1 = Coord.x
y1 = Coord.y
TextBox2.BackColor = rgbvalue Me.Caption "Position du curseur : X " & x1 & " Y = " & y1
TextBox1 = "Choisir les points à surveiller et lancer le programme"
TextBox3 = "Ok"
 
End If
End Sub
 
 
'2eme bouton pour la surveillance du 2nd point : idem voir point 1
Private Sub CommandButton2_Click()
' point 2
'Finboucle = "0"
TextBox4.BackColor = "0"
TextBox5 = ""
TextBox1 = "Mettez la souris au dessus du point à surveiller et appuyez sur [Entrée]"
 
 
If GetAsyncKeyState(13) = 0 Then
TextBox4.BackColor = "0"
TextBox5 = ""
 
ElseIf GetKeyState(13) <> 0 Then
GetCursorPos Coord
rgbvalue = GetPixel(GetDC(stdout), Coord.x, Coord.y)
x2 = Coord.x
y2 = Coord.y
TextBox4.BackColor = rgbvalue Me.Caption "Position du curseur : X " & x2 & " Y = " & y2
TextBox1 = "Choisir les points à surveiller et lancer le programme"
TextBox5 = "Ok"
' Loop
End If
 
End Sub
 
 
'bouton de lancement de la surveillance
Sub CommandButton5_Click()
TextBox1 = "Surveillance en cours. Appuyez sur la touche [A] pour quitter la surveillance."
TextBox3 = "En Surveillance"
TextBox5 = "En Surveillance"
 
 
Retour = 0 'mise à zéro de la touche "a" non enfoncée
 
 
'boucle de vérification des points jusqu'à ce que la touche " a " soit enfoncée
 
Do Until (Retour) <> 0
 
 
'vérification toutes les secondes si la touche "a" est enfoncée : sortir de la boucle
'fonction sleep modifiée pour éviter qu'excel soit figé pendant la boucle
xStart = Timer
xStop = xStart + 1
Do While Timer < xStop
If (Timer + 300) > xStop Then
Sleep xStop - Timer
DoEvents
Else
Sleep 500
End If
DoEvents
Loop
 
'si la touche " a " est enfoncée, sortir de la boucle de surveillance
Retour = GetAsyncKeyState(65) 'a
If (Retour) <> 0 Then
Exit Do
End If
 
 
'vérification de la couleur du point 1
 
If GetPixel(GetDC(stdout), x1, y1) = "255" Then
If timer1 = 0 Then
timer1 = Timer
netsend = Shell("net send toto Le point 1 est rouge !", vbHide)
 
DoEvents
 
Else
If Timer - timer1 > 7 Then timer1 = 0
End If
 
End If
 
 
'vérification de la couleur du point 2
 
If GetPixel(GetDC(stdout), x2, y2) = "255" Then
If Timer2 = 0 Then
Timer2 = Timer
netsend = Shell("net send toto Le point 2 est rouge !", vbHide)
 
DoEvents
Else
If Timer - Timer2 > 7 Then Timer2 = 0
End If
 
End If
 
Loop
 
 
TextBox1 = "Placer la fenêtre du programme en haut de l'écran et choisir les points à surveiller"
TextBox3 = ""
TextBox5 = ""
TextBox7 = ""
TextBox13 = ""
 
End Sub
Afficher la suite 

Votre réponse

14 réponses

Meilleure réponse
Renfield 17307 Messages postés mercredi 2 janvier 2002Date d'inscription 18 janvier 2017 Dernière intervention - 21 sept. 2006 à 14:46
3
Merci
tu appelle toujours GetDC sans le Releaser derrière...

un peu d'indentation plus tard, nous obtenons :

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal uAction As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As PointAPI) As Long
Private Declare Function GetPixel Lib "gdi32.dll" (ByVal hdc As Long, ByVal nXPos As Long, ByVal nYPos As Long) As Long
Private Declare Function GetDC Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDC As Long) As Long
 
 
Dim rgbvalue As Long  
Dim Coord As PointAPI 
Dim x1 As Integer     
Dim y1 As Integer     
Dim x2 As Integer     
Dim y2 As Integer     
Dim x3 As Integer     
Dim y3 As Integer     
Dim x4 As Integer     
Dim y4 As Integer     
Dim keystate As Byte  

                      
Dim Retour As Long    
Dim xTimer As Single  
Dim xStop As Single   
                      
Dim Finboucle As String

 
' 1er bouton pour la surveillance du 1er point
Private Sub CommandButton_Click()
    TextBox3 = ""
    TextBox1 = "Mettez la souris au dessus du point à surveiller et appuyez sur [Entrée]"
    TextBox2.BackColor = "0"
 
    'la case Textbox2 est noire tant qu'entrée n'a pas été enfoncé et la case TextBox3 est vide
    If GetAsyncKeyState(13) = 0 Then
        TextBox2.BackColor = "0"
        TextBox3 = ""
 
        ' quand entrée est enfoncée au dessus du point voulu
        ' des cases prennent la couleur noire et se remplisse avec des textes
        ' et les coordonnées du point 1 sont récupérées dans X1 et Y1,
    Else
        GetCursorPos Coord
        rgbvalue = GetPixel(GetDC(stdout), Coord.x, Coord.y)
        x1 = Coord.x
        y1 = Coord.y
        TextBox2.BackColor = rgbvalue        Me.Caption "Position du curseur :  X " & x1 & "    Y = " & y1
        TextBox1 = "Choisir les points  à surveiller et lancer le programme"
        TextBox3 = "Ok"
    End If
End Sub
 
 
'2eme bouton pour la surveillance du 2nd point : idem voir point 1
Private Sub CommandButton2_Click()
    ' point 2
    'Finboucle = "0"
    TextBox4.BackColor = "0"
    TextBox5 = ""
    TextBox1 = "Mettez la souris au dessus du point à surveiller et appuyez sur [Entrée]"
 
 
    If GetAsyncKeyState(13) = 0 Then
        TextBox4.BackColor = "0"
        TextBox5 = ""
    Else
        GetCursorPos Coord
        rgbvalue = GetPixel(GetDC(stdout), Coord.x, Coord.y)
        x2 = Coord.x
        y2 = Coord.y
        TextBox4.BackColor = rgbvalue        Me.Caption "Position du curseur :  X " & x2 & "    Y = " & y2
        TextBox1 = "Choisir les points  à surveiller et lancer le programme"
        TextBox5 = "Ok"
        ' Loop
    End If
End Sub
 
 
'bouton de lancement de la surveillance
Sub CommandButton5_Click()
Dim hStdOutDC As Long 
    TextBox1 = "Surveillance en cours. Appuyez sur la touche [A] pour quitter la surveillance."
    TextBox3 = "En Surveillance"
    TextBox5 = "En Surveillance"
 
    Retour = 0 'mise à zéro de la touche "a" non enfoncée
 
 
    'boucle de vérification des points jusqu'à ce que la touche " a " soit enfoncée
    Do Until Retour
        'vérification toutes les secondes si la touche "a" est enfoncée : sortir de la boucle
        'fonction sleep modifiée pour éviter qu'excel soit figé pendant la boucle
        xStart = Timer
        xStop = xStart + 1
        Do While Timer < xStop
            If (Timer + 300) > xStop Then
                Sleep xStop - Timer
                DoEvents
            Else
                Sleep 500
           End If
            DoEvents
        Loop
 
        'si la touche " a " est enfoncée, sortir de la boucle de surveillance
        Retour = GetAsyncKeyState(65) 'a
        If Retour = 0 Then
            hStdOutDC = GetDC ( stdOut )
           
            'vérification de la couleur du point 1
            If GetPixel(hStdOutDC, x1, y1) = 255 Then
                If timer1 = 0 Then
                    timer1 = Timer
                    netsend = Shell("net send toto Le point 1 est rouge !", vbHide)
                    DoEvents
                ElseIf Timer - timer1 > 7 Then
                    timer1 = 0
                End If
            End If
 
            'vérification de la couleur du point 2
            If GetPixel( hStdOutDC , x2, y2) = 255 Then
                If Timer2 = 0 Then
                    Timer2 = Timer
                    netsend = Shell("net send toto Le point 2 est rouge !", vbHide)
                    DoEvents
                ElseIf Timer - Timer2 > 7 Then
                    Timer2 = 0
                End If
            End If
           
            ReleaseDC StdOut, hStdOutDC
        End If
    Loop
 
    TextBox1 = "Placer la fenêtre du programme  en haut de l'écran et choisir les points à surveiller"
    TextBox3 = vbNullString
    TextBox5 = vbNullString
    TextBox7 = vbNullString
    TextBox13 = vbNullString
End Sub

Renfield
Admin CodeS-SourceS- MVP Visual Basic

Merci Renfield 3

Avec quelques mots c'est encore mieux Ajouter un commentaire

Codes Sources a aidé 69 internautes ce mois-ci

Commenter la réponse de Renfield
Renfield 17307 Messages postés mercredi 2 janvier 2002Date d'inscription 18 janvier 2017 Dernière intervention - 21 sept. 2006 à 14:06
0
Merci
4 octets ?
ca ressemble a un handle non rendu....
je regarde ça

Renfield
Admin CodeS-SourceS- MVP Visual Basic
Commenter la réponse de Renfield
Renfield 17307 Messages postés mercredi 2 janvier 2002Date d'inscription 18 janvier 2017 Dernière intervention - 21 sept. 2006 à 14:07
0
Merci
ton GetDC n'est pas contrebalancé par un ReleaseDC

Renfield
Admin CodeS-SourceS- MVP Visual Basic
Commenter la réponse de Renfield
icks99 9 Messages postés samedi 28 janvier 2006Date d'inscription 21 septembre 2006 Dernière intervention - 21 sept. 2006 à 14:08
0
Merci
Merci Renfield !!!!!
 T'es trop rapide :))
Commenter la réponse de icks99
Renfield 17307 Messages postés mercredi 2 janvier 2002Date d'inscription 18 janvier 2017 Dernière intervention - 21 sept. 2006 à 14:08
0
Merci
de plus, tu compare ce que renvoie GetPixel (un Long) à une chaine de caractère...

If GetPixel(GetDC(stdout), x2, y2) = "255" Then

(255 est du bleu... &hFF0000& pour avoir du rouge)

Renfield
Admin CodeS-SourceS- MVP Visual Basic
Commenter la réponse de Renfield
icks99 9 Messages postés samedi 28 janvier 2006Date d'inscription 21 septembre 2006 Dernière intervention - 21 sept. 2006 à 14:09
0
Merci
Par contre, et si ça te dérange pas, tu pourrais me dire comment et où placer le ReleaseDC ??? J'ai cherché sur cette fonction mais j'arrive pas à en comprendre la syntaxe.
(j'aurais bien mis mon post dans la rubrique Débutant, mais comme ça correspondait plus à du vba ^^)

Merci en tout cas pour tes réponses !!!!!
Commenter la réponse de icks99
icks99 9 Messages postés samedi 28 janvier 2006Date d'inscription 21 septembre 2006 Dernière intervention - 21 sept. 2006 à 14:11
0
Merci
Pour ce qui est de la valeur 255 j't'assure que c'est bien du rouge en code rvb :)
J'ai testé le programme tout marche, sauf justement ce problème de saturation de mémoire avec ces +4 octets toutes les secondes :)
Commenter la réponse de icks99
Renfield 17307 Messages postés mercredi 2 janvier 2002Date d'inscription 18 janvier 2017 Dernière intervention - 21 sept. 2006 à 14:12
0
Merci
je sais pas d'ou sort ton stdout, mais on doit normallement faire :

Dim hStdOutDC as Long
hStdOutDC = GetDC ( StdOut )
....
...
ReleaseDC StdOut, hStdOutDC

Renfield
Admin CodeS-SourceS- MVP Visual Basic
Commenter la réponse de Renfield
icks99 9 Messages postés samedi 28 janvier 2006Date d'inscription 21 septembre 2006 Dernière intervention - 21 sept. 2006 à 14:15
0
Merci
Trop classe Renfield !!! Merci j't'adore :)))
Pour le stdout à la base j'avais gardé ce nom de variable en me basant sur le code qui m'avait servi à choper les pixels et je l'ai pas changé :/
(je sais, copier c'est très très mal, et encore plus quand on sait pas ce qu'on fait...) Mais comme j'y connais strictement rien et que je cherche les trucs dont j'ai besoin, que j'essaye de les comprendre et de les adapter à ce dont j'ai besoin.... des fois ça marche pas toujours :)

Merci pour tout n'empêche !!! J'essaye ça et j'te dis si tout est bon !!
Commenter la réponse de icks99
icks99 9 Messages postés samedi 28 janvier 2006Date d'inscription 21 septembre 2006 Dernière intervention - 21 sept. 2006 à 14:30
0
Merci
J'ai rajouté dans la liste des variables :
Dim hStdOutDC As Long

J'ai rajouté
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDC As Long) As Long

Et rajouté le ReleaseDC à cet endroit là :

'vérification de la couleur du point 1
 If GetPixel(GetDC(StdOut), x1, y1) = "255" Then
hStdOutDC = GetDC(StdOut)


    If timer1 = 0 Then
    timer1 = Timer
         netsend = Shell("net send toto Le point 1 est rouge !", vbHide)
    ReleaseDC StdOut, hStdOutDC
    DoEvents
    
    Else
        If Timer - timer1 > 7 Then timer1 = 0
    End If


 End If

Mais quand je lance la surveillance des pixels, il me met le message :
"Erreur de Compilation"
"Sub ou Function non définie"

J'ai hooonte :/

Tu pourrais me dire c'que j'ai fait qui cloche, si t'es pas trop trop occupé ?
Si tu veux pas, je comprendrais, parce que bon... j'abuse :)
Commenter la réponse de icks99
icks99 9 Messages postés samedi 28 janvier 2006Date d'inscription 21 septembre 2006 Dernière intervention - 21 sept. 2006 à 14:42
0
Merci
Hello Again,

Bon, en même temps j'ai essayé de comprendre pourquoi j'étais aussi mauvais :)

J'ai corrigé Private Declare Function ReleaseDC Lib "user32" (ByVal hStdOutDC As Long, ByVal hDC As Long) As Long

Cette fois je n'ai plus de message d'erreur. Par contre j'ai toujours 4 octets qui se rajoutent (le rythme auquel ils se rajoutent a l'air plus lent).

Tu pourrais me dire si j'ai fait une erreur là ô grand Renfield ? ^^

'vérification de la couleur du point 1
 If GetPixel(GetDC(StdOut), x1, y1) = "255" Then
hStdOutDC = GetDC(StdOut)
    If timer1 = 0 Then
    timer1 = Timer
         netsend = Shell("net send toto Le point 1 est rouge !", vbHide)
    ReleaseDC StdOut, hStdOutDC
    DoEvents
    
    Else
        If Timer - timer1 > 7 Then timer1 = 0
    End If

 End If
Commenter la réponse de icks99
icks99 9 Messages postés samedi 28 janvier 2006Date d'inscription 21 septembre 2006 Dernière intervention - 21 sept. 2006 à 15:15
0
Merci
Eh ben alors là.... félicitations....

J'viens de tester avec le code que t'as optimisé et corrigé avec la fonction ReleaseDC, et ça marche, j'ai plus le cumul des 4 octets dans la mémoire utilisée par Excel toutes les 4 secondes !!

J'ai plus qu'à relire tout le code pour comprendre ce que t'as fait :)

Un autre truc, j'viens de m'apercevoir que la mémoire prise par excel augmente quand même de manière différente. En chronométrant c'était genre toutes les 50 secondes de 20 octets, ou parfois plus.

Bravo en tout cas :) T'es le Roi !!
Rah heureusement qu'y a des gens intelligents pour aider les simples d'esprit :)

Merci pour tout Renfield !!

J'vérifie le coup de la mémoire qui augmente quand même et j'te dirais ce qu'il en est.

Bonne suite de journée :)
Commenter la réponse de icks99
Renfield 17307 Messages postés mercredi 2 janvier 2002Date d'inscription 18 janvier 2017 Dernière intervention - 21 sept. 2006 à 15:18
0
Merci
ravi que ca fonctionne mieux

je viens de relire, j'avais pas vu la lecture dans
Private Sub CommandButton_Click()

il faut procéder de même avec le GetDC/ReleaseDC

Renfield
Admin CodeS-SourceS- MVP Visual Basic
Commenter la réponse de Renfield
icks99 9 Messages postés samedi 28 janvier 2006Date d'inscription 21 septembre 2006 Dernière intervention - 21 sept. 2006 à 16:10
0
Merci
Merci encore Renfield.

Je viens de corriger CommandButton_Click et CommandButton2_Click (les boutons qui servent à choisir les pixels avant la surveillance) avec les fonctions GetDC et les Release DC.

J'ai fait mon maniaque à compter et à chronométrer les augmentations de mémoire d'excel pendant le déroulement du code.

L'augmentation de mémoire du début doit être des résidus  du chargement initial ou un truc comme ça. (pareil des fois ça prend des octets sans raison, ou si on déplace la fenêtre, mais c'est apparemment sans rapport avec le déroulement du code, et c'est très faible).

Dans tout les cas le problème rencontré est définitivement et complètement résolu grâce à toi !

Bravo, et encore merci pour tout c'que tu fais, l'aide que tu fournis, ton talent, tout ça :)
Commenter la réponse de icks99

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.