Out of Memory

[joey o.]

'I'm using the following example and put it in my mousemove event. I am continually getting an "Out of Memory" error. Any Idea's?

'VB code:

Option Explicit

Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Const SRCCOPY = &HCC0020 ' (DWORD) dest = source

Dim memdc As Long
Dim membmp As Long
Dim i As Single, j As Single





Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'create a memory DC for this form
memdc = CreateCompatibleDC(Me.hdc)
'create a bitmap for this form
membmp = CreateCompatibleBitmap(Me.hdc, Picture1.ScaleWidth, Picture1.ScaleHeight)
'select that bitmap into the memory dc
SelectObject memdc, membmp
'paste the picture from the picture onto the memory DC.
'Because we selected the bitmap in the memory DC, it'll
'be pasted on the bitmap
BitBlt memdc, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight, Picture1.hdc, 0, 0, SRCCOPY
'now paste the contents of the memory DC on this form
Refresh
BitBlt Me.hdc, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight, memdc, i, j, SRCCOPY
i = i + 1
If i > 320 Then
j = j + 1
i = 0
Picture1.Refresh
End If
DeleteObject memdc
DeleteObject membmp

End Sub

[Fox]

you must not create the memory dc every time mousemove is called

i dont know if this is the problem, but you shouldnt do so at all

[joey o.]

Thanks!

This seems to work:

'VB code:

Option Explicit

Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Const SRCCOPY = &HCC0020 ' (DWORD) dest = source

Dim memdc As Long
Dim membmp As Long
Dim i As Single, j As Single





Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbLeftButton Then
'create a memory DC for this form
memdc = CreateCompatibleDC(Me.hdc)
'create a bitmap for this form
membmp = CreateCompatibleBitmap(Me.hdc, Picture1.ScaleWidth, Picture1.ScaleHeight)
'select that bitmap into the memory dc
SelectObject memdc, membmp
End If
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbLeftButton Then
'paste the picture from the picture onto the memory DC.
'Because we selected the bitmap in the memory DC, it'll
'be pasted on the bitmap
BitBlt memdc, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight, Picture1.hdc, 0, 0, SRCCOPY
'now paste the contents of the memory DC on this form
Refresh
BitBlt Me.hdc, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight, memdc, i, j, SRCCOPY
i = i + 1
If i > 320 Then
j = j + 1
i = 0
Picture1.Refresh
End If
End If
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
DeleteObject memdc
DeleteObject membmp
End Sub

[PsychoMark]

The SelectObject and DeleteObject problem seems to come back every once in a while and everybody has a different solution. In my opinion, your method is wrong. After studying the GDI API's for a while now, I came to the conclusion you have to select the old object back into the DC before freeing it.

It doesn't matter that much with only one DC, but if you miss any call or place it at the wrong position, you've got yourself a memory leak.

Correct me if I'm wrong here, but this is how I think it should be:

Dim hMemDC As Long
Dim hOldBMP As Long
 
' Create memory DC
hMemDC = CreateCompatibleDC(Me.hdc) 
 
' Select bitmap into it, storing the previous value
' (SelectObject returns the previous bitmap which
' was selected into the DC)
hOldBMP = SelectObject(hMemDC, CreateCompatibleBitmap(Me.hdc, Width, Height))
 
'
' Now you can draw...
'
 
' First, select the old bitmap back into the DC and delete our bitmap
DeleteObject(SelectObject(hMemDC, hOldBMP))
 
' Now delete the DC
DeleteDC(hMemDC)

I've also seen ReleaseDC being used, therefore I quote from the SDK help files:

Remarks

The application must call the ReleaseDC function for each call to the GetWindowDC function and for each call to the GetDC function that retrieves a common device context.

An application cannot use the ReleaseDC function to release a device context that was created by calling the CreateDC function; instead, it must use the DeleteDC function.

[joey o.]

Thanks! This should save some poor unexpecting downloaders a crash or two - and I learned something too!

[jim mcnamara]

You really should use a DeleteDC call at ther end. And restoring the objects back to the DC is good programming practice, even if as in this case it doesn't make too much difference.

All of the api I've used & seen has this general scheme:

GetDC -> restore objects as they were -> ReleaseDC

or

CreateDC (or CreateCompatibleDC) -> DeleteDC.

Doing otherwise causes problems. If it's good enough for MS, it's good enough for me.