Problems with GDI using API

[vcv]

I wrote a menu system from scratch using a class module, and everything works fairly well. I used API functions to do 95% of the drawing. The only problem is that if you move your mouse back and forth over the menus and keep clicking down on different ones, after a while, it causes the program to sort of stop responding. The menu turns white, and any attempts to move or resize the window causes the whole desktop to be drawn on.
I have been unable to figure out if I am doing anything wrong (i.e. not deleting an object). Here's the code that seems to be causing the problem:

Public Sub DrawMenu()
 
    Dim intMenus As Integer, j As Integer, intWidth As Integer, I As Integer
    Dim textWidth As Integer, textHeight As Integer, curX As Integer, intHeight As Integer
    Dim tBrush As Long, BMP As BitmapStruc, hFont As Long, theSize As Size
    Dim offset As Integer, ly As Integer, lx As Integer
    offset = 2
    
    Static bDrawing As Boolean
    
    If bDrawing Then Exit Sub
    
    bDrawing = True
    
    '* Create the fonts to be used
    hFont = CreateFont(13, 5, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, "Tahoma")
    If hFont = 0 Then Exit Sub
    
    '* Set the Area
    BMP.Area.Left = 0
    BMP.Area.Top = 0
    BMP.Area.Right = picMenu.ScaleWidth
    BMP.Area.Bottom = picMenu.ScaleHeight
    
    '* Create bitmap
    BMP.hDcMemory = CreateCompatibleDC(picMenu.hdc)
    BMP.hDcBitmap = CreateCompatibleBitmap(picMenu.hdc, picMenu.ScaleWidth, picMenu.ScaleHeight)
    BMP.hDcPointer = SelectObject(BMP.hDcMemory, BMP.hDcBitmap)
            
    If BMP.hDcMemory = 0 Or BMP.hDcBitmap = 0 Then
        DeleteObject BMP.hDcBitmap
        DeleteDC BMP.hDcMemory
        DeleteObject hFont
        Exit Sub
    End If
        
    '* Copy the background of picMenu into the DC
    tBrush = CreateSolidBrush(clrBackground)
    SelectObject BMP.hDcMemory, tBrush
    tBrush = CreatePen(0, 0, clrBackground)
    SelectObject BMP.hDcMemory, tBrush
    Rectangle BMP.hDcMemory, 0, 0, picMenu.ScaleWidth + 1, picMenu.ScaleHeight + 1
    DeleteObject tBrush
   
    '* Draw the uh..thing on the left
    tBrush = CreateSolidBrush(clrLines)
    SelectObject BMP.hDcMemory, tBrush
    tBrush = CreatePen(0, 1, clrLines)
    SelectObject BMP.hDcMemory, tBrush
    lx = 3
    For ly = 5 To 17 Step 2
        Rectangle BMP.hDcMemory, 4, ly, 4 + lx, ly + 1
    Next ly
    DeleteObject tBrush
    
    '* Set The Font
    Call SelectObject(BMP.hDcMemory, hFont)
    
    '* background of text transparent
    SetBkMode BMP.hDcMemory, 0
    
    intMenus = UBound(MenuArray) + 1
    If intMenus <= 0 Then GoTo fini****
    
    I = 0
        
    textHeight = picMenu.textWidth("gW")
    intHeight = textHeight + (YM_Buffer * 2)
    
    curX = XStart
    
    On Error Resume Next
    For j = 1 To intMenus
        'textWidth = picMenu.textWidth(MenuArray(j - 1))
        Call GetTextExtentPoint32(BMP.hDcMemory, MenuArray(j - 1), Len(MenuArray(j - 1)), theSize)
        textWidth = theSize.cx
        'intHeight = theSize.cy + (YM_Buffer * 2)
        intWidth = textWidth + (XM_Buffer * 2)
    
        MenuYPos(j - 1) = curX + 4
        If mnuOverWhich = j Then
            If bPopupShown Then
                tBrush = CreateSolidBrush(RGB(150, 150, 150)) 'clrButtonOver)
                SelectObject BMP.hDcMemory, tBrush
                tBrush = CreatePen(0, 1, RGB(150, 150, 150)) 'clrBorderOver)
                SelectObject BMP.hDcMemory, tBrush
            Else
                tBrush = CreateSolidBrush(clrButtonOver)
                SelectObject BMP.hDcMemory, tBrush
                tBrush = CreatePen(0, 1, clrBorderOver)
                SelectObject BMP.hDcMemory, tBrush
            End If
        Else
            tBrush = CreateSolidBrush(clrButtonOff)
            SelectObject BMP.hDcMemory, tBrush
            tBrush = CreatePen(0, 1, clrBorderOff)
            SelectObject BMP.hDcMemory, tBrush
        End If
        Rectangle BMP.hDcMemory, curX, YStart, curX + intWidth, YStart + intHeight
        DeleteObject tBrush
        
        TextOut BMP.hDcMemory, curX + XM_Buffer, (picMenu.ScaleHeight - textHeight) \ 2 + 1, MenuArray(j - 1), Len(MenuArray(j - 1))
        curX = curX + intWidth + 1
        I = I + 1
    Next
    
fini****:
    'picMenu.Picture = picMenuBuffer.Image
    BitBlt picMenu.hdc, BMP.Area.Left, BMP.Area.Top, BMP.Area.Right, BMP.Area.Bottom, BMP.hDcMemory, 0, 0, SRCCOPY
    
    DeleteObject hFont
    DeleteObject BMP.hDcBitmap
    BMP.hDcMemory = 0
    BMP.hDcBitmap = 0
    DeleteDC BMP.hDcMemory
    
    bMenuDrew = True
    bDrawing = False
 
End Sub

Some quick notes: The picMenu picturebox's AutoRedraw property is set to false, and ScaleMode to 3.

[gdebacker]

Sounds like a GDI resource problem. Somewhere you are not deleting an object that you created and releasing those resources. Eventually your PC runs out of resources and is unable to redraw properly.

I only glanced at your code, and I'm far from an expert of GDI, but I did notice soemthing I would do differntly.

Here you create a pen and a brush using the same variable but you only delete the object once when it is the pen but not the brush.

tBrush = CreateSolidBrush(RGB(150, 150, 150)) 'clrButtonOver)
SelectObject BMP.hDcMemory, tBrush
tBrush = CreatePen(0, 1, RGB(150, 150, 150)) 'clrBorderOver)
SelectObject BMP.hDcMemory, tBrush
lx = 3
For ly = 5 To 17 Step 2
     Rectangle BMP.hDcMemory, 4, ly, 4 + lx, ly + 1
Next ly
DeleteObject tBrush

I would write this as

tBrush = CreateSolidBrush(RGB(150, 150, 150)) 'clrButtonOver)
SelectObject BMP.hDcMemory, tBrush
tPen = CreatePen(0, 1, RGB(150, 150, 150)) 'clrBorderOver)
SelectObject BMP.hDcMemory, tPen
lx = 3
For ly = 5 To 17 Step 2
     Rectangle BMP.hDcMemory, 4, ly, 4 + lx, ly + 1
Next ly
DeleteObject tBrush
DeleteObject tPen

You can run the resource monitor that comes with Windows to track your resource usage and make sure you are returning all of the resources you program uses.

Start/Programs/Accessories/System Tools/Resource Meter

Greg

[vcv]

Yep, already got that figured out. Someone pointed it out to me.

Thing is, the problem still occurs, and I notice each time I move the mouse over a new menu item, resources that my program is using jump 4k.