dxengine.vb

vb.net 做的RPG游戏,不过还有点BUG没有调试好

                    With Textures(i)
                        If Not (.Texture Is Nothing) Then
                            .Texture.Dispose()
                        End If
                    End With
                    Textures(i) = Nothing
                    Textures.RemoveAt(i)
                Next
                Textures = Nothing
                For i As Integer = Tiles.Count - 1 To 0 Step -1
                    Tiles(i).Dispose()
                    Tiles(i) = Nothing
                    Tiles.RemoveAt(i)
                Next
                Tiles = Nothing
                If Not (DD Is Nothing) Then
                    DD.Dispose()
                    DD = Nothing
                End If
            End If
        End Sub
#End Region

#Region "Tiles and textures"
        Private Structure TextureData
            Dim File As String
            Dim [Texture] As Direct3D.Texture
        End Structure
        Friend Class Tile
            Public [Sprite] As Sprite
            Public [Texture] As String
            Public TexturePoolPos As Integer
            Public Center As Vector3
            Public Position As Vector3
            Public Color As Integer
            Public Visible As Boolean
            Public ScrRect As Rectangle
            Public Name As String

            Public Sub New()
                [Sprite] = New Sprite(DD)
                TexturePoolPos = -1
                Center = New Vector3(0, 0, 0)
                Position = New Vector3(0, 0, 0)
                Color = Drawing.Color.White.ToArgb()
                Visible = True
                ScrRect = Rectangle.Empty
            End Sub
            Public Function SetTexture(ByVal sFile As String) As Boolean
                TexturePoolPos = GetTexturePoolPos(sFile)
                If TexturePoolPos = -1 Then
                    If AddTexture(sFile) Then
                        TexturePoolPos = GetTexturePoolPos(sFile)
                        [Texture] = sFile
                        Return True
                    Else
                        Return False
                    End If
                Else
                    [Texture] = sFile
                    Return True
                End If
            End Function
            Public Sub Draw()
                [Sprite].Begin(SpriteFlags.AlphaBlend)
                [Sprite].Draw(GetTexture(TexturePoolPos), ScrRect, Center, Position, Color)
                [Sprite].End()
            End Sub
            Public Sub Dispose()
                [Sprite].Dispose()
                [Sprite] = Nothing
            End Sub
        End Class
        Friend Class AnimatedTile
            Public Class AnimData
                Public Sub New()
                    TexturePoolPos = -1
                    ScrRect = Rectangle.Empty
                End Sub

                Public [Texture] As String
                Public TexturePoolPos As Integer
                Public ScrRect As Rectangle
            End Class
            Public [Sprite] As Sprite
            Public Center As Vector3
            Public Position As Vector3
            Public Color As Integer
            Public Visible As Boolean
            Public Name As String
            Public Frames As ArrayList
            Public CurrentFrame As Integer
            Public AnimSpeed As Single
            Public AnimCurrent As Single

            Public Sub Update(ByVal eTime As Single)
                If Frames.Count = 1 Then
                    CurrentFrame = 0
                    Exit Sub
                End If
                AnimCurrent = AnimCurrent + eTime
                If AnimCurrent >= AnimSpeed Then
                    CurrentFrame += CInt((AnimCurrent / AnimSpeed))
                    AnimCurrent -= (AnimCurrent / AnimSpeed) * AnimSpeed
                    If CurrentFrame > Frames.Count - 1 Then
                        CurrentFrame -= (CurrentFrame \ (Frames.Count)) * (Frames.Count)
                    End If
                End If
            End Sub
            Public Sub New()
                [Sprite] = New Sprite(DD)
                Center = New Vector3(0, 0, 0)
                Position = New Vector3(0, 0, 0)
                Color = Drawing.Color.White.ToArgb()
                Visible = True
                Frames = New ArrayList
                CurrentFrame = -1
                AnimSpeed = 33
            End Sub
            Public Function SetTexture(ByVal Frame As Integer, ByVal sFile As String) As Boolean
                If Frames.Count = 0 Then Return False
                If Frames.Count < Frame Then Return False

                With CType(Frames(Frame), AnimData)
                    .TexturePoolPos = GetTexturePoolPos(sFile)
                    If .TexturePoolPos = -1 Then
                        If AddTexture(sFile) Then
                            .TexturePoolPos = GetTexturePoolPos(sFile)
                            .[Texture] = sFile
                            Return True
                        Else
                            Return False
                        End If
                    Else
                        .[Texture] = sFile
                        Return True
                    End If
                End With
            End Function
            Public Sub Draw()
                If CurrentFrame < 0 Then Exit Sub
                [Sprite].Begin(SpriteFlags.AlphaBlend)
                [Sprite].Draw(CType(GetTexture(Frames((CurrentFrame)).TexturePoolPos), Direct3D.Texture), CType(Frames(CurrentFrame).ScrRect, Rectangle), Center, Position, Color)
                [Sprite].End()
            End Sub
            Public Sub Dispose()
                [Sprite].Dispose()
                [Sprite] = Nothing
            End Sub
            Public Function AddFrame(ByVal sFile As String, ByVal Rect As Rectangle) As Integer
                Dim tmp As New AnimData
                tmp.ScrRect = Rect
                tmp.Texture = sFile
                Dim pos As Integer = Frames.Add(tmp)
                SetTexture(pos, sFile)
                tmp = Nothing
                Return pos
            End Function
            Public Sub ClearFrames(ByVal Whipe As Boolean)
                Frames.Clear()
                If Whipe Then
                    Center = New Vector3(0, 0, 0)
                    Position = New Vector3(0, 0, 0)
                    CurrentFrame = 0
                    AnimSpeed = 0.1
                    AnimCurrent = 0
                End If
            End Sub
        End Class

        Shared Function AddTile(ByVal sTile As Tile) As String
            If sTile.Name = "" Then sTile.Name = Guid.NewGuid.ToString
            Tiles.Add(sTile)
            Return sTile.Name
        End Function
        Shared Function AddTile(ByVal sName As String) As String
            Dim tTile As New Tile
            tTile.Name = sName
            Tiles.Add(tTile)
            tTile = Nothing
            Return sName
        End Function
        Shared Function AddTile(ByVal sFile As String, ByVal sRect As Rectangle) As String
            Dim sTile As New Tile()
            Dim rName As String
            With sTile
                rName = Guid.NewGuid.ToString
                .Name = rName
                .SetTexture(sFile)
                .ScrRect = sRect
            End With
            Tiles.Add(sTile)
            sTile = Nothing
            Return rName
        End Function
        Shared Function AddTile(ByVal Position As Vector3, ByVal Visible As Boolean, ByVal Color As Integer, ByVal Center As Vector3, ByVal sFile As String, ByVal sRect As Rectangle) As String
            Dim sTile As New Tile()
            Dim rName As String
            With sTile
                rName = Guid.NewGuid.ToString
                .Name = rName
                .SetTexture(sFile)
                .ScrRect = sRect
                .Center = Center
                .Position = Position
                .Color = Color
                .Visible = Visible
            End With
            Tiles.Add(sTile)
            sTile = Nothing
            Return rName
        End Function
        Shared Function AddAnimTile(ByVal sAnimTile As AnimatedTile) As String
            If sAnimTile.Name = "" Then sAnimTile.Name = Guid.NewGuid.ToString
            AnimTiles.Add(sAnimTile)
            Return sAnimTile.Name
        End Function
        Shared Function AddAnimTile() As String
            Dim sAnimTile As New AnimatedTile()
            Dim rName As String
            With sAnimTile
                rName = Guid.NewGuid.ToString
                .Name = rName
            End With
            AnimTiles.Add(sAnimTile)
            sAnimTile = Nothing
            Return rName
        End Function
        Shared Function AddAnimTile(ByVal sName As String) As String
            Dim sAnimTile As New AnimatedTile()
            With sAnimTile
                .Name = sName
            End With
            AnimTiles.Add(sAnimTile)
            sAnimTile = Nothing
            Return sName
        End Function
        Shared Function AddAnimTile(ByVal Position As Vector3, ByVal Visible As Boolean, ByVal Color As Integer, ByVal Center As Vector3) As String
            Dim sAnimTile As New AnimatedTile()
            Dim rName As String
            With sAnimTile
                rName = Guid.NewGuid.ToString
                .Name = rName
                .Center = Center
                .Position = Position
                .Color = Color
                .Visible = Visible
            End With
            AnimTiles.Add(sAnimTile)
            sAnimTile = Nothing
            Return rName
        End Function
        Shared Function GetAnimTile(ByVal sName As String) As AnimatedTile
            If AnimTiles.Count = 0 Then Return Nothing
            For i As Integer = 0 To AnimTiles.Count - 1
                If AnimTiles(i).name = sName Then Return CType(AnimTiles(i), AnimatedTile)
            Next
            Return Nothing
        End Function
        Shared Function GetAnimTile(ByVal TilePos As Integer) As AnimatedTile
            If (AnimTiles.Count = 0) Or (AnimTiles.Count < TilePos) Then Return Nothing
            Return CType(AnimTiles(TilePos), AnimatedTile)
        End Function
        Shared Sub RemoveTile(ByVal sName As String)
            If Tiles.Count = 0 Then Exit Sub
            For i As Integer = 0 To Tiles.Count - 1
                If Tiles(i).Name = sName Then
                    Tiles.RemoveAt(i)
                    Exit Sub
                End If
            Next
        End Sub
        Shared Sub RemoveAnimTile(ByVal sName As String)
            If AnimTiles.Count = 0 Then Exit Sub
            For i As Integer = 0 To AnimTiles.Count - 1
                If AnimTiles(i).Name = sName Then
                    AnimTiles.RemoveAt(i)
                    Exit Sub
                End If
            Next
        End Sub