Imports Microsoft.DirectX
Imports Microsoft.DirectX.Direct3D
Imports Microsoft.DirectX.DirectInput

Public Class frmSample

    Private myDevice As Device = Nothing
    Private vertexBuffer As VertexBuffer = Nothing

    Private Sub frmSample_Resize(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Resize
        Render()
    End Sub

    Public Function InitializeGraphics() As Boolean
        Try
            Dim presentParams As New PresentParameters
            presentParams.Windowed = True
            presentParams.SwapEffect = SwapEffect.Discard
            'Создание device с параметрами, задаваемыми presentParams.
            myDevice = New Device( 0 , DeviceType.Reference, Me, CreateFlags.SoftwareVertexProcessing, presentParams)
            AddHandler myDevice.DeviceReset, AddressOf Me.OnResetDevice
            Me.OnCreateDevice(myDevice, Nothing)
            Me.OnResetDevice(myDevice, Nothing)
            Return True
            'Если неудача, то возврящаем False.
        Catch e As DirectXException
            Return False
        End Try
    End Function

    Public Sub OnCreateVertexBuffer(ByVal sender As Object, ByVal e As EventArgs)
        Dim vb As VertexBuffer = CType(sender, VertexBuffer)
        Dim verts As CustomVertex.PositionColored() = CType(vb.Lock( 0 ,  0 ), CustomVertex.PositionColored())
        'Задаем координаты и цвета вершин.
        verts( 0 ) = New CustomVertex.PositionColored(- 1 , - 1 ,  0 , Color.Green.ToArgb())
        verts( 1 ) = New CustomVertex.PositionColored( 1 , - 1 ,  0 , Color.Green.ToArgb())
        verts( 2 ) = New CustomVertex.PositionColored( 0 , Math.Sqrt( 3 ) -  1 ,  0 . 5 , Color.Green.ToArgb())
        vb.Unlock()
    End Sub
    Public Sub OnCreateDevice(ByVal sender As Object, ByVal e As EventArgs)
        Dim dev As Device = CType(sender, Device)
        'Создаем вершинный буфер из 3 вершин.
        vertexBuffer = New VertexBuffer(GetType(CustomVertex.PositionColored),  3 , dev,  0 , CustomVertex.PositionColored.Format, Pool.Default)
        AddHandler vertexBuffer.Created, AddressOf Me.OnCreateVertexBuffer
        Me.OnCreateVertexBuffer(vertexBuffer, Nothing)
    End Sub
    Public Sub OnResetDevice(ByVal sender As Object, ByVal e As EventArgs)
        Dim dev As Device = CType(sender, Device)
        ' Показываем два стороны треугольника.
        dev.RenderState.CullMode = Cull.None
        ' Отключаем световые эффекты.
        dev.RenderState.Lighting = False
    End Sub

    Public Sub Render()
        If myDevice Is Nothing Then
            Return
        End If
        'Устанавливаем цвет фона.
        myDevice.Clear(ClearFlags.Target, System.Drawing.Color.Bisque,  1 .0F,  0 )
        'Начинаем сцену.
        myDevice.BeginScene()
        ' Применяем матрицы преобразований
        SetupMatrices()
        'Тут будем добавлять код.
        myDevice.SetStreamSource( 0 , vertexBuffer,  0 )
        myDevice.VertexFormat = CustomVertex.PositionColored.Format
        DrawTrangle(- 2 ,  0 ,  0 )
        DrawTrangle( 2 ,  0 ,  0 )

        'Заканчиваем сцену.
        myDevice.EndScene()
        myDevice.Present()
    End Sub

    ' Установка матрицы преобразования.
    Private Sub SetupMatrices()
        ' Установка мировой матрицы.
        myDevice.Transform.World = Matrix.Translation( 0 ,  0 ,  1 )
        ' Установка матрицы вида.
        myDevice.Transform.View = Matrix.LookAtLH( _
                New Vector3( 0 .0F,  0 .0F, - 12 .0F), _
                New Vector3( 0 .0F,  0 .0F,  0 .0F), _
                New Vector3( 0 .0F,  1 .0F,  0 .0F))
        ' Установка матрицы проекции.
        myDevice.Transform.Projection = Matrix.PerspectiveFovLH(CSng(Math.PI) /  4 ,  1 .0F,  1 .0F,  100 .0F)
    End Sub
    Private Sub DrawTrangle(ByVal x As Integer, ByVal y As Integer, ByVal z As Integer)
        myDevice.Transform.World = Matrix.Translation(x, y, z)
        myDevice.DrawPrimitives(PrimitiveType.TriangleList,  0 ,  1 )
    End Sub
End Class