Memoryleak

[jojotsch]

I am searching for a memoryleak in my application.

Perhaps the reason is a misunderstandig. I am using IS3RGBToHBITMAP. The helpfile told me:
Return Value HBITMAP object. Caller must call DestroyObject to release this memory.
Because I did not find a function called DestroyObject I am using DeleteObject. Could this be the reason?

JoJo

[Chris]

DeleteObject is the correct call.

what kind of leak is it?

[jojotsch]

Perhaps you will see a mistake.
With the following code I am loosing memory every time the function is called (approx. 60kb).
pic is the picturebox for drawing (150x120).

Public gpHDCback As Long
Public gpBMPback As Long

Private pRGB1 As Long
Private pRGB2 As Long
Private pHDCBild As Long
Private pBMPBild As Long
Private pHDC As Long
Private pBMP As Long
Private pHDC1 As Long
Private pBMP1 As Long
Private image_width As Long
Private image_height As Long
Private new_width As Long
Private new_height As Long
Private xposimage As Long
Private yposimage As Long
Private blende As Long
Private pColor As Long

Function draw_picture(pic As PictureBox, ByVal filename As String) As String

  Dim f As Single
  Dim f_width As Single
  Dim f_height As Single
  Dim rc As Long
  Dim area As rect
  
  pRGB1 = 0
  pRGB2 = 0

  'Load Image
  draw_picture = GetImg(filename, StrConv(Right$(filename, 3), vbUpperCase), pRGB1, image_width, image_height)
  If Len(draw_picture) <> 0 Then
    GoTo weiter
  End If

  f_width = image_width / pic.Width
  f_height = image_height / pic.Height
  f = dmax(f_width, f_height)
  new_width = image_width / f
  new_height = image_height / f

  pRGB2 = GlobalAlloc(GPTR, (new_width * new_height * 3))
  If pRGB2 = 0 Then
    draw_picture = "Error in GlobalAlloc: " & vbLf & filename
    GoTo weiter
  End If

  If IS3DecimateImage(pRGB1, image_width, image_height, image_width * 3, pRGB2, new_width, new_height, new_width * 3, 3, 0) <> ISOURCE_TRUE Then
    draw_picture = "Error " & IS3GetLastError() & " in IS3DecimateImage" & vbLf & filename
    GoTo weiter
  End If

  If pRGB1 <> 0 Then
    Call GlobalFree(pRGB1)
    pRGB1 = 0
  End If

  pRGB1 = pRGB2
  pRGB2 = 0

  image_width = new_width
  image_height = new_height

  pHDCBild = CreateCompatibleDC(pic.hDC)
  If pHDCBild = 0 Then
    Debug.Print pHDCBild
  End If

  pBMPBild = IS3RGBToHBITMAP(pRGB1, image_width, image_height, 0, pic.hDC)
  If pBMPBild = 0 Then
    Debug.Print pBMPBild
  End If
  rc = SelectObject(pHDCBild, pBMPBild)

  pColor = CreateSolidBrush(hgfarbe)
  If pColor = 0 Then
    draw_picture = "Error in CreateSolidBrush in DrawPicture" & vbLf & filename
    GoTo weiter
  End If

  area.Left = 0
  area.Top = 0
  area.Right = pic.Width
  area.Bottom = pic.Height
  If fillRect(gpHDCback, area, pColor) = 0 Then
    draw_picture = "Error in FillRect in DrawPicture" & vbLf & filename
    GoTo weiter
  End If

  xposimage = (pic.Width - image_width) / 2
  yposimage = (pic.Height - image_height) / 2

  If BitBlt(gpHDCback, xposimage, yposimage, image_width, image_height, pHDCBild, 0, 0, SRCCOPY) = 0 Then
    draw_picture = "Error in BitBlt in DrawPicture" & vbLf & filename
    GoTo weiter
  End If
  
  Call blende_000(pic)

weiter:
  'Release memory
  If pRGB1 <> 0 Then
    rc = GlobalFree(pRGB1)
    If rc <> 0 Then
      Debug.Print rc
    End If
    pRGB1 = 0
  End If

  If pRGB2 <> 0 Then
    rc = GlobalFree(pRGB2)
    If rc <> 0 Then
      Debug.Print rc
    End If
    pRGB2 = 0
  End If

  If pBMPBild <> 0 Then
    rc = DeleteObject(pBMPBild)
    If rc = 0 Then
      Debug.Print rc
    End If
    pBMPBild = 0
  End If

  If pHDCBild <> 0 Then
    rc = DeleteDC(pHDCBild)
    If rc = 0 Then
      Debug.Print rc
    End If
    pHDCBild = 0
  End If

  If pBMP <> 0 Then
    rc = DeleteObject(pBMP)
    If rc = 0 Then
      Debug.Print rc
    End If
    pBMP = 0
  End If

  If pHDC <> 0 Then
    rc = DeleteDC(pHDC)
    If rc = 0 Then
      Debug.Print rc
    End If
    pHDC = 0
  End If

  If pBMP1 <> 0 Then
    rc = DeleteObject(pBMP1)
    If rc = 0 Then
      Debug.Print rc
    End If
    pBMP1 = 0
  End If

  If pHDC1 <> 0 Then
    rc = DeleteDC(pHDC1)
    If rc = 0 Then
      Debug.Print rc
    End If
    pHDC1 = 0
  End If

  If pColor <> 0 Then
    rc = DeleteObject(pColor)
    If rc = 0 Then
      Debug.Print rc
    End If
    pColor = 0
  End If

End Function

[jojotsch]

Is this sequence my error?
rc = DeleteObject(...)
rc = DeleteDC(...)

Is this sequence a must?
rc = DeleteDC(...)
rc = DeleteObject(...)

[Chris]

one thing you need to do is to select the default object back into the DC before you delete the DC. in general, the sequence for using GDI objects is:

// the first time you select an object into a DC, save the return value.
// this is the 'default' object.
HBITMAP hBitmapOld = SelectObject(hDC, hBmp);

...whatever

SelectObject(hDC, hBitmapOld);
DeleteObject(hBmp);
DeleteDC(hDC);

-c