В примере реализовано передвижение камеры(мож кто поможет с вращением) кнопками WASD
Создание кубиков происходит посредством конструктора обьектов
- Код: Выделить всё
Imports Microsoft.DirectX
Imports Microsoft.DirectX.Direct3D
Imports DI = Microsoft.DirectX.DirectInput
Public Class Form1
Public bkColor As Color = Color.Blue
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
CreateDevice(1280, 800, 32, Me.Handle, False)
'Убрать артифакты
Me.SetStyle(ControlStyles.AllPaintingInWmPaint Or ControlStyles.Opaque, True)
Kbd = New DI.Device(DI.SystemGuid.Keyboard)
Mou = New DI.Device(DI.SystemGuid.Mouse)
Kbd.SetCooperativeLevel(Me, DI.CooperativeLevelFlags.Background Or DI.CooperativeLevelFlags.NonExclusive)
Mou.SetCooperativeLevel(Me, DI.CooperativeLevelFlags.Background Or DI.CooperativeLevelFlags.NonExclusive)
Kbd.Acquire()
Mou.Acquire()
Me.Invalidate()
End Sub
Private Sub Form1_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint
Device.Clear(ClearFlags.Target Or ClearFlags.ZBuffer, bkColor, 1, 0)
Device.BeginScene()
defaultSetting()
ProcessInputState()
Device.Transform.View = Matrix.LookAtLH(New Vector3(AngleX, AngleY, AngleZ - 30), New Vector3(AngleX, AngleY, AngleZ), New Vector3(0, 1, 0))
'Device.Transform.View = Matrix.Multiply(
CreateBox(1, 1, 1, 1, 13, -1, 0, 7, 5)
CreateBox(1, 1, 1, 1, -5, -1, 0, -9, 5)
CrateBox(1, 1, 1, 1, 5, -1, 0, 6, 5)
CreateBox(1, 1, 1, 1, 4, -1, 1, 4, 5)
CreateBox(1, 0.2, 50, 0.2, 0, 0, 0, 0, 0)
CreateBox(1, 50, 0.2, 0.2, 0, 0, 0, 0, 0)
CreateBox(1, 0.2, 0.2, 50, 0, 0, 0, 0, 0)
Device.EndScene()
Device.Present()
Me.Invalidate()
End Sub
Private Sub Form1_Resize(ByVal sender As Object, ByVal e As System.EventArgs) Handles MyBase.Resize
'If Not (Device Is Nothing Or Me.WindowState = FormWindowState.Minimized) Then
' resetDevice()
'End If
End Sub
End Class
В модуле:
- Код: Выделить всё
Imports Microsoft.DirectX
Imports Microsoft.DirectX.Direct3D
Imports DI = Microsoft.DirectX.DirectInput
Module Module1
Public Device As Microsoft.DirectX.Direct3D.Device
Dim DeviceSetting As New PresentParameters
Public AngleX, AngleZ, AngleY As Double '
'Structure Item
' 'contain mesh and material for an object
'Public mesh As Mesh
' Public numX As Integer
' Public tex() As Texture
' Public mat() As Material
'End Structure
Public Kbd, Mou As DI.Device
'Set Up DirectInput Keyboard Device...
Public Box As Mesh = Nothing
Public tempmatrix As Matrix
Public GameOver As Boolean = False
Dim texture As Texture
Sub CreateBox(ByVal index As Short, ByVal x As Double, ByVal y As Double, ByVal z As Double, ByVal cx As Double, ByVal cy As Double, ByVal cz As Double, ByVal AngX As Double, ByVal AngY As Double)
'Dim t As Item = Nothing
'Dim mesh As Mesh = Nothing
Box = Mesh.Box(Device, x, y, z)
tempmatrix = New Matrix
tempmatrix = Matrix.Scaling(1, 1, 1)
tempmatrix.Multiply(Matrix.RotationY(AngY))
tempmatrix.Multiply(Matrix.RotationX(AngX))
tempmatrix.Multiply(Matrix.Translation(cx, cy, cz))
Device.Transform.World = tempmatrix
'Device.SetTexture(0, Nothing)
'For i = 0 To t.numX
' Device.VertexFormat = CustomVertex.PositionNormalTextured.Format
Device.SetTexture(0, texture)
Box.DrawSubset(0)
'Next
End Sub
Sub CreateDevice(ByVal width As Integer, ByVal heigth As Integer, ByVal bpp As Integer, ByVal fhWnd As System.IntPtr, ByVal windowed As Boolean)
'screen description
DeviceSetting.BackBufferCount = 1 'backbuffer number
DeviceSetting.AutoDepthStencilFormat = DepthFormat.D16 'Z/Stencil buffer formats
DeviceSetting.EnableAutoDepthStencil = True 'active Z/Stencil buffer
DeviceSetting.DeviceWindowHandle = fhWnd 'Хендл окна
DeviceSetting.SwapEffect = SwapEffect.Discard 'Тип отрисовки(Cопинг связка)
If windowed Then
DeviceSetting.Windowed = True 'Для оконного режима
Else
DeviceSetting.Windowed = False 'Установки для полного экрана
DeviceSetting.BackBufferWidth = width
DeviceSetting.BackBufferHeight = heigth
If bpp = 16 Then DeviceSetting.BackBufferFormat = Format.R5G6B5 'backbuffer format at 16Bit
If bpp = 32 Then DeviceSetting.BackBufferFormat = Format.X8R8G8B8 'backbuffer format at 32Bit
End If
DeviceSetting.PresentationInterval = PresentInterval.Immediate 'Тип представления
'create device
Device = New Device(0, DeviceType.Hardware, fhWnd, CreateFlags.HardwareVertexProcessing, DeviceSetting)
'device = New Device(0, DeviceType.Software, fhWnd, CreateFlags.SoftwareVertexProcessing, deviceSetting)
End Sub
'must be executed when form is resized
Sub resetDevice()
''you must putting them to zero to permit directX to change backbuffer size
'DeviceSetting.BackBufferHeight = 0
'DeviceSetting.BackBufferWidth = 0
'Device.Reset()
End Sub
Sub defaultSetting()
Device.RenderState.ZBufferEnable = True 'Z buffer on
Device.RenderState.Lighting = False 'lights off
Device.RenderState.ShadeMode = ShadeMode.Gouraud 'gouraud mode
'Device.RenderState.AntiAliasedLineEnable = True
'texture = createTexture(Application.StartupPath + "\texture0.bmp", Color.Tan.ToArgb)
Device.Transform.World = Matrix.Identity
Device.Transform.View = Matrix.LookAtLH(New Vector3(0, 0, -30), New Vector3(0, 0, 0), New Vector3(0, 1, 0))
device.Transform.Projection = Matrix.PerspectiveFovLH(CSng(Math.PI / 3), CSng(4 / 3), 1, 2000)
End Sub
Public Sub ClearAll()
'Mou.Dispose()
' ''Kbd.Unacquire()
'Kbd.Dispose()
'DeviceSetting = Nothing
' DI = Nothing
'Kbd = Nothing
Device.Clear(ClearFlags.Target Or ClearFlags.ZBuffer, Color.Black, 10, 0)
Device.Dispose()
Device = Nothing
End
End Sub
Sub ProcessInputState()
Dim K As DI.Key
Dim State As MouseState = Mou.CurrentMouseState
Dim ButtonStatus As Byte() = State.GetMouseButtons()
For Each K In Kbd.GetPressedKeys()
If K = DI.Key.W Then
AngleZ += 0.5
End If
If K = DI.Key.S Then
AngleZ -= 0.5
End If
If K = DI.Key.A Then
AngleX -= 0.5
End If
If K = DI.Key.D Then
AngleX += 0.5
End If
If K = DI.Key.Up Then
AngleZ += 0.5
End If
If K = DI.Key.Down Then
AngleZ -= 0.5
End If
If K = DI.Key.Left Then
AngleX -= 0.5
End If
If K = DI.Key.Right Then
AngleX += 0.5
End If
If K = DI.Key.Escape Then
ClearAll
End If
Next K
If ButtonStatus(0) <> 0 Then
'AngleX += State.X * Math.Sin(State.X)
AngleY -= State.Y + 0.1
'AngleX = AngleX + Math.Cos(State.X)
'AngleY = AngleY + Math.Sin(State.Y)
Device.Transform.World = Matrix.RotationY(AngleY)
Else
End If
If ButtonStatus(1) <> 0 Then
Else
End If
End Sub
'create texture from file
'Function createTexture(ByVal filesrc As String, Optional ByVal colorKey As Integer = 0) As Texture
' Return TextureLoader.FromFile(Device, filesrc, 0, 0, 0, 0, Format.Unknown, Pool.Managed, Filter.Box, Filter.Box, colorKey)
'End Function
End Module