⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 engine.vb.svn-base

📁 MirUnleashed vb.net Module modMainServer Public WithEvents Socket As New WinsockServer Pub
💻 SVN-BASE
📖 第 1 页 / 共 2 页
字号:
'### Visual Basic.NET and Direct X9 Legend of MiR Project ###'
'### Mir Unleashed Client Engine Module ###'
'### http://www.lomcn.co.uk ###' '### Credits to TrueADM and DeathWish ###'

'The Mir Unleashed Engine.
'Finding targets etc. Game/Login Scene, Loops and fonts etc.

Imports Microsoft.DirectX
Imports Microsoft.DirectX.Direct3D
Imports System
Imports System.Windows.Forms
Imports System.Drawing
Imports System.Drawing.Text
Imports System.Drawing.Imaging

Module Engine

    Public Function MakeInt16(ByVal LoByte As Byte, ByVal HiByte As Byte) As Int64
        Dim Output As Int64
        Output = ((HiByte * &H100) + LoByte)
        MakeInt16 = Output
    End Function
    Public Function MakeInt32(ByVal LoWord As Integer, ByVal HiWord As Integer) As Int32
        Return (HiWord * &H10000) Or (LoWord And &HFFFF&)
    End Function

    Public Function Shift(ByVal lValue As Long, ByVal lBits As Long, ByVal lDir As BitShiftDir) As Long
        If lDir = BitShiftDir.Left Then Shift = lValue * (2 ^ lBits)
        If lDir = BitShiftDir.Right Then Shift = lValue \ (2 ^ lBits)
    End Function
    Public Function LShift(ByVal lValue As Long, ByVal lBits As Long) As Long
        LShift = Shift(lValue, lBits, BitShiftDir.Left)
    End Function
    Public Function RShift(ByVal lValue As Long, ByVal lBits As Long) As Long
        RShift = Shift(lValue, lBits, BitShiftDir.Right)
    End Function
    Public Enum BitShiftDir
        Left = 1
        Right = 2
    End Enum

    Public Sub LoadPalette()
        Dim bmp As Bitmap = New Bitmap(My.Application.Info.DirectoryPath & "\Palette.bmp")
        Dim TempPal As System.Drawing.Imaging.ColorPalette

        TempPal = bmp.Palette

        Dim I As Short
        For I = 0 To 255
            CustomPal(I).Blue = TempPal.Entries(I).B
            CustomPal(I).Green = TempPal.Entries(I).G
            CustomPal(I).Red = TempPal.Entries(I).R
        Next I

    End Sub

    Public Sub FindTarget()

        CursorX = Cursor.Position.X - WindowX
        CursorY = Cursor.Position.Y - WindowY

        SelectCordY = (((CursorY / 32)) + 0.1 + (Actor.Y) - 10) + 2
        SelectCordX = (((CursorX / 48)) - 1.1 + (Actor.X) - 10) + 3

    End Sub

    Public Sub SetBlend(ByVal Fade As Single)
        If Fade = 1 Then
            D3D.RenderState.AlphaBlendEnable = True
            D3D.RenderState.SourceBlend = 5
            D3D.RenderState.AlphaSourceBlend = 2
            D3D.RenderState.DestinationBlend = 6
            D3D.RenderState.BlendFactor = Color.FromArgb(255, 255, 255, 255)
        Else
            D3D.RenderState.AlphaBlendEnable = True
            D3D.RenderState.SourceBlend = Blend.BlendFactor
            D3D.RenderState.DestinationBlend = Blend.InvBlendFactor
            D3D.RenderState.AlphaSourceBlend = Blend.SourceAlpha
            D3D.RenderState.BlendFactor = Color.FromArgb(255 * Fade, 255 * Fade, 255 * Fade, 255 * Fade)
        End If
    End Sub

    Public Sub DrawBox(ByVal X1 As Integer, ByVal X2 As Integer, ByVal Y1 As Integer, ByVal Y2 As Integer, ByVal Width As Single, ByVal Colour As System.Drawing.Color)

        Dim aLineVectors(1) As Microsoft.DirectX.Vector2

        TempLine.Width = Width

        TempBox.Begin()

        aLineVectors(0).X = X1
        aLineVectors(0).Y = Y1

        aLineVectors(1).X = X2
        aLineVectors(1).Y = Y1

        TempLine.Draw(aLineVectors, Colour)

        aLineVectors(0).X = X1
        aLineVectors(0).Y = Y2

        aLineVectors(1).X = X2
        aLineVectors(1).Y = Y2

        TempLine.Draw(aLineVectors, Colour)

        aLineVectors(0).X = X1
        aLineVectors(0).Y = Y1

        aLineVectors(1).X = X1
        aLineVectors(1).Y = Y2

        TempLine.Draw(aLineVectors, Colour)

        aLineVectors(0).X = X2
        aLineVectors(0).Y = Y1

        aLineVectors(1).X = X2
        aLineVectors(1).Y = Y2

        TempLine.Draw(aLineVectors, Colour)


        TempBox.End()

    End Sub


    Public Sub DrawLine(ByVal X1 As Integer, ByVal X2 As Integer, ByVal Y1 As Integer, ByVal Y2 As Integer, ByVal Width As Single, ByVal Colour As System.Drawing.Color)

        Dim aLineVectors(1) As Microsoft.DirectX.Vector2

        'Set the starting point of the line
        aLineVectors(0).X = X1
        aLineVectors(0).Y = Y1

        'Set the ending point of the line
        aLineVectors(1).X = X2
        aLineVectors(1).Y = Y2

        'Give the line it's width (there's that width you were needing....)  
        TempLine.Width = Width

        'Render the line
        TempLine.Begin()
        TempLine.Draw(aLineVectors, Colour)
        TempLine.End()

    End Sub

    Public Sub GameLoop()

        TempLine = New Microsoft.DirectX.Direct3D.Line(D3D)
        TempBox = New Microsoft.DirectX.Direct3D.Line(D3D)

        LoadFonts()

        Do While (Running = True)
            FindTarget()
            CheckTimers()
            CheckMouseInput()
            LoadQueue()
            'CheckStackSound()

            If DeviceLost Then
                AttemptRecovery()
            End If

            If DeviceLost = False Then
                SceneBegin()
            End If

            If Scene = SceneType.GAME Then

                D3D.SetRenderTarget(0, AlphaSurface)

                If Actor.IsDead = False Or Actor.GhostForm = True Then
                    If Actor.GhostForm = True Then
                        FogColour = Color.FromArgb(0, 0, 250, 80)
                        D3D.Clear(ClearFlags.Target, Color.FromArgb(255, 0, 120, 240), 0, 0)
                    Else
                        If Actor.MapLight = 0 Then ' Night
                            FogColour = Color.White
                            D3D.Clear(ClearFlags.Target, Color.FromArgb(25, 25, 45), 0, 0)
                        ElseIf Actor.MapLight = 1 Then 'Being removed.
                            FogColour = Color.White
                            D3D.Clear(ClearFlags.Target, Color.FromArgb(255, 40, 40, 40), 0, 0)
                        ElseIf Actor.MapLight = 2 Then ' Sunset/Sunrise
                            FogColour = Color.FromArgb(255, 255, 150, 80)
                            D3D.Clear(ClearFlags.Target, Color.FromArgb(255, 50, 50, 50), 0, 0)
                        ElseIf Actor.MapLight = 3 Then ' Day Light
                            FogColour = Color.White
                            D3D.Clear(ClearFlags.Target, Color.White, 0, 0)
                        ElseIf Actor.MapLight = 4 Then ' Morning
                            FogColour = Color.FromArgb(255, 255, 150, 80)
                            D3D.Clear(ClearFlags.Target, Color.FromArgb(255, 50, 50, 50), 0, 0)
                        End If
                    End If
                Else
                    FogColour = Color.FromArgb(1, 100, 0, 0)
                    D3D.Clear(ClearFlags.Target, FogColour, 0, 0)
                End If

                GameSprite.Begin(SpriteFlags.DoNotSaveState)
                DrawFog()
                GameSprite.End()

            End If

            Application.DoEvents()
            System.Threading.Thread.Sleep(1)

        Loop
        Terminate()
    End Sub

    Public Sub SceneBegin()
        Dim TempX, TempY As Integer

        If Scene = SceneType.GAME Then

            D3D.SetRenderTarget(0, GameSurface)

            D3D.Clear(ClearFlags.Target, Color.Black, 0, 0)

            D3D.BeginScene()
            DrawGame()
            D3D.EndScene()

            DrawFogScene()

            GameSprite.Begin(SpriteFlags.AlphaBlend)
            'DrawGlow()
            'DrawMist()
            'DrawSnow()
            GameSprite.End()

            D3D.SetRenderTarget(0, MainSurface)

            D3D.BeginScene()

            DrawGameSurface()
            DrawGameGUI()
            D3D.EndScene()

            D3D.BeginScene()
            DrawTitle()
            D3D.EndScene()

        ElseIf Scene = SceneType.LOGIN Then

            D3D.BeginScene()
            DrawLoginScene()
            D3D.EndScene()

        End If

        Try
            D3D.Present()
        Catch e As DeviceLostException
            DeviceLost = True
        End Try

    End Sub

    Public Sub DrawGame()

        If Scene = SceneType.GAME Then
            DrawGameScene()
        End If

        If DateTime.Now.Ticks > FPSTick + 10000000 Then
            FPSShow = FPS
            FPS = 0
            FPSTick = DateTime.Now.Ticks
        Else
            FPS = FPS + 1
        End If

        Exit Sub
    End Sub

    Public Sub DrawMist()

        Dim TempX As Integer
        Dim TempY As Integer
        Dim I As Integer
        Dim FogTick As Long

        Dim BaseX As Single
        Dim BaseY As Single

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -