📄 engine.vb.svn-base
字号:
'### 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 + -