troubleshooting Question

Extremely simple drawing sub is leaking GDI objects!

Avatar of Lowspeed
Lowspeed asked on
Visual Basic Classic
4 Comments1 Solution547 ViewsLast Modified:
Hello Experts,

I have a simple sub which draws some points to a memory DC and then bitblts the result to a picturebox. The code is very straight forward and simple; however, when I examine the process of the application in ProcessExplorer I see the GDI handle count rising along with the memory. I am assuming this is because I am forgetting to release (a) GDI Object(s) somewhere.

If anyone can find a flaw or offer a suggestion, I would be greatly appeciative!

Code:

Public Sub Oscillscope(ByRef picFinal As PictureBox)

  On Error GoTo The_Fan
   
  '|| Coordinates
  Dim x           As Long
  Dim r           As Long
  Dim H           As Long
  Dim y           As Long
  Dim intHeight   As Integer
   
  '|| Data
  Dim intDataSize     As Integer
  Dim intData()       As Integer
   
  '|| Drawing
  Dim pntReturn       As POINTAPI     '<| Holds the location for the MoveTo, LineTo API calls
  Dim pntTextSize     As POINTAPI     '<| Hold the size returned by GetTextExtentPoint32
  Dim strTimeLeft     As String       '<| Formatted 'Time Left' string, e.g. -02:21
  Dim lngResult       As Long         '<| Holds the return code of our BitBlts
   
  '|| GDI Objects (requiring clean-up)
  Dim lngOriginalFont   As Long
  Dim lngOriginalPen    As Long
  Dim lngFont           As Long
  Dim lngPen            As Long
     
    '|| If we are not playing a track, we do not need to draw anything
    If BASS_ChannelIsActive(g_lngChannel) <> BASS_ACTIVE_PLAYING Then Exit Sub
   
    '|| Create memory DC compatible with the screen
    g_lngMemoryDC = CreateCompatibleDC(GetDC(0))
   
    '|| Check that DC creation was successful
    If g_lngMemoryDC Then
   
        '|| Create bitmap compatible with the screen
        lngBitmap = CreateCompatibleBitmap(GetDC(0), frmMain.picSpectrum.ScaleWidth, frmMain.picSpectrum.ScaleHeight)
       
        '|| Check that bitmap creation was successful
        If lngBitmap Then
       
            '|| Select the bitmap into the DC
            lngReturnBitmap = SelectObject(g_lngMemoryDC, lngBitmap)
           
            '|| Set the back mode of the DC to transparent (so text can overlap)
            SetBkMode g_lngMemoryDC, 1
           
            '|| Create a pen
            lngPen = CreatePen(PS_SOLID, 1, RGB(192, 0, 0))
           
            '|| Select the pen into the DC
            lngOriginalPen = SelectObject(g_lngMemoryDC, lngPen)
           
            '|| Store the height of our destination PictureBox
            intHeight = picFinal.Height
         
            '|| Store the amount of times we have hit this sub
            m_intTimes = m_intTimes + 1
           
            '|| Update the time remaining every half second or so (high resolution is not required)
            If m_intTimes >= 20 Then
           
                Dim lngCurrent  As Long
                Dim lngSeconds  As Long
           
                lngCurrent = BASS_ChannelBytes2Seconds(g_lngChannel, BASS_ChannelGetPosition(g_lngChannel))
               
                If lngCurrent = -1 Then
               
                    Exit Sub
               
                End If
               
                If lngCurrent >= g_lngCurrentLength - 1 Then
                   
                    frmMain.NextTrack
                   
                End If
           
                lngSeconds = (g_lngCurrentLength - lngCurrent)
                strTimeLeft = "-" & formatString(Int(lngSeconds / 60)) & ":" & formatString(Int(lngSeconds Mod 60))
       
            End If
           
            '|| Create our background text font
            lngFont = CreateFont(175, 0, 0, 0, FW_EXTRABOLD, False, False, False, DEFAULT_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, PROOF_QUALITY, DEFAULT_PITCH, "Tahoma")
           
            '|| Select font into the DC
            lngOriginalFont = SelectObject(g_lngMemoryDC, lngFont)
           
            '|| Set the text color of the DC
            SetTextColor g_lngMemoryDC, RGB(64, 0, 0)
           
            '|| Calculate the size of the formatted string
            GetTextExtentPoint32 g_lngMemoryDC, strTimeLeft, Len(strTimeLeft), pntTextSize
           
            '|| Draw the text to the DC
            TextOut g_lngMemoryDC, picFinal.ScaleWidth - pntTextSize.x, -20, strTimeLeft, Len(strTimeLeft)
           
            '|| Restore our original font
            DeleteObject SelectObject(g_lngMemoryDC, lngOriginalFont)
           
            '|| Delete the font object from memory
            DeleteObject lngFont
           
            'intDataSize = 500
            'intDataSize = 1000
            intDataSize = 2000
            'intDataSize = 4000
           
            ReDim intData(intDataSize) As Integer
       
            '|| Aquire some data from the audio channel
            BASS_ChannelGetData g_lngChannel, intData(0), intDataSize
           
            x = 0
       
            '|| Loop through data and draw our points/lines
            For r = 0 To intDataSize / 2 Step 1
               
                H = ((intData(r) + 32768) / 65535 * intHeight)
                x = ((picFinal.ScaleWidth * r * 256) / (intDataSize / 256 * 2048)) / 8
                y = ((intData(r * 2) + 32768) / 65535 * intHeight + 1)
               
                Select Case tOscill.DrawStyle
                   
                    Case 0 '<| Dot
                       
                        SetPixel g_lngMemoryDC, x, H, tOscill.LowColor
                       
                    Case 1 '<| Line
                           
                        If r = 0 Then
                            pntReturn.y = intHeight / 2
                            pntReturn.x = 0
                        End If
                       
                        If pntReturn.y = 0 Then pntReturn.y = intHeight / 2
       
                        MoveToEx g_lngMemoryDC, pntReturn.x, pntReturn.y, pntReturn
                        LineTo g_lngMemoryDC, x, H
                       
                    Case 2 '<| Solid
                       
                        If r = 0 Then
                            pntReturn.y = intHeight / 2
                            pntReturn.x = x
                        End If
       
                        MoveToEx g_lngMemoryDC, x, intHeight / 2, pntReturn
                        LineTo g_lngMemoryDC, x, H
                           
                End Select
           
            Next
           
            '|| Create our foreground font
            lngFont = CreateFont(32, 0, 0, 0, FW_EXTRABOLD, False, False, False, DEFAULT_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, PROOF_QUALITY, DEFAULT_PITCH, "Tahoma")
           
            '|| Select the font into the DC
            lngOriginalFont = SelectObject(g_lngMemoryDC, lngFont)
           
            '|| Set the text color of the DC
            SetTextColor g_lngMemoryDC, RGB(192, 0, 0)
           
            '|| Draw text to the DC
            TextOut g_lngMemoryDC, 0, 0, g_strArtist, Len(g_strArtist)
           
            '|| Calculate formatted text size
            GetTextExtentPoint32 g_lngMemoryDC, g_strArtist, Len(g_strArtist), pntTextSize
           
            '|| Draw text to the DC
            TextOut g_lngMemoryDC, 0, pntTextSize.y, g_strAlbum, Len(g_strAlbum)
           
            '|| BitBlt the DC to our PictureBox
            lngResult = BitBlt(picFinal.hdc, 0, 0, picFinal.ScaleWidth, picFinal.ScaleHeight, g_lngMemoryDC, 1, 1, vbSrcCopy)
           
            '|| Cleanup Objects
            DeleteObject SelectObject(g_lngMemoryDC, lngOriginalFont)
            DeleteObject lngFont
            DeleteObject SelectObject(g_lngMemoryDC, lngOriginalPen)
            DeleteObject lngPen
           
            '|| Cleanup DC/Bitmap
            SelectObject g_lngMemoryDC, lngReturnBitmap
            DeleteObject lngBitmap
            DeleteDC g_lngMemoryDC
           
        End If '<| Bitmap creation
       
    End If '<| DC creation
   
    Exit Sub

The_Fan:

    HandleError "modVisualization", "Oscillscope", Err.Number, Err.Description

End Sub
Join the community to see this answer!
Join our exclusive community to see this answer & millions of others.
Unlock 1 Answer and 4 Comments.
Join the Community
Learn from the best

Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.

Andrew Hancock - VMware vExpert
See if this solution works for you by signing up for a 7 day free trial.
Unlock 1 Answer and 4 Comments.
Try for 7 days

”The time we save is the biggest benefit of E-E to our team. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange.

-Mike Kapnisakis, Warner Bros