frmtile.frm

在游戏中场景的移动

VERSION 5.00
Begin VB.Form frmTile 
   AutoRedraw      =   -1  'True
   BorderStyle     =   0  'None
   Caption         =   "Tile Sample"
   ClientHeight    =   4800
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   11040
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   320
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   736
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  'CenterScreen
End
Attribute VB_Name = "frmTile"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit


Dim TileArray() As Long
Dim TileDesc(7) As Tile

Dim TileDC As Long
Dim ThingDC As Long
Dim ThingMask As Long

Dim X As Long   'Global X position of the sprite
Dim Y As Long   'Global Y Position of the sprite


Const ThingSpeed As Long = 2
Const MinimumSpeed As Long = 1
Dim TempThingSpeed As Single

Dim CurrentTileX As Long
Dim CurrentTileY As Long


Const FormWidth As Long = 320
Const FormHeight As Long = 320

Const TotalTilesX As Long = 10
Const TotalTilesY As Long = 10

Const TileWidth As Long = 32
Const TileHeight As Long = 32

Const ThingWidth As Long = 16
Const ThingHeight As Long = 16


Private Sub Form_Load()
Dim AppPath As String

'Set the form's size

Me.Width = FormWidth * Screen.TwipsPerPixelX
Me.Height = FormHeight * Screen.TwipsPerPixelY

AppPath = App.Path
'Check for right path
If Right$(AppPath, 1) <> "\" Then
    AppPath = AppPath & "\"
End If

'Read the tile into memory
ReadTileFile AppPath & "tile.txt", TileArray

'Define the tiles
DefineTiles

'Set the graphics
TileDC = GenerateDC(AppPath & "tiles.bmp")
ThingDC = GenerateDC(AppPath & "thing.bmp")
ThingMask = GenerateDC(AppPath & "thingmask.bmp")

X = FormWidth
Y = FormHeight

RunMain

End Sub
'this procedure defines the tiles in the program, ie. the special abilities of the sprites
' the position on the source picture etc..
Private Sub DefineTiles()
Dim I As Integer, J As Integer

'Set the Y, X, Width and Height positions/definitions of the tiles
For I = 1 To 2
    For J = 1 To 4
        TileDesc((J - 1) + (I - 1) * 4).SourceX = (J - 1) * TileWidth
        TileDesc((J - 1) + (I - 1) * 4).SourceY = (I - 1) * TileHeight
        TileDesc((J - 1) + (I - 1) * 4).TileWidth = TileWidth
        TileDesc((J - 1) + (I - 1) * 4).TileHeight = TileHeight
    Next J
Next I

'Now for the special abilities
'the SpecialData member of the type is used to
'define the movement factor of the sprite, when it moves over the
'tile. If the factor is 0, then the tile can not be moved into

TileDesc(0).SpecialData = 0 'no movement

TileDesc(1).SpecialData = 1 'no penalties for movement

TileDesc(2).SpecialData = 1.5 'going down

TileDesc(3).SpecialData = 4 'going down

TileDesc(4).SpecialData = 0.5 'not very  moveable

TileDesc(5).SpecialData = 2 'faster  movement

TileDesc(6).SpecialData = 0.1 'penalties for movement

TileDesc(7).SpecialData = 0.8 'penalties for movement


End Sub

'Draws the tiles on the form
Private Sub DrawTiles()
On Error Resume Next
Dim LowerX As Integer, LowerY As Integer
Dim UpperX As Integer, UpperY As Integer
Dim LowerXOff As Integer, LowerYOff As Integer
Dim J As Integer, I As Integer

'Calculate the off set, only if it is relevant
If X > FormWidth / 2 And X < FormWidth * 1.5 Then

    LowerXOff = X Mod TileWidth
    LowerX = Int((X / TileWidth)) - TotalTilesX / 2

ElseIf X >= FormWidth * 1.5 Then
        
    LowerX = TotalTilesX
        
End If


If Y > FormHeight / 2 And Y < FormHeight * 1.5 Then

    LowerYOff = Y Mod TileHeight
    LowerY = Int((Y / TileHeight)) - TotalTilesY / 2

ElseIf Y >= FormHeight * 1.5 Then
    
    LowerY = TotalTilesY

End If



'If LowerX > TotalTilesX Then LowerX = TotalTilesX
'If LowerY > TotalTilesY Then LowerY = TotalTilesY
    
UpperY = LowerY + 10
UpperX = LowerX + 10

For I = LowerY To UpperY
    For J = LowerX To UpperX
        BitBlt Me.hdc, (J - LowerX) * TileWidth - LowerXOff, (I - LowerY) * TileHeight - LowerYOff, TileWidth, TileHeight, _
                TileDC, TileDesc(TileArray(I, J)).SourceX, TileDesc(TileArray(I, J)).SourceY, vbSrcCopy
    
    Next J
Next I

End Sub

Private Sub RunMain()
Dim CurrentTick As Long
Dim LastTick As Long

Const TickDifference As Long = 10
Me.Show

Do
    If IsEscapePressed Then
        EndIt
        Exit Do
    End If
    
    CurrentTick = GetTickCount()
       
    If CurrentTick - LastTick > TickDifference Then
                
        AdjustForTiles
        UpdateKeys
        DrawTiles
        DrawThing
        Me.Refresh
        LastTick = CurrentTick
        
        DoEvents
    
    Else
        
        DoEvents
        Sleep 2
    
    End If
Loop

Unload Me
Set frmTile = Nothing

End Sub

Private Sub AdjustForTiles()


CurrentTileX = Int(X / TileWidth)
CurrentTileY = Int(Y / TileHeight)
'Calculate which tile the thing is on

TempThingSpeed = ThingSpeed * TileDesc(TileArray(CurrentTileY, CurrentTileX)).SpecialData

End Sub
Private Sub EndIt()

DeleteDC TileDC
DeleteDC ThingDC
ReleaseMask ThingMask

End Sub
Private Sub UpdateKeys()
Dim TempX As Long
Dim TempY As Long

TempX = X
TempY = Y

If CheckLeftKey Then
    X = X - Int(TempThingSpeed + 0.5) - MinimumSpeed
    
    If Int(X / TileWidth) <> CurrentTileX Then
        If TileDesc(TileArray(CurrentTileY, Int((X - ThingWidth * 0.5) / TileWidth))).SpecialData = 0 Then
            X = TempX
        End If
    End If
End If
    
    
If CheckRightKey Then
    X = X + Int(TempThingSpeed + 0.5) + MinimumSpeed
    
    If Int((X + ThingWidth) / TileWidth) <> CurrentTileX Then
        If TileDesc(TileArray(CurrentTileY, Int((X + ThingWidth) / TileWidth))).SpecialData = 0 Then
           X = TempX
        End If
    End If
End If

If CheckUPKey Then
    Y = Y - Int(TempThingSpeed + 0.5) - MinimumSpeed
    If Int(Y / TileHeight) <> CurrentTileY Then
        If CSng(TileDesc(TileArray(Int(Y / TileHeight), CurrentTileX)).SpecialData) = 0 Then
            Y = TempY
        End If
    End If
End If


If CheckDownKey Then
    Y = Y + Int(TempThingSpeed + 0.5) + MinimumSpeed
    If Int((Y + ThingHeight) / TileHeight) <> CurrentTileY Then
        If CSng(TileDesc(TileArray(Int((Y + ThingHeight) / TileHeight), CurrentTileX)).SpecialData) = 0 Then
            Y = TempY
        End If
    End If
End If

   
End Sub

Private Sub DrawThing()
Dim TempX As Long, TempY As Long

If X > FormWidth / 2 And X < FormWidth * 1.5 Then
    
    TempX = FormWidth / 2

ElseIf X < FormWidth / 2 Then
    
    TempX = X

Else
    
    TempX = FormWidth / 2 + ((FormWidth / 2) - (FormWidth * 2 - X))

End If


If Y > FormHeight / 2 And Y < FormHeight * 1.5 Then
    
    TempY = FormHeight / 2

ElseIf Y < FormHeight / 2 Then
    
    TempY = Y

Else
    
    TempY = FormHeight / 2 + ((FormHeight / 2) - (FormHeight * 2 - Y))

End If

BitBlt Me.hdc, TempX, TempY, ThingWidth, ThingHeight, ThingMask, 0, 0, vbSrcAnd
BitBlt Me.hdc, TempX, TempY, ThingWidth, ThingHeight, ThingDC, 0, 0, vbSrcPaint

End Sub