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. rhw As Single 'normalized z rhw. color As Long 'vertex color. End Type 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 2) As CUSTOMVERTEX Set Dx = New DirectX8 Set D3D = Dx.Direct3DCreate() DispMode.Format = D3DFMT_X8R8G8B8 DispMode.Width = 640 DispMode.Height = 480 D3DWindow.SwapEffect = D3DSWAPEFFECT_FLIP D3DWindow.BackBufferCount = 1 '//1 backbuffer only D3DWindow.BackBufferFormat = DispMode.Format 'What we specified earlier D3DWindow.BackBufferWidth = 640 D3DWindow.BackBufferHeight = 480 D3DWindow.hDeviceWindow = hWnd Set D3DDevice = D3D.CreateDevice(D3DADAPTER_DEFAULT, _ D3DDEVTYPE_HAL, hWnd, _ D3DCREATE_SOFTWARE_VERTEXPROCESSING, _ D3DWindow) D3DDevice.SetVertexShader D3DFVF_XYZRHW Or D3DFVF_DIFFUSE D3DDevice.SetRenderState D3DRS_LIGHTING, False Me.Show Triangle(0).x = 0 Triangle(0).y = 0 Triangle(0).z = 0 Triangle(0).rhw = 1 Triangle(0).color = &HFF0000 Triangle(1).x = 100 Triangle(1).y = 0 Triangle(1).z = 0 Triangle(1).rhw = 1 Triangle(1).color = &HFF0000 Triangle(2).x = 0 Triangle(2).y = 100 Triangle(2).z = 0 Triangle(2).rhw = 1 Triangle(2).color = &HFF0000 bRunning = True Do While bRunning D3DDevice.Clear 0, ByVal 0, _ D3DCLEAR_TARGET, _ &HCCCCFF, 1#, 0 D3DDevice.BeginScene D3DDevice.DrawPrimitiveUP D3DPT_TRIANGLELIST, 1, _ 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