VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   5250
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6300
   LinkTopic       =   "Form1"
   ScaleHeight     =   5250
   ScaleWidth      =   6300
   StartUpPosition =   3  'Windows Default
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim bRunning As Boolean

Private Type CUSTOMVERTEX
    X As Single         'x in screen space.
    Y As Single         'y in screen space.
    z As Single         'normalized z.
    nx As Single
    ny As Single
    nz As Single
    color As Long       'vertex color.
End Type

Private Function MakeVector(X As Single, Y As Single, z As Single) As D3DVECTOR
    MakeVector.X = X
    MakeVector.Y = Y
    MakeVector.z = z
End Function
Private Sub Form_Click()
    bRunning = False
End Sub

Private Sub Form_Load()

    Dim Dx As DirectX8
    Dim D3D As Direct3D8
    Dim D3DDevice As Direct3DDevice8
    Dim DispMode As D3DDISPLAYMODE
    Dim D3DWindow As D3DPRESENT_PARAMETERS
    
Dim Triangle(0 To 7) As CUSTOMVERTEX
    
    Set Dx = New DirectX8
    Set D3D = Dx.Direct3DCreate()

    Dim matView As D3DMATRIX
    Dim matProj As D3DMATRIX

    Dim Light As D3DLIGHT8
    
    D3D.GetAdapterDisplayMode D3DADAPTER_DEFAULT, DispMode

    D3DWindow.Windowed = 1
    D3DWindow.SwapEffect = D3DSWAPEFFECT_COPY_VSYNC
    D3DWindow.BackBufferFormat = DispMode.Format

    D3DWindow.AutoDepthStencilFormat = D3DFMT_D16
    D3DWindow.EnableAutoDepthStencil = 1

    Set D3DDevice = D3D.CreateDevice(D3DADAPTER_DEFAULT, _
                         D3DDEVTYPE_HAL, hWnd, _
                         D3DCREATE_SOFTWARE_VERTEXPROCESSING, _
                         D3DWindow)
    
    D3DDevice.SetVertexShader D3DFVF_XYZ Or D3DFVF_NORMAL Or _
                            D3DFVF_DIFFUSE
    D3DDevice.SetRenderState D3DRS_LIGHTING, True

    D3DDevice.SetRenderState D3DRS_ZENABLE, True

    Me.Show
    
    With Triangle(0)
    .X = -2:    .Y = 2:    .z = 0
    .nx = 0:    .ny = 0:    .nz = 1
    .color = &HFF0000
    End With
    
    With Triangle(1)
    .X = -2:    .Y = -2:    .z = 0
    .nx = 0:    .ny = 0:    .nz = 1
    .color = &HFF0000
    End With
    
    With Triangle(2)
    .X = -1:    .Y = 1:    .z = 0
    .nx = 0:    .ny = 0:    .nz = 1
    .color = &HFF00
    End With

    With Triangle(3)
    .X = -1:    .Y = -1:    .z = 0
    .nx = 0:    .ny = 0:    .nz = 1
    .color = &HFF00
    End With
    
    With Triangle(4)
    .X = 1:    .Y = 1:    .z = 0
    .nx = 0:    .ny = 0:    .nz = 1
    .color = &HFF00
    End With
    
    With Triangle(5)
    .X = 1:    .Y = -1:    .z = 0
    .nx = 0:    .ny = 0:    .nz = 1
    .color = &HFF00
    End With
    
    With Triangle(6)
    .X = 2:    .Y = 2:    .z = -0
    .nx = 0:    .ny = 0:    .nz = 1
    .color = &HFF
    End With
    
    With Triangle(7)
    .X = 2:    .Y = -2:    .z = -0
    .nx = 0:    .ny = 0:    .nz = 1
    .color = &HFF
    End With

    D3DXMatrixLookAtLH matView, MakeVector(0, 5, 9), _
                MakeVector(0, 0, 0), MakeVector(0, 1, 0)
    D3DDevice.SetTransform D3DTS_VIEW, matView
    D3DXMatrixPerspectiveFovLH matProj, 3.1416 / 4, 1, 0.1, 500
    D3DDevice.SetTransform D3DTS_PROJECTION, matProj

    Light.Type = D3DLIGHT_POINT
    Light.Position = MakeVector(3, 5, 9)
    Light.diffuse.r = 1
    Light.diffuse.g = 1
    Light.diffuse.b = 1
    Light.Range = 100
    Light.Attenuation1 = 0.05

    D3DDevice.SetLight 0, Light
    D3DDevice.LightEnable 0, 1
    
    bRunning = True
    
    Do While bRunning
    D3DDevice.Clear 0, ByVal 0, _
                    D3DCLEAR_TARGET Or D3DCLEAR_ZBUFFER, _
                    &H0, 1#, 0
        
        D3DDevice.BeginScene

D3DDevice.DrawPrimitiveUP D3DPT_TRIANGLESTRIP, 6, _
               Triangle(0), Len(Triangle(0))
        
        D3DDevice.EndScene
    
        D3DDevice.Present ByVal 0, ByVal 0, 0, ByVal 0
        
        DoEvents
    Loop

    Set D3DDevice = Nothing
    Set D3D = Nothing
    Set Dx = Nothing

    Unload Me
End Sub