VB6 Memory Leak

[Nean]

Ok, so I'm using ED 2.0 (Could be before that even), before you say: "Get something better" please understand that this game has been running off of ED 2.0 for about 2 years. Now, there is a memory leak somewhere and as the programmer for this game, this is a little bit stressful, because it's fucking impossible to pin point. I believe that it has to do with how Dx7 is initialized, seeing as at the game screen memory is 50k, and then when you login it jumps to 100k, and then when I'm actually playing the game it's 250k+. I'm not very good with DX7 so can anyone look through these and see if somethings awry? Honestly I hate to ask, but you're the only credible programmers I know that are willing to help.

Code:

Option Explicit

'Private Resp As Long

Public tmrRainDropTag As String

Public tmrSnowDropTag As String

Public Const TilesInSheets As Byte = 14

Public Const ExtraSheets As Byte = 6

Public DX As New DirectX7

Public DD As DirectDraw7

Public DD_Clip As DirectDrawClipper

Public DD_PrimarySurf As DirectDrawSurface7

Public DDSD_Primary As DDSURFACEDESC2

Public DD_SpriteSurf As DirectDrawSurface7

Public DDSD_Sprite As DDSURFACEDESC2

Public DD_SpellIcons As DirectDrawSurface7

Public DDSD_SpellIcons As DDSURFACEDESC2

Public DD_ItemSurf As DirectDrawSurface7

Public DDSD_Item As DDSURFACEDESC2

Public DD_EmoticonSurf As DirectDrawSurface7

Public DDSD_Emoticon As DDSURFACEDESC2

Public DD_BackBuffer As DirectDrawSurface7

Public DDSD_BackBuffer As DDSURFACEDESC2

Public DD_BigSpriteSurf As DirectDrawSurface7

Public DDSD_BigSprite As DDSURFACEDESC2

Public DD_SpellAnim As DirectDrawSurface7

Public DDSD_SpellAnim As DDSURFACEDESC2

Public DD_TileSurf(0 To ExtraSheets) As DirectDrawSurface7

Public DDSD_Tile(0 To ExtraSheets) As DDSURFACEDESC2

Public TileFile(0 To ExtraSheets) As Byte

Public DDSD_ArrowAnim As DDSURFACEDESC2

Public DDSD_TileIcon As DDSURFACEDESC2

Public DD_ArrowAnim As DirectDrawSurface7

Public DD_RestIcon As DirectDrawSurface7

Public rec As RECT

Public rec_pos As RECT

Code:

Sub InitDirectX()

    ' Initialize direct draw
    Set DD = DX.DirectDrawCreate(vbNullString)
    frmMirage.Show
    
    ' Indicate windows mode application
    Call DD.SetCooperativeLevel(frmMirage.hWnd, DDSCL_NORMAL)
    
    ' Init type and get the primary surface
    DDSD_Primary.lFlags = DDSD_CAPS
    DDSD_Primary.ddsCaps.lCaps = DDSCAPS_PRIMARYSURFACE
    Set DD_PrimarySurf = DD.CreateSurface(DDSD_Primary)
    
    ' Create the clipper
    Set DD_Clip = DD.CreateClipper(0)
    
    ' Associate the picture hwnd with the clipper
    DD_Clip.SetHWnd frmMirage.picScreen.hWnd
        
    ' Have the blits to the screen clipped to the picture box
    DD_PrimarySurf.SetClipper DD_Clip
        
    ' Initialize all surfaces
    Call InitSurfaces
End Sub

Code:

Sub InitSurfaces()
    Dim key As DDCOLORKEY
    Dim I As Long

    ' Check for files existing
    If Not FileExist("\GFX\sprites.bmp") Or Not FileExist("\GFX\items.bmp") Or Not FileExist("\GFX\bigsprites.bmp") Or Not FileExist("\GFX\emoticons.bmp") Or Not FileExist("\GFX\arrows.bmp") Then
        Call MsgBox("You're missing some graphic files!", vbOKOnly, GAME_NAME)
        Call GameDestroy
    End If
    
    ' Set the key for masks
    key.low = 0
    key.high = 0
    
    ' Initialize back buffer
    DDSD_BackBuffer.lFlags = DDSD_CAPS Or DDSD_HEIGHT Or DDSD_WIDTH
    DDSD_BackBuffer.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
    DDSD_BackBuffer.lWidth = (MAX_MAPX + 1) * PIC_X
    DDSD_BackBuffer.lHeight = (MAX_MAPY + 1) * PIC_Y
    Set DD_BackBuffer = DD.CreateSurface(DDSD_BackBuffer)
    
    ' Init sprite ddsd type and load the bitmap
    DDSD_Sprite.lFlags = DDSD_CAPS
    DDSD_Sprite.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
    Set DD_SpriteSurf = DD.CreateSurfaceFromFile(App.Path & "\GFX\sprites.bmp", DDSD_Sprite)
    SetMaskColorFromPixel DD_SpriteSurf, 0, 0
    
    ' Init tiles ddsd type and load the bitmap
    For I = 0 To ExtraSheets

        If Dir$(App.Path & "\GFX\tiles" & I & ".bmp")  vbNullString Then
            DDSD_Tile(I).lFlags = DDSD_CAPS
            DDSD_Tile(I).ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
            Set DD_TileSurf(I) = DD.CreateSurfaceFromFile(App.Path & "\GFX\tiles" & I & ".bmp", DDSD_Tile(I))
            SetMaskColorFromPixel DD_TileSurf(I), 0, 0
            TileFile(I) = 1
        Else
            TileFile(I) = 0
        End If

    Next
    
    ' Init items ddsd type and load the bitmap
    DDSD_Item.lFlags = DDSD_CAPS
    DDSD_Item.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
    Set DD_ItemSurf = DD.CreateSurfaceFromFile(App.Path & "\GFX\items.bmp", DDSD_Item)
    SetMaskColorFromPixel DD_ItemSurf, 0, 0
    
    ' Init big sprites ddsd type and load the bitmap
    DDSD_BigSprite.lFlags = DDSD_CAPS
    DDSD_BigSprite.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
    Set DD_BigSpriteSurf = DD.CreateSurfaceFromFile(App.Path & "\GFX\bigsprites.bmp", DDSD_BigSprite)
    SetMaskColorFromPixel DD_BigSpriteSurf, 0, 0
    
    ' Init emoticons ddsd type and load the bitmap
    DDSD_Emoticon.lFlags = DDSD_CAPS
    DDSD_Emoticon.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
    Set DD_EmoticonSurf = DD.CreateSurfaceFromFile(App.Path & "\GFX\emoticons.bmp", DDSD_Emoticon)
    SetMaskColorFromPixel DD_EmoticonSurf, 0, 0
    
    ' init icons
    DDSD_SpellIcons.lFlags = DDSD_CAPS
    DDSD_SpellIcons.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
    Set DD_SpellIcons = DD.CreateSurfaceFromFile(App.Path & "\GFX\icons.bmp", DDSD_SpellIcons)
    SetMaskColorFromPixel DD_EmoticonSurf, 0, 0
    
    ' Init spells ddsd type and load the bitmap
    DDSD_SpellAnim.lFlags = DDSD_CAPS
    DDSD_SpellAnim.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
    Set DD_SpellAnim = DD.CreateSurfaceFromFile(App.Path & "\GFX\spells.bmp", DDSD_SpellAnim)
    SetMaskColorFromPixel DD_SpellAnim, 0, 0
    
    ' Init arrows ddsd type and load the bitmap
    DDSD_ArrowAnim.lFlags = DDSD_CAPS
    DDSD_ArrowAnim.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
    Set DD_ArrowAnim = DD.CreateSurfaceFromFile(App.Path & "\GFX\arrows.bmp", DDSD_ArrowAnim)
    SetMaskColorFromPixel DD_ArrowAnim, 0, 0
    
    'Init Rest Icon
    DDSD_TileIcon.lFlags = DDSD_CAPS
    DDSD_TileIcon.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
    Set DD_RestIcon = DD.CreateSurfaceFromFile(App.Path & "\GFX\rest.bmp", DDSD_TileIcon)
    SetMaskColorFromPixel DD_RestIcon, 0, 0
End Sub

Code:

Sub DestroyDirectX()
    Dim I As Long

    Set DX = Nothing
    Set DD = Nothing
    Set DD_PrimarySurf = Nothing
    Set DD_SpriteSurf = Nothing
    Set DD_SpellIcons = Nothing

    For I = 0 To ExtraSheets

        If TileFile(I) = 1 Then
            Set DD_TileSurf(I) = Nothing
        End If

    Next

    Set DD_ItemSurf = Nothing
    Set DD_BigSpriteSurf = Nothing
    Set DD_EmoticonSurf = Nothing
    Set DD_SpellAnim = Nothing
    Set DD_ArrowAnim = Nothing
End Sub

Code:

Function NeedToRestoreSurfaces() As Boolean

    NeedToRestoreSurfaces = True
    
    If DD.TestCooperativeLevel = DD_OK Then NeedToRestoreSurfaces = False

End Function

Code:

Public Sub SetMaskColorFromPixel(ByRef TheSurface As DirectDrawSurface7, _
                                 ByVal x As Long, _
                                 ByVal y As Long)
    Dim TmpR As RECT
    Dim TmpDDSD As DDSURFACEDESC2
    Dim TmpColorKey As DDCOLORKEY

    With TmpR
        .Left = x
        .Top = y
        .Right = x
        .Bottom = y
    End With

    TheSurface.Lock TmpR, TmpDDSD, DDLOCK_WAIT Or DDLOCK_READONLY, 0

    With TmpColorKey
        .low = TheSurface.GetLockedPixel(x, y)
        .high = .low
    End With

    TheSurface.SetColorKey DDCKEY_SRCBLT, TmpColorKey

    TheSurface.Unlock TmpR
End Sub

Code:

Sub DisplayFx(ByRef surfDisplay As DirectDrawSurface7, _
              intX As Long, _
              intY As Long, _
              intWidth As Long, _
              intHeight As Long, _
              lngROP As Long, _
              blnFxCap As Boolean, _
              Tile As Long)
    Dim lngSrcDC As Long
    Dim lngDestDC As Long

    lngDestDC = DD_BackBuffer.GetDC
    lngSrcDC = surfDisplay.GetDC
    BitBlt lngDestDC, intX, intY, intWidth, intHeight, lngSrcDC, (Tile Mod TilesInSheets) * PIC_X, (Tile \ TilesInSheets) * PIC_Y, lngROP
    surfDisplay.ReleaseDC lngSrcDC
    DD_BackBuffer.ReleaseDC lngDestDC
End Sub

[JokeofWeek]

Altough I did not read the entire code, I would assume that loading 6-7 tile sheets can't be that good for memory usage, especially when you aren't even using all the tile sheets..

[Matt]

It wouldn't cause a memory leak. So, that's not the problem. I load 25 sets with my source at the start and it only takes about 25MB total.

[JokeofWeek]

It wouldn't cause a memory leak. So, that's not the problem. I load 25 sets with my source at the start and it only takes about 25MB total.

It's not necessarily a leak though. Do you load all your tile sets in the system memory?

Edit: Then again, that wouldn't take up that much memory unless they were huge tilesets, so I am probably wrong xD

[GIAKEN]

Well he was using my DX7 class. I converted his game to use it, but he complained about it having memory leaks...then he moved back to the old shitty Elysium system and still complained.

[Nean]

Well he was using my DX7 class. I converted his game to use it, but he complained about it having memory leaks...then he moved back to the old shitty Elysium system and still complained.

Over half of our players had a FPS cut with your DX7 class, almost a 100% FPS cut. That's a pretty big deal.

[Joost]

For one, you could convert Public Sub SetMaskColorFromPixel( to just a variable, asuming you use the same transparent colour for every tileset. Elysium was made for games, not for a game.

[Nean]

For one, you could convert Public Sub SetMaskColorFromPixel( to just a variable, asuming you use the same transparent colour for every tileset. Elysium was made for games, not for a game.

Hmm. I think I'll do that. Thanks for the suggestion.

[Joost]

For two, I think ES is limited to one tileset per map, you could try to load and unload tilesets when switching maps.

And yeah, you call that check upper pixel part about 15 times, while you probably always use a black background.

[Labmonkey]

It isn't, and I'm pretty sure Hyrule Online mixes tilesets.

Make sure everything is initialized only once. Seems like a dumb problem, but you never know what's in Elysium.