Results 1 to 5 of 5

Thread: URGENT HELP WITH MEMORY PROBLEMS!

  1. #1

    Thread Starter
    Addicted Member danielkw's Avatar
    Join Date
    Mar 2000
    Location
    Sweden
    Posts
    134

    Exclamation

    Hello everyone!

    I am creating a sprite class, and now I have encountered some problems. The 'main' procedures in the class are the ones listed below. The problem is this:
    To use a sprite I do like this:

    General declarations in Form1:
    Code:
    Private sSprite1 As New cSprite
    
    Sub Form_Activate()
        AutoRedraw = True
        sSprite1.Init
        sSprite1.LoadBitmap App.path + "\test1.bmp"
        sSprite1.DrawSprite Me.Hdc
    End Sub
    
    Sub Form_Unload()
        sSprite1.Delete
    End Sub
    So, far so good... I think... At least it's working but something is wrong, because, if I want to animate the sprite, I do like this:
    I add a Timer control:
    Code:
    Sub Timer1_Timer()
        ' f is just a var holding which frame is in count...
        sSprite1.LoadBitmap app.path + "\test" & f & ".bmp"
        sSprite1.DrawSprite Me.Hdc
    End Sub
    Ok, this is working. But only for a while!!! After a while I get the message "Out of memory". What's wrong in the code? What memoryplace aren't I cleaning? What is WRONG???
    PLEASE HELP!!!!!!!!!!!!!

    Code:
    Private Type BITMAP
       bmType As Long
       bmWidth As Long
       bmHeight As Long
       bmWidthBytes As Long
       bmPlanes As Integer
       bmBitsPixel As Integer
       bmBits As Long
    End Type
    
    Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
    Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
    Private Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
    Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
    Private Declare Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 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 DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
    Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
    Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
    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 iImageDC As Long
    Private iInvertImageDC As Long
    Private iMaskDC As Long
    Private iWidth As Long
    Private iHeight As Long
    
    Public Function Init() As Boolean
    
        Init = True
        If iImageDC = 0 Then iImageDC = CreateCompatibleDC(0)
        If iInvertImageDC = 0 Then iInvertImageDC = CreateCompatibleDC(0)
        If iMaskDC = 0 Then iMaskDC = CreateCompatibleDC(0)
        If (iImageDC = 0) Or (iInvertImageDC = 0) Or (iMaskDC = 0) Then
            Init = False
        End If
    
    End Function
    
    Public Sub Delete()
    
       Call DeleteDC(iImageDC)
       Call DeleteDC(iInvertImageDC)
       Call DeleteDC(iMaskDC)
    
    End Sub
    
    Private Function SetBitmap(NewBitmap As Long) As Boolean
    
        Dim lResult As Long
        Dim iInvertImage As Long
                                    
        Dim iMask As Long
        Dim BitmapData As BITMAP
        
        lResult = GetObject(NewBitmap, Len(BitmapData), BitmapData)
    
        If (lResult = 0) Then
            SetBitmap = False
        End If
    
        iWidth = BitmapData.bmWidth
        iHeight = BitmapData.bmHeight
    
        If (iImageDC = 0) Or (iInvertImageDC = 0) Or (iMaskDC = 0) Then
            SetBitmap = False
            Exit Function
        End If
        
        lResult = SelectObject(iImageDC, NewBitmap)
    
        If (lResult = 0) Then
            SetBitmap = False
            Exit Function
        End If
    
    
        iInvertImage = CreateCompatibleBitmap(iImageDC, iWidth, iHeight)
    
        lResult = SelectObject(iInvertImageDC, iInvertImage)
    
        If (lResult = 0) Then
            SetBitmap = False
            Exit Function
        End If
    
        iMask = CreateCompatibleBitmap(iMaskDC, iWidth, iHeight)
    
        If (iMask = 0) Then
            SetBitmap = False
            Exit Function
        End If
    
        lResult = SelectObject(iMaskDC, iMask)
    
        If (lResult = 0) Then
            SetBitmap = False
            Exit Function
        End If
    
        lResult = BitBlt(iInvertImageDC, 0, 0, iWidth, iHeight, iImageDC, 0, 0, vbSrcCopy)
        
        If (lResult = 0) Then
            SetBitmap = False
            Exit Function
        End If
        
        lResult = BitBlt(iMaskDC, 0, 0, iWidth, iHeight, iImageDC, 0, 0, vbSrcCopy)
        
        If (lResult = 0) Then
            SetBitmap = False
            Exit Function
        End If
        
        lResult = SetBkColor(iInvertImageDC, vbWhite)
        
        If (lResult = CLR_INVALID) Then
            SetBitmap = False
            Exit Function
        End If
        
        lResult = SetTextColor(iInvertImageDC, vbBlack)
    
        If (lResult = CLR_INVALID) Then
            SetBitmap = False
            Exit Function
        End If
    
        lResult = BitBlt(iInvertImageDC, 0, 0, iWidth, iHeight, iMaskDC, 0, 0, vbSrcAnd)
    
        If (lResult = 0) Then
            SetBitmap = False
            Exit Function
        End If
    
        lResult = DeleteObject(iInvertImage)
    
        If (lResult = 0) Then
            SetBitmap = False
            Exit Function
        End If
    
        lResult = DeleteObject(iMask)
        
        If (lResult = 0) Then
           SetBitmap = False
            Exit Function
        End If
        
        SetBitmap = True
    
    End Function
    
    Public Sub DrawSprite(targetHdc As Long)
    
        BitBlt targetHdc, mLeft, mTop, iWidth, iHeight, iInvertImageDC, 0, 0, vbMergePaint
        BitBlt targetHdc, mLeft, mTop, iWidth, iHeight, iImageDC, 0, 0, vbSrcAnd
    
    End Sub
    
    Public Function LoadBitmap(sFileName As String) As Boolean
    
        Dim hBitmap As Long
        
        hBitmap = LoadImage(0, sFileName, IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE)
    
        LoadBitmap = SetBitmap(hBitmap)
    
    End Function

  2. #2

    Thread Starter
    Addicted Member danielkw's Avatar
    Join Date
    Mar 2000
    Location
    Sweden
    Posts
    134

    Talking Ooops, I forgot two things...

    I forgot to mention the two constants used in the LoadBitmap function. They are declared like this in the beginning of the classfile:
    Code:
    Private Const IMAGE_BITMAP = &O0
    Private Const LR_LOADFROMFILE = 16

  3. #3

    Thread Starter
    Addicted Member danielkw's Avatar
    Join Date
    Mar 2000
    Location
    Sweden
    Posts
    134

    Unhappy Please guys! I Really need help!

    PLEASE Guys!!! I really need some help on this!!!

  4. #4

  5. #5

    Thread Starter
    Addicted Member danielkw's Avatar
    Join Date
    Mar 2000
    Location
    Sweden
    Posts
    134
    Well, the problem is obviosly that I am not releasing all the memory I take. I don't know why. I call the DeleteDC and DeleteObject once the sprite is removed and I don't request any new DCs or objects (when calling LoadBitmap) since they were initialized at the Init procedure... I would like to know what's causing the problem, i.e. what memory I have to release before getting new one...

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width