Where is the memory leak in this short VBA code?

The simple example code simply reads the pixel color in the top left corner again and again to test the memory leaks with reading the pixel color. Currently it only runs about 1000 times, but you'd need to run it for more iterations for some problems.

The first sign of issue is that after about 310 iterations the status bar in excel stops updating for some reason. If however I get to this many iterations by slowly stepping in the debugger, this doesn't happen. Secondly as long as that code runs, the memory usage of excel is climbing up steadily (although it never reaches very high levels where running out of ram would be an issue). The memory usage stays the same when the macro stops, only restarting excel fixes it.

If the code runs constantly for about 5 and a half minutes, excel freezes completely with things not displaying correctly. There are also graphical errors in the task manager at this point. The memory usage of excel goes from 14.7 MB to 19.1 MB between opening excel and freezing. To achieve this I increased the iterations to 30,000 on my system, but you may need a different amount of iterations in your system.

''''PIXELS
#If VBA7 Then
    Private Declare PtrSafe Function GetPixel Lib "gdi32" (ByVal hdc As LongPtr, ByVal x As Long, ByVal y As Long) As Long
    Private Declare PtrSafe Function GetWindowDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
#Else
    Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
    Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
#End If



Sub testcolor()

Dim color As String
Dim Time As Double
Time = Now()


For i = 1 To 1000
color = GetPixelcolor(0, 0)
If i Mod 10 = 0 Then
Application.StatusBar = i & "  " & "  " & Now() - Time & "  " & color
End If
Next


Application.StatusBar = False
End Sub

Function GetPixelcolor(ByVal x As Long, ByVal y As Long)
    Dim iPixelColor As Long
    Dim lDC As Variant
    lDC = GetWindowDC(0)
    
    iPixelColor = GetPixel(lDC, x, y)
    GetPixelcolor = Hex(iPixelColor)

End Function

Open in new window


Other info
I am using Excel 2010 but I found similar issues with other systems running later versions.
The reason I want to read pixels again and again, as in another program I'm automating higly repetitive tasks and pixel changes on the screen is how VBA finds out when the desired part of the other program loaded.
Laszlo BenedekAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Qlemo"Batchelor", Developer and EE Topic AdvisorCommented:
You need to release the DC again, that is each GetWindowDC or GetDC needs to be matched with a ReleaseDC for that DC. See https://msdn.microsoft.com/en-us/library/windows/desktop/dd144947(v=vs.85).aspx (GetWindowDC) and https://msdn.microsoft.com/en-us/library/windows/desktop/dd162920(v=vs.85).aspx (ReleaseDC).
1

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Laszlo BenedekAuthor Commented:
''''PIXEL

    
#If VBA7 Then
    Private Declare PtrSafe Function GetPixel Lib "gdi32" (ByVal hdc As LongPtr, ByVal x As Long, ByVal y As Long) As Long
    Private Declare PtrSafe Function GetWindowDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
    Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As LongPtr
#Else
    Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
    Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
#End If



Sub testcolor()

Dim color As String
Dim Time As Double
Time = Now()


For i = 1 To 1000
color = GetPixelcolor(0, 0)
If i Mod 10 = 0 Then
DoEvents
Application.StatusBar = i & "  " & "  " & Now() - Time & "  " & color
End If



Next




Application.StatusBar = False
End Sub

Function GetPixelcolor(ByVal x As Long, ByVal y As Long)
    Dim iPixelColor As Long
    Dim lDC As Variant
    lDC = GetWindowDC(0)
    
    iPixelColor = GetPixel(lDC, x, y)
    GetPixelcolor = Hex(iPixelColor)
    

    ReleaseDC 0, lDC
End Function

Open in new window

0
Laszlo BenedekAuthor Commented:
Thanks, that solves it, and it was quite a quick reply.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VBA

From novice to tech pro — start learning today.