simpLe animation, hangs on unload ; * )

[scr0p]

Save a BMP (any, for a test, spIN.bmp) and run the code below. The animation plays but.. when you press the x (not stop in VB IDE). The animation does not close, it hangs still pLaying and your forced to end task.. but why~?

'Sonikku`s cOde-_-
Option Explicit
Dim DX As New DirectX7
Dim DD As DirectDraw7
Dim ddsd1 As DDSURFACEDESC2
Dim ddsd2 As DDSURFACEDESC2
Dim Primary As DirectDrawSurface7
Dim PiCBuFFeR As DirectDrawSurface7
Dim bInit As Boolean
Dim brunning As Boolean, brestore As Boolean
Dim ddclipper As DirectDrawClipper
 
Private Type AnimationFrame
    Top As Long
    Left As Long
End Type
Dim Frame(4) As AnimationFrame
Dim CurFrame As Integer
Dim Dir_up As Boolean
Dim LastTimeDrawn As Long
Const Delaytime = 1000 / 25
 
Private Sub Form_load()
    Init
End Sub
 
Sub Init()
    Set DD = DX.DirectDrawCreate("")
    Call DD.SetCooperativeLevel(Me.hWnd, DDSCL_NORMAL)
    ddsd1.lFlags = DDSD_CAPS
    ddsd1.ddsCaps.lCaps = DDSCAPS_PRIMARYSURFACE
        
    Set Primary = DD.CreateSurface(ddsd1)
    ddsd2.lFlags = DDSD_CAPS
    ddsd2.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN
        
    Set PiCBuFFeR = DD.CreateSurfaceFromFile("SpIN.bmp", ddsd2)
    CreateLookUpTable
    
    Set ddclipper = DD.CreateClipper(0)
    ddclipper.SetHWnd picbox.hWnd
    Primary.SetClipper ddclipper
        
bInit = True
brunning = True
bLt
End Sub
 
Sub EndiT()
    DD.RestoreDisplayMode
    brunning = False
    End
End Sub
 
Private Sub Form_Resize()
    picbox.Height = Me.ScaleHeight
    picbox.Width = Me.ScaleWidth
    Do While brunning = True
        DoEvents
        bLt
        DoEvents
    Loop
End Sub
 
Sub bLt()
    Dim ddrval As Long
    Dim r1 As RECT
    Dim r2 As RECT
    Call DX.GetWindowRect(picbox.hWnd, r1)
 
    r2.Top = Frame(CurFrame).Top
    r2.Left = Frame(CurFrame).Left
    r2.Bottom = r2.Top + 31
    r2.Right = r2.Left + 31
    
    If DX.TickCount >= LastTimeDrawn + Delaytime Then
        LastTimeDrawn = DX.TickCount
 
        If Dir_up = True Then
            CurFrame = CurFrame + 1
            If CurFrame = 5 Then
 
                CurFrame = 0
                Dir_up = True
            End If
        Else
            CurFrame = CurFrame - 1
            If CurFrame = -1 Then
                CurFrame = 0
                Dir_up = True
            End If
        End If
    End If
    DoEvents
    ddrval = Primary.bLt(r1, PiCBuFFeR, r2, DDBLT_WAIT)
End Sub
 
Sub CreateLookUpTable()
    Frame(0).Top = 0: Frame(0).Left = 0
    Frame(1).Top = 0: Frame(1).Left = 31
    Frame(2).Top = 0: Frame(2).Left = 62
    Frame(3).Top = 0: Frame(3).Left = 93
    Frame(4).Top = 0: Frame(4).Left = 124
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
    EndiT
End Sub
 
Private Sub Picbox_Paint()
    DD.RestoreAllSurfaces
    Init
    bLt
End Sub

[Sonikku`]

I thought Brunning = False wuld stop the loop and End the App. I was wrong, heres FiLE-

[AtonalPanic]

#1) Please don't post executables, how can we help you without the code? Even if the code was posted before, executables are likely not to be opened by any user because of trojans and other virus types of files.
#2) This is very easy to fix, just add END after you set bRunning=false. Or it could be that you never terminated the surfaces, so try that too.

[Sonikku`]

Thats in the code I already have, when Event Query_unload occurs goto Sub EndiT(), There I tell it brunning = False which should stop the loop allowing it to END, but it doesnt!? WeirD~

[Sastraxi]

You know something's wrong with your code when you're spawning a new instance of DirectX with every paint event...

[Sonikku`]

OH~ It keeps repeating the Init sequence. I guess thats why its such a resource HoG.

[Machaira]

Originally posted by AtonalPanic
#2) This is very easy to fix, just add END after you set bRunning=false. Or it could be that you never terminated the surfaces, so try that too.

NEVER, repeat NEVER use the End statement to stop your program under normal conditions. Destroy all objects you've created and unload all forms.

[scr0p]

but how`-`

[Machaira]

More than likely this is your problem:

Private Sub Picbox_Paint()
    DD.RestoreAllSurfaces
    Init
    bLt
End Sub

You shouldn't need any of this.

Also, you should be able to replace the End statement with Unload Me.