by Chamira Jayasinghe

wm oeka fï äðÜ iuÕ tl;= jkafka 4 jeks mdvu iuÕskqhs' fuu i;sfha isg wm fuu mdvï ud,dfõ kj me;slvl kj rih ú£ug ;uhs fï ierfikafka' äfrlaÜia fla;kh ms<sn|j uQ,sl wjfndaOhla oeka Tng ksiÕj wh;a ù we;s nj Tngu jegfykjd we;s' ^Tn äðÜ iuÕ uq, isgu /£ isáhd kï& fuys§ i|yka l< hq;= úfYaI lreK jkafka" Tn i;= oekqu Tnu .fõIKh lr ,nd.;a tlla ùuhs' ud isÿlf<a Tng uÕ fmkaùula muKs'   

Option Explicit

Private Type TLVERTEX

    X As Single

    Y As Single

    Z As Single

    RHW As Single

    Color As Long

    Specular As Long

    TU As Single

    TV As Single

End Type

Private Const COLOR_DEPTH_16_BIT As Long = D3DFMT_R5G6B5

Private Const COLOR_DEPTH_24_BIT As Long = D3DFMT_A8R8G8B8

Private Const COLOR_DEPTH_32_BIT As Long = D3DFMT_X8R8G8B8

Private Const FVF_TLVERTEX As Long = D3DFVF_XYZRHW Or D3DFVF_TEX1 Or D3DFVF_DIFFUSE Or D3DFVF_SPECULAR

Private DirectX8 As DirectX8

Private Direct3D As Direct3D8

Private Direct3D_Device As Direct3DDevice8

Private Fullscreen_Enabled As Boolean

Private Running As Boolean

Private Vertex_List(3) As TLVERTEX

Private Function Create_TLVertex(X As Single, Y As Single, Z As Single, RHW As Single, Color As Long, Specular As Long, TU As Single, TV As Single) As TLVERTEX

    Create_TLVertex.X = X

    Create_TLVertex.Y = Y

    Create_TLVertex.Z = Z

    Create_TLVertex.RHW = RHW

    Create_TLVertex.Color = Color

    Create_TLVertex.Specular = Specular

    Create_TLVertex.TU = TU

    Create_TLVertex.TV = TV

End Function

Private Sub Form_Activate()

    frmMain.Caption = "DirectX Tutorial"

    Dim Display_Mode As D3DDISPLAYMODE

    Dim Direct3D_Window As D3DPRESENT_PARAMETERS

    Set DirectX8 = New DirectX8

    Set Direct3D = DirectX8.Direct3DCreate()

    If Fullscreen_Enabled = True Then

        Display_Mode.Width = 800

        Display_Mode.Height = 600

        Display_Mode.Format = COLOR_DEPTH_16_BIT

        Direct3D_Window.Windowed = False

        Direct3D_Window.BackBufferCount = 1

        Direct3D_Window.BackBufferWidth = Display_Mode.Width

        Direct3D_Window.BackBufferHeight = Display_Mode.Height

        Direct3D_Window.hDeviceWindow = frmMain.hWnd

    Else

        Direct3D.GetAdapterDisplayMode D3DADAPTER_DEFAULT, Display_Mode

                                                                                                                                                'talking about your current screen resolution. ;)

        Direct3D_Window.Windowed = True

    End If

    Direct3D_Window.SwapEffect = D3DSWAPEFFECT_COPY_VSYNC

    Direct3D_Window.BackBufferFormat = Display_Mode.Format

        Set Direct3D_Device = Direct3D.CreateDevice(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, frmMain.hWnd, D3DCREATE_SOFTWARE_VERTEXPROCESSING, Direct3D_Window)

    Vertex_List(0) = Create_TLVertex(0, 0, 0, 1, D3DColorRGBA(255, 255, 255, 0), 0, 0, 0)

    Vertex_List(1) = Create_TLVertex(100, 0, 0, 1, D3DColorRGBA(255, 255, 255, 0), 0, 1, 0)

    Vertex_List(2) = Create_TLVertex(0, 100, 0, 1, D3DColorRGBA(255, 255, 255, 0), 0, 0, 1)

    Vertex_List(3) = Create_TLVertex(100, 100, 0, 1, D3DColorRGBA(255, 255, 255, 0), 0, 1, 1)

    Direct3D_Device.SetVertexShader FVF_TLVERTEX

    Running = True

    Do While Running = True

        DoEvents

        Direct3D_Device.Clear 0, ByVal 0, D3DCLEAR_TARGET, D3DColorRGBA(0, 0, 0, 0), 1#, 0

            Direct3D_Device.BeginScene

                Direct3D_Device.DrawPrimitiveUP D3DPT_TRIANGLESTRIP, 2, Vertex_List(0), Len(Vertex_List(0))

            Direct3D_Device.EndScene

        Direct3D_Device.Present ByVal 0, ByVal 0, 0, ByVal 0

    Loop

End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)

    If KeyCode = vbKeyEscape Then

        Running = False

        Set Direct3D_Device = Nothing

        Set Direct3D = Nothing

        Set DirectX8 = Nothing

        Unload Me

        End

    End If

End Sub

Private Sub Form_Load()

    If MsgBox("Click Yes to go to full screen (Recommended)", vbQuestion Or vbYesNo, "Options") = vbYes Then Fullscreen_Enabled = True

End Sub

Private Sub Form_Unload(Cancel As Integer)

    Running = False

    Set Direct3D_Device = Nothing

    Set Direct3D = Nothing

    Set DirectX8 = Nothing

    Unload Me

    End

End Sub

,nk i;sfha§ fuu fla;khkaf.a mQ¾K ú.%yhla iuÕska yuq fjuq'