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.