blt.frm

推箱子的游戏VB源代码.适合于有一定VB经验的人阅读参考

                    Else
                        'hit ground so add to map
                        map((blockx%(a%) - 300) \ 60, (blocky%(a%) - 5) \ 60) = blockcell%(a%)
                        blockmode%(a%) = 0 'stop falling
                        checkforgroup
                    End If
            End Select
        End If
    Next
    
    
    'place the character
    Select Case mode%
        Case 1, 2
        Case 3, 4 'fall
            anim% = anim% + 1
            If anim% > bcells%(mode%) Then anim% = 1
            If map((mapl% + 300) \ 60, (mapv% + 10) \ 60) = 0 And map((mapl% + 355) \ 60, (mapv% + 10) \ 60) = 0 Then
                mapv% = mapv% + 10
            Else
                If mode% = 3 Then mode% = 6 Else mode% = 8 'land
            End If
            If mapv% > 350 Then
                mapv% = 350
                If mode% = 3 Then mode% = 6 Else mode% = 8 'land
            End If
        Case 5, 7 'jump left or right
            anim% = anim% + 1
            If anim% > bcells%(mode%) Then
                If mode% = 5 Then mode% = 3 Else mode% = 4
                anim% = 1
            Else
                If anim% <= 15 Then 'on the way up
                    If mode% = 5 Then 'left
                        If map((mapl% + 300) \ 60, (mapv% - 60) \ 60) = 0 And map((mapl% + 355) \ 60, (mapv% - 60) \ 60) = 0 Then
                            mapv% = mapv% + byo%(mode%, anim%)
                            If mapv% < 1 Then mapv% = 1
                        Else
                            anim% = 15
                        End If
                        If map((mapl% + 300 + bxo%(mode%, anim%)) \ 60, mapv% \ 60) = 0 And map((mapl% + 300 + bxo%(mode%, anim%)) \ 60, (mapv% - 50) \ 60) = 0 Then
                            mapl% = mapl% + bxo%(mode%, anim%)
                        Else
                            mode% = 3: anim% = 1
                            If animshift% Then startmove 1
                        End If
                    Else 'right
                        If map((mapl% + 355) \ 60, (mapv% - 60) \ 60) = 0 And map((mapl% + 300) \ 60, (mapv% - 60) \ 60) = 0 Then
                            mapv% = mapv% + byo%(mode%, anim%)
                            If mapv% < 1 Then mapv% = 1
                        Else
                            anim% = 15
                        End If
                        If map((mapl% + 355 + bxo%(mode%, anim%)) \ 60, mapv% \ 60) = 0 And map((mapl% + 355 + bxo%(mode%, anim%)) \ 60, (mapv% - 50) \ 60) = 0 Then
                            mapl% = mapl% + bxo%(mode%, anim%)
                            If mapv% < 1 Then mapv% = 1
                        Else
                            mode% = 4: anim% = 1
                            If animshift% Then startmove 2
                        End If
                    End If
                    
                Else 'on the way down
                    If mode% = 5 Then 'left
                        If map((mapl% + 300) \ 60, (mapv% + 15) \ 60) = 0 And map((mapl% + 355) \ 60, (mapv% + 15) \ 60) = 0 Then
                            mapv% = mapv% + byo%(mode%, anim%)
                            If mapv% < 1 Then mapv% = 1
                        Else
                            mode% = 6: anim% = 1 'land
                        End If
                        If map((mapl% + 300 + bxo%(mode%, anim%)) \ 60, mapv% \ 60) = 0 And map((mapl% + 300 + bxo%(mode%, anim%)) \ 60, (mapv% - 50) \ 60) = 0 Then
                            mapl% = mapl% + bxo%(mode%, anim%)
                        Else
                            mode% = 3: anim% = 1 'fall
                            If animshift% Then startmove 1
                        End If
                    Else 'right
                        If map((mapl% + 355) \ 60, (mapv% + 15) \ 60) = 0 And map((mapl% + 300) \ 60, (mapv% + 15) \ 60) = 0 Then
                            mapv% = mapv% + byo%(mode%, anim%)
                            If mapv% < 1 Then mapv% = 1
                        Else
                            mode% = 4: anim% = 1 'fall
                        End If
                        If map((mapl% + 355 + bxo%(mode%, anim%)) \ 60, mapv% \ 60) = 0 And map((mapl% + 355 + bxo%(mode%, anim%)) \ 60, (mapv% - 50) \ 60) = 0 Then
                            mapl% = mapl% + bxo%(mode%, anim%)
                        Else
                            mode% = 4: anim% = 1 'fall
                            If animshift% Then startmove 2
                        End If
                    End If
                End If
            End If
        Case 9, 10 'shift blocks
            If anim% = 1 Then 'start pushing
                'make blocks moveable
                If mode% = 9 Then startmove 1 Else startmove 2
            End If
            anim% = anim% + 1
            If anim% > bcells%(mode%) Then
                anim% = 1
                If mode% = 9 Then mode% = 1 Else mode% = 2
            End If
        Case Else
            anim% = anim% + 1
            If anim% > bcells%(mode%) Then
                Select Case mode%
                    Case 6: mode% = 1 'land now walk left
                    Case 8: mode% = 2 'land now walk right
                    Case Else: mode% = 1
                End Select
                anim% = 1
            End If
    End Select
    
        
    sp% = bchar%(mode%, anim%)
    If sp% = 0 Then sp% = 1
    
    t.top = spny%(sp%)
    t.left = spnx%(sp%)
    t.bottom = spny%(sp%) + spnh%(sp%)
    t.Right = spnx%(sp%) + spnw%(sp%)
       
   ddsBack.BltFast 295 + spnox%(sp%), mapv% + spnoy%(sp%) + 10, aDDS, t, DDBLTFAST_SRCCOLORKEY Or DDBLTFAST_WAIT
    
    'If Err.Number <> 0 Then
        ' Just in case
    '    Stop
    'End If
    ' Flip the buffers
    Do
        ddsFront.Flip Nothing, 0
        If Err.Number = DDERR_SURFACELOST Then ddsFront.Restore
    Loop Until Err.Number = 0
        
End Sub

Private Sub Form_Unload(Cancel As Integer)

End Sub

Private Sub Timer1_Timer()
    Timer1.Enabled = 0

    'Render loop
    While Not blnend
        DrawNextFrame
        u = DoEvents
    Wend
    
    'clean up
    Set aDDS = Nothing
    Set tDDS = Nothing
    dd.FlipToGDISurface
    dd.RestoreDisplayMode
    dd.SetCooperativeLevel 0, DDSCL_NORMAL
    Set ddsBack = Nothing
    Set ddsFront = Nothing
    Set dd = Nothing
    ShowCursor 1
    
    Unload frmBlt

End Sub
Sub loadlevel(mapnum%)
Dim a%, b%, nfile%
mapv% = 0
mapl% = 0
mode% = 3
Open App.Path & "\map.dat" For Random As #1 Len = 2
nfile% = LOF(1) / 2
blockcount% = 0
For a% = 0 To 39
    For b% = 0 To 5
        Get #1, 1 + (a% + (b% * 40)) + (mapnum% - 1) * 2500, map(a%, b%)
        If map(a%, b%) > 3 Then blockcount% = blockcount% + 1
    Next
Next

Close #1
For a% = 1 To 30
    blockmode%(a%) = 0
Next
End Sub

Sub drawblock(cl%, ByVal xx%, ByVal yy%)
Dim a%, b%
Dim t As RECT
    
Select Case cl%
    Case 0
        t.top = -99
    Case 1:
        t.top = 0
        t.left = 0
        t.bottom = 75
        t.Right = 80
    Case 2:
        t.top = 0
        t.left = 80
        t.bottom = 75
        t.Right = 160
    Case 3:
        t.top = 0
        t.left = 160
        t.bottom = 75
        t.Right = 240
    Case 4:
        t.top = 75
        t.left = 0
        t.bottom = 150
        t.Right = 80
    Case 5:
        t.top = 75
        t.left = 80
        t.bottom = 150
        t.Right = 160
    Case 6:
        t.top = 75
        t.left = 160
        t.bottom = 150
        t.Right = 240
End Select
If t.top >= 0 Then
    If xx% < 0 Then
        t.left = t.left + Abs(xx%)
        xx% = 0
    End If
    If xx% > 560 Then
        t.Right = t.Right - (xx% - 560)
    End If
    If t.Right > t.left Then ddsBack.BltFast xx%, yy%, tDDS, t, DDBLTFAST_SRCCOLORKEY Or DDBLTFAST_WAIT
End If
End Sub
Sub startmove(initdir%)
Dim cbx%, cby%, a%
If initdir% = 1 Then cbx% = (mapl% + 290) \ 60 Else cbx% = (mapl% + 369) \ 60
cby% = (mapv% - 30) \ 60
If map(cbx%, cby%) > 3 Then 'moveable block
    If (initdir% = 1 And map%(cbx% - 1, cby%) = 0) Or (initdir% = 2 And map%(cbx% + 1, cby%) = 0) Then
        For a% = 1 To 30
            If blockmode%(a%) = 0 Then 'spare block
                blockx%(a%) = cbx% * 60 + 300
                blocky%(a%) = cby% * 60 + 60
                blockcell%(a%) = map(cbx%, cby%)
                If initdir% = 1 Then blockmode%(a%) = 1 Else blockmode%(a%) = 2
                Exit For
            End If
        Next
        map(cbx%, cby%) = 0 'remove block of map, as now is in motion
        'when the block stops, it will be readded to the map
    End If
End If

End Sub

Sub checkforgroup()
Dim a%, b%, cc%, ct%, flag%
For a% = 0 To 39
    ct% = 0: cc% = 0
    For b% = 0 To 5
        If map(a%, b%) > 3 Then
            If map(a%, b%) <> cc% Then ct% = 0
            cc% = map(a%, b%)
            ct% = ct% + 1
            If ct% = 3 Then
                map(a%, b%) = 0
                map(a%, b% - 1) = 0
                map(a%, b% - 2) = 0
                
                checkabove a%, b%
                checkabove a%, b% - 1
                checkabove a%, b% - 2
                
                flag% = True
                blockcount% = blockcount% - 3
                If blockcount% < 3 Then
                    level% = level% + 1
                    loadlevel level%
                End If
                Exit For
            End If
        Else
            ct% = 0
        End If
    Next
Next
If Not flag% Then
    For b% = 0 To 5
        ct% = 0: cc% = 0
        For a% = 0 To 39
            If map(a%, b%) > 3 Then
                If map(a%, b%) <> cc% Then ct% = 0
                cc% = map(a%, b%)
                ct% = ct% + 1
                If ct% = 3 Then
                    map(a%, b%) = 0
                    map(a% - 1, b%) = 0
                    map(a% - 2, b%) = 0
                
                    checkabove a%, b%
                    checkabove a% - 1, b%
                    checkabove a% - 2, b%
                    
                    flag% = True
                    blockcount% = blockcount% - 3
                    If blockcount% < 3 Then
                        level% = level% + 1
                        loadlevel level%
                    End If
                    Exit For
                End If
            Else
                ct% = 0
            End If
        Next
    Next
End If
End Sub
Sub checkabove(cbx%, ByVal cby%)
Dim b%
Do While cby% > 0
    cby% = cby% - 1
    If map%(cbx%, cby%) > 3 Then
        For b% = 1 To 30
            If blockmode%(b%) = 0 Then 'spare block
                blockx%(b%) = cbx% * 60 + 300
                blocky%(b%) = cby% * 60 + 60
                blockcell%(b%) = map(cbx%, cby%)
                map(cbx%, cby%) = 0
                blockmode%(b%) = 3 'fall
                Exit For
            End If
        Next
    Else
        Exit Do
    End If
Loop
End Sub