dxengine.vb

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

        Shared Function GetTile(ByVal sName As String) As Tile
            If Tiles.Count = 0 Then Return Nothing
            For i As Integer = 0 To Tiles.Count - 1
                If Tiles(i).name = sName Then Return CType(Tiles(i), Tile)
            Next
            Return Nothing
        End Function
        Shared Function GetTile(ByVal TilePos As Integer) As Tile
            If (Tiles.Count = 0) Or (Tiles.Count < TilePos) Then Return Nothing
            Return CType(Tiles(TilePos), Tile)
        End Function
        Shared Function RemoveTexture(ByVal sName As String) As Boolean
            If Tiles.Count = 0 Then Return True
            For i As Integer = Tiles.Count - 1 To 0 Step -1
                If Tiles(i).Name = sName Then
                    Tiles(i).Dispose()
                    Tiles.RemoveAt(i)
                    Return True
                End If
            Next
            Return True
        End Function
        Shared Function GetTexture(ByVal sFile As String) As Direct3D.Texture
            If Textures.Count = 0 Then Return Nothing
            For Each ea As TextureData In Textures
                If ea.File = sFile Then Return ea.Texture
            Next
            Return Nothing
        End Function
        Shared Function GetTexture(ByVal TexturePoolPos As Integer) As Direct3D.Texture
            If Textures.Count = 0 Then Return Nothing
            If TexturePoolPos = -1 Then Return Nothing
            If Textures.Count - 1 < TexturePoolPos Then Return Nothing
            Return CType(Textures(TexturePoolPos).Texture, Direct3D.Texture)
        End Function
        Shared Function GetTexturePoolPos(ByVal sFile As String) As Integer
            If Textures.Count = 0 Then Return -1
            For i As Integer = 0 To Textures.Count - 1
                If Textures(i).File = sFile Then Return i
            Next
            Return -1
        End Function
        Shared Function AddTexture(ByVal sFile As String) As Boolean
            If Not (GetTexture(sFile) Is Nothing) Then Return True
            Dim tmp_TexData As New TextureData
            With tmp_TexData
                .File = sFile
                Try
                    .Texture = TextureLoader.FromFile(DD, sFile)
                Catch ex As Direct3DXException
                    If Not (.Texture Is Nothing) Then
                        .Texture.Dispose()
                        .Texture = Nothing
                    End If
                    tmp_TexData = Nothing
                End Try
            End With
            If Not (tmp_TexData.Texture Is Nothing) Then
                Textures.Add(tmp_TexData)
                Return True
            Else
                Return False
            End If
        End Function
#End Region

#Region "Scripting"
        Private WithVar As String = ""

        Private Class MsgPumpPiece
            Public Command As String
            Public Requeue As Boolean
            Public Threaded As Boolean
            Public ReturnVal As Object
        End Class

        Public Function ReadScriptFile(ByVal sFile As String) As Boolean
            Dim str As String()
            Dim sReader As IO.StreamReader = Nothing
            ReDim str(0)
            Try
                sReader = IO.File.OpenText(sFile)
                str(0) = sReader.ReadToEnd()
                sReader.Close()
                sReader = Nothing
            Catch ex As Exception
                If Not (sReader Is Nothing) Then
                    sReader.Close()
                    sReader = Nothing
                End If
                Return False
            End Try
            str = str(0).Split(New Char() {CType(vbNewLine, Char)})

            For i As Integer = 0 To str.GetUpperBound(0)
                If Not CType(ProccessCommand(str(i)), Boolean) Then
                    Dx.Dispose()
                    ExitCalled = True
                    Exit Function
                End If
            Next
        End Function

        Public Sub MsgPump()
            Do Until ExitCalled
                Application.DoEvents()
                Sleep(100)
            Loop
        End Sub

        Public Function ProccessCommand(ByVal sCommand As String) As Object
            If sCommand = "" Then Return True
            Dim coms As String()
            Dim ignorePoint As Integer = sCommand.IndexOf("'")
            If ignorePoint > -1 Then
                sCommand = sCommand.Substring(0, ignorePoint)
                If sCommand = "" Then Return True
            End If
            coms = sCommand.Split(New Char() {CType(" ", Char)})
            If coms(0).Substring(0, 1) = Chr(10) Then coms(0) = coms(0).Substring(1, coms(0).Length - 1)
            If coms(0) = "" Then Return True
            If coms(0).Substring(0, 1) = Chr(9) Then coms(0) = coms(0).Substring(1, coms(0).Length - 1)
            If coms(0).Substring(0, 1) = "'" Then Return True

            Select Case coms(0)
                Case "InitEngine"
                    Dim pram As New PresentParameters
                    RenderControl = New Form
                    CType(RenderControl, Form).FormBorderStyle = FormBorderStyle.None
                    CType(RenderControl, Form).ShowInTaskbar = True
                    RenderControl.Height = CType(coms(2), Integer)
                    RenderControl.Width = CType(coms(3), Integer)
                    With pram
                        .Windowed = CType(coms(1), Boolean)
                        If Not .Windowed Then
                            .BackBufferHeight = CType(coms(2), Integer)
                            .BackBufferWidth = CType(coms(3), Integer)
                            .BackBufferFormat = CType(IIf(CType(coms(4), Integer) = 32, Direct3D.Format.X8R8G8B8, Direct3D.Format.R5G6B5), Direct3D.Format)
                            .FullScreenRefreshRateInHz = CType(coms(5), Integer)
                        End If
                        .DeviceWindow = RenderControl
                        .BackBufferCount = 2
                        .EnableAutoDepthStencil = True
                        .AutoDepthStencilFormat = DepthFormat.D24S8
                        .PresentationInterval = PresentInterval.Immediate
                        .SwapEffect = SwapEffect.Discard
                    End With
                    Dx.SetParams(pram)
                    pram = Nothing
                    If Not InitD3D(RenderControl) Then Return False
                    InitDI(True, True)
                Case "StartEngine"
                    RenderControl.Show()
                    RenderControl.Focus()
                    Cursor.Hide()
                    Dx.Start()
                Case "StopEngine"
                    Cursor.Show()
                    Dx.Stop()
                Case "Shutdown"
                    Cursor.Show()
                    Dx.Stop()
                    Dx.Dispose()
                    Dx = Nothing
                Case "Quit"
                    ProccessCommand("Shutdown")
                    ExitCalled = True
                Case "SetMediaFolder"
                    Dx.MediaPath = CStr(coms(1))
                Case "CreateAnimation"
                    DxEngine.AddAnimTile(CStr(coms(1)))
                Case "CreateTile"
                    DxEngine.AddTile(CStr(coms(1)))
                Case "DeleteAnimation"
                    DxEngine.RemoveAnimTile(CType(coms(1), String))
                Case "AddFrame"
                    If WithVar <> "" Then
                        With DxEngine.GetAnimTile(WithVar)
                            .AddFrame(MediaPath & CType(coms(1), String), New Rectangle(CType(coms(2), Integer), CType(coms(3), Integer), CType(coms(4), Integer), CType(coms(5), Integer)))
                        End With
                    Else
                        With DxEngine.GetAnimTile(CType(coms(1), String))
                            .AddFrame(MediaPath & CType(coms(2), String), New Rectangle(CType(coms(3), Integer), CType(coms(4), Integer), CType(coms(5), Integer), CType(coms(6), Integer)))
                        End With
                    End If
                Case "SetPosition"
                    If WithVar <> "" Then
                        With DxEngine.GetAnimTile(WithVar)
                            .Position = New Vector3(CType(coms(1), Integer), CType(coms(2), Integer), CType(coms(3), Integer))
                        End With
                    Else
                        With DxEngine.GetAnimTile(CType(coms(1), String))
                            .Position = New Vector3(CType(coms(2), Integer), CType(coms(3), Integer), CType(coms(4), Integer))
                        End With
                    End If
                Case "SetAnimSpeed"
                    If WithVar <> "" Then
                        With DxEngine.GetAnimTile(WithVar)
                            .AnimSpeed = CType(coms(1), Single)
                        End With
                    Else
                        With DxEngine.GetAnimTile(CType(coms(1), String))
                            .AnimSpeed = CType(coms(2), Single)
                        End With
                    End If
                Case "SetCurrentFrame"
                    If WithVar <> "" Then
                        With DxEngine.GetAnimTile(WithVar)
                            .CurrentFrame = CType(coms(1), Integer)
                        End With
                    Else
                        With DxEngine.GetAnimTile(CType(coms(1), String))
                            .CurrentFrame = CType(coms(2), Integer)
                        End With
                    End If
                Case "With"
                    WithVar = CType(coms(1), String)
                Case "End"
                    Select Case CType(coms(1), String)
                        Case "With"
                            WithVar = ""
                        Case Else
                            Return False
                    End Select
                Case "Proccess"
                    ReadScriptFile(MediaPath & CType(coms(1), String) & ".dhe")
                Case "ClearAnimFrames"
                    If WithVar <> "" Then
                        With DxEngine.GetAnimTile(WithVar)
                            .ClearFrames(CType(coms(1), Boolean))
                        End With
                    Else
                        With DxEngine.GetAnimTile(CType(coms(1), String))
                            .ClearFrames(CType(coms(2), Boolean))
                        End With
                    End If
                Case "MovePosition"
                    If WithVar <> "" Then
                        With DxEngine.GetAnimTile(WithVar)
                            .Position.X += CType(coms(1), Integer)
                            .Position.Y += CType(coms(2), Integer)
                            .Position.Z += CType(coms(3), Integer)
                        End With
                    Else
                        With DxEngine.GetAnimTile(CType(coms(1), String))
                            .Position.X += CType(coms(2), Integer)
                            .Position.Y += CType(coms(3), Integer)
                            .Position.Z += CType(coms(4), Integer)
                        End With
                    End If
                Case "Paused"
                    Paused = CType(coms(1), Boolean)
                    If Paused Then
                        Select Case CStr(coms(2))
                            Case "Pause_Key"
                                UnPauseKey = Key.Pause
                            Case "Left_Arrow"
                                UnPauseKey = Key.LeftArrow
                            Case "Right_Arrow"
                                UnPauseKey = Key.RightArrow
                            Case "Up_Arrow"
                                UnPauseKey = Key.UpArrow
                            Case "Down_Arrow"
                                UnPauseKey = Key.DownArrow
                            Case "A_Key"
                                UnPauseKey = Key.A
                            Case "D_Key"
                                UnPauseKey = Key.D
                            Case "S_Key"
                                UnPauseKey = Key.S
                            Case "W_Key"
                                UnPauseKey = Key.W
                            Case "Esc_Key"
                                UnPauseKey = Key.Escape
                            Case "F1_Key"
                                UnPauseKey = Key.F1
                            Case "F2_Key"
                                UnPauseKey = Key.F2
                            Case "F3_Key"
                                UnPauseKey = Key.F3
                            Case "F4_Key"