VERSION 5.00Begin VB.Form Form1    Caption         =   "Create Device"   ClientHeight    =   3195   ClientLeft      =   60   ClientTop       =   345   ClientWidth     =   4680   LinkTopic       =   "Form1"   ScaleHeight     =   3195   ScaleWidth      =   4680   StartUpPosition =   3  ''Windows Default   Begin VB.PictureBox Picture1       Height          =   3015      Left            =   120      ScaleHeight     =   2955      ScaleWidth      =   4395      TabIndex        =   0      Top             =   120      Width           =   4455      Begin VB.Timer Timer1          Enabled         =   0   ''False         Interval        =   40         Left            =   1920         Top             =   1320      End   EndEndAttribute VB_Name = "Form1"Attribute VB_GlobalNameSpace = FalseAttribute VB_Creatable = FalseAttribute VB_PredeclaredId = TrueAttribute VB_Exposed = False''-----------------------------------------------------------------------------'' File: Tut01_CreateDevice.frm'''' Desc: This is the first tutorial for using Direct3D. In this tutorial, all''       we are doing is create a Direct3D device and using it to clear the''       screen.'' Copyright (C) 1999-2001 Microsoft Corporation. All rights reserved.''-----------------------------------------------------------------------------''-----------------------------------------------------------------------------'' variables''-----------------------------------------------------------------------------Dim g_DX As New DirectX8Dim g_D3D As Direct3D8              ''Used to create the D3DDeviceDim g_D3DDevice As Direct3DDevice8  ''Our rendering device''-----------------------------------------------------------------------------'' Name: Form_Load()''-----------------------------------------------------------------------------Private Sub Form_Load()        '' Allow the form to become visible    Me.Show    DoEvents        '' Initialize D3D and D3DDevice    b = InitD3D(Picture1.hWnd)    If Not b Then        MsgBox "Unable to CreateDevice (see InitD3D() source for comments)"        End    End If        '' Enable Timer to update    Timer1.Enabled = True    End Sub''-----------------------------------------------------------------------------'' Name: Timer1_Timer()''-----------------------------------------------------------------------------Private Sub Timer1_Timer()    RenderEnd Sub''-----------------------------------------------------------------------------'' Name: Form_Unload()''-----------------------------------------------------------------------------Private Sub Form_Unload(Cancel As Integer)    EndEnd Sub''-----------------------------------------------------------------------------'' Name: InitD3D()'' Desc: Initializes Direct3D''-----------------------------------------------------------------------------Function InitD3D(hWnd As Long) As Boolean    On Local Error Resume Next        '' Create the D3D object, which is needed to create the D3DDevice. It can    '' also be used to enumerate devices types, modes, etc., which will be    '' shown in a separate tutorial.    Set g_D3D = g_DX.Direct3DCreate()    If g_D3D Is Nothing Then Exit Function        '' Get The current Display Mode format    Dim mode As D3DDISPLAYMODE    g_D3D.GetAdapterDisplayMode D3DADAPTER_DEFAULT, mode        '' Fill in the type structure used to create the D3DDevice. Most parameters    '' are left at zero. We set Windowed to 1 for TRUE, since we want to do D3D    '' in a window, and the set the SwapEffect to flip the backbuffer to the    '' frontbuffer only on vsync (which prevents "tearing" artifacts).    '' we set the back buffer format from the current display mode    Dim d3dpp As D3DPRESENT_PARAMETERS    d3dpp.Windowed = 1    d3dpp.SwapEffect = D3DSWAPEFFECT_COPY_VSYNC    d3dpp.BackBufferFormat = mode.Format        '' Create the D3DDevice. Here we are using the default adapter (most    '' systems only have one, unless they have multiple graphics hardware cards    '' installed) and using the HAL (which is saying we prefer the hardware    '' device or a software one). Software vertex processing is specified    '' since we know it will work on all cards. On cards that support hardware    '' vertex processing, though, we would see a big performance gain by using it.    ''    '' If you do not have hardware 3d acceleration. Enable the reference rasterizer    '' using the DirectX control panel and change D3DDEVTYPE_HAL to D3DDEVTYPE_REF        Set g_D3DDevice = g_D3D.CreateDevice(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, hWnd, _                                      D3DCREATE_SOFTWARE_VERTEXPROCESSING, d3dpp)    If g_D3DDevice Is Nothing Then Exit Function        '' Device state would normally be set here        InitD3D = TrueEnd Function''-----------------------------------------------------------------------------'' Name: Cleanup()'' Desc: Releases all previously initialized objects''-----------------------------------------------------------------------------Sub Cleanup()    Set g_D3DDevice = Nothing    Set g_D3D = NothingEnd Sub''-----------------------------------------------------------------------------'' Name: Render()'' Desc: Draws the scene''-----------------------------------------------------------------------------Sub Render()    If g_D3DDevice Is Nothing Then Exit Sub    '' Clear the backbuffer to a blue color (ARGB = 000000ff)    ''    '' To clear the entire back buffer we send down    ''   rect count = 0    ''   clearD3DRect = ByVal 0 (ByVal is necessary as param is of type as any)    ''   flags = D3DCLEAR_TARGET to specify the backbuffer    ''   color = &HFF& to specify BLUE (note final & indicates this is a long)    ''   zClear = 1  which is not used    ''   stencil = 0  which is not used    g_D3DDevice.Clear 0, ByVal 0, D3DCLEAR_TARGET, &HFF&, 1#, 0             '' Begin the scene    g_D3DDevice.BeginScene        '' Rendering of scene objects happens here             '' End the scene    g_D3DDevice.EndScene             '' Present the backbuffer contents to the front buffer (screen)    '' parameters are flexible to allow for only showing certain    '' portions of the back buffer, we want to Present the entire buffer    '' so we will pass down 0 to all parameters    ''   SourceRect = ByVal 0 (ByVal is necessary as param is of type as any)    ''   DestRect = ByVal 0 (ByVal is necessary as param is of type as any)    ''   hWndOverride = 0 (use same hWnd as passed to CreateDevice)    ''   DirtyRegion = Byval 0 (ByVal is necessary as param is of type as any)    g_D3DDevice.Present ByVal 0, ByVal 0, 0, ByVal 0    End Sub  

  VERSION 5.00Begin VB.Form Form1    BorderStyle     =   1  ''Fixed Single   Caption         =   "Meshes"   ClientHeight    =   3195   ClientLeft      =   45   ClientTop       =   330   ClientWidth     =   4680   LinkTopic       =   "Form1"   MaxButton       =   0   ''False   MinButton       =   0   ''False   ScaleHeight     =   3195   ScaleWidth      =   4680   StartUpPosition =   3  ''Windows Default   Begin VB.PictureBox Picture1       Height          =   3015      Left            =   120      ScaleHeight     =   2955      ScaleWidth      =   4395      TabIndex        =   0      Top             =   120      Width           =   4455      Begin VB.Timer Timer1          Enabled         =   0   ''False         Interval        =   40         Left            =   1920         Top             =   1320      End   EndEndAttribute VB_Name = "Form1"Attribute VB_GlobalNameSpace = FalseAttribute VB_Creatable = FalseAttribute VB_PredeclaredId = TrueAttribute VB_Exposed = False''-----------------------------------------------------------------------------'' File: Tut06_meshes.frm'''''' Desc: For advanced geometry, most apps will prefer to load pre-authored''       meshes from a file. Fortunately, when using meshes, D3DX does most of''       the work for this, parsing a geometry file and creating vertx buffers''       (and index buffers) for us. This tutorial shows how to use a D3DXMESH''       object, including loading it from a file and rendering it. One thing''       D3DX does not handle for us is the materials and textures for a mesh,''       so note that we have to handle those manually.''''       Note: one advanced (but nice) feature that we don''t show here, is that''       when cloning a mesh we can specify the FVF. So, regardless of how the''       mesh was authored, we can add/remove normals, add more texture''       coordinate sets (for multi-texturing), etc..'''''' Copyright (C) 1999-2001 Microsoft Corporation. All rights reserved.''-----------------------------------------------------------------------------Option Explicit''-----------------------------------------------------------------------------'' variables''-----------------------------------------------------------------------------Dim g_DX As New DirectX8Dim g_D3DX As New D3DX8Dim g_D3D As Direct3D8                  '' Used to create the D3DDeviceDim g_D3DDevice As Direct3DDevice8      '' Our rendering deviceDim g_Mesh As D3DXMesh                  '' Our MeshDim g_MeshMaterials() As D3DMATERIAL8   '' Mesh Material dataDim g_MeshTextures() As Direct3DTexture8 '' Mesh TexturesDim g_NumMaterials As LongConst g_pi = 3.1415''-----------------------------------------------------------------------------'' Name: Form_Load()''-----------------------------------------------------------------------------Private Sub Form_Load()    Dim b As Boolean        '' Allow the form to become visible    Me.Show    DoEvents        '' Initialize D3D and D3DDevice    b = InitD3D(Picture1.hWnd)    If Not b Then        MsgBox "Unable to CreateDevice (see InitD3D() source for comments)"        End    End If            '' Initialize vertex buffer with geometry and load our texture    b = InitGeometry()    If Not b Then        MsgBox "Unable to Create VertexBuffer"        End    End If            '' Enable Timer to update    Timer1.Enabled = True    End Sub''-----------------------------------------------------------------------------'' Name: Timer1_Timer()''-----------------------------------------------------------------------------Private Sub Timer1_Timer()    RenderEnd Sub''-----------------------------------------------------------------------------'' Name: Form_Unload()''-----------------------------------------------------------------------------Private Sub Form_Unload(Cancel As Integer)    Cleanup    EndEnd Sub''-----------------------------------------------------------------------------'' Name: InitD3D()'' Desc: Initializes Direct3D''-----------------------------------------------------------------------------Function InitD3D(hWnd As Long) As Boolean    On Local Error Resume Next        '' Create the D3D object    Set g_D3D = g_DX.Direct3DCreate()    If g_D3D Is Nothing Then Exit Function         '' Get The current Display Mode format    Dim mode As D3DDISPLAYMODE    g_D3D.GetAdapterDisplayMode D3DADAPTER_DEFAULT, mode             '' Set up the structure used to create the D3DDevice. Since we are now    '' using more complex geometry, we will create a device with a zbuffer.    '' the D3DFMT_D16 indicates we want a 16 bit z buffer but    Dim d3dpp As D3DPRESENT_PARAMETERS    d3dpp.Windowed = 1    d3dpp.SwapEffect = D3DSWAPEFFECT_COPY_VSYNC    d3dpp.BackBufferFormat = mode.Format    d3dpp.BackBufferCount = 1    d3dpp.EnableAutoDepthStencil = 1    d3dpp.AutoDepthStencilFormat = D3DFMT_D16    '' Create the D3DDevice    '' If you do not have hardware 3d acceleration. Enable the reference rasterizer    '' using the DirectX control panel and change D3DDEVTYPE_HAL to D3DDEVTYPE_REF        Set g_D3DDevice = g_D3D.CreateDevice(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, hWnd, _                                      D3DCREATE_SOFTWARE_VERTEXPROCESSING, d3dpp)    If g_D3DDevice Is Nothing Then Exit Function        '' Device state would normally be set here    '' Turn off culling, so we see the front and back of the triangle    ''g_D3DDevice.SetRenderState D3DRS_CULLMODE, D3DCULL_NONE    '' Turn on the zbuffer    g_D3DDevice.SetRenderState D3DRS_ZENABLE, 1        '' Turn on lighting    g_D3DDevice.SetRenderState D3DRS_LIGHTING, 0        '' Turn on full ambient light to white    g_D3DDevice.SetRenderState D3DRS_AMBIENT, &HFFFFFFFF    InitD3D = TrueEnd Function''-----------------------------------------------------------------------------'' Name: SetupMatrices()'' Desc: Sets up the world, view, and projection transform matrices.''-----------------------------------------------------------------------------Sub SetupMatrices()        '' The transform Matrix is used to position and orient the objects    '' you are drawing    '' For our world matrix, we will just rotate the object about the y axis.    Dim matWorld As D3DMATRIX    D3DXMatrixRotationAxis matWorld, vec3(0, 1, 0), Timer / 4    g_D3DDevice.SetTransform D3DTS_WORLD, matWorld    '' The view matrix defines the position and orientation of the camera    '' Set up our view matrix. A view matrix can be defined given an eye point,    '' a point to lookat, and a direction for which way is up. Here, we set the    '' eye five units back along the z-axis and up three units, look at the    '' origin, and define "up" to be in the y-direction.            Dim matView As D3DMATRIX    D3DXMatrixLookAtLH matView, vec3(0#, 3#, -5#), _                                 vec3(0#, 0#, 0#), _                                 vec3(0#, 1#, 0#)                                     g_D3DDevice.SetTransform D3DTS_VIEW, matView    '' The projection matrix describes the camera''s lenses    '' For the projection matrix, we set up a perspective transform (which    '' transforms geometry from 3D view space to 2D viewport space, with    '' a perspective divide making objects smaller in the distance). To build    '' a perpsective transform, we need the field of view (1/4 pi is common),    '' the aspect ratio, and the near and far clipping planes (which define at    '' what distances geometry should be no longer be rendered).    Dim matProj As D3DMATRIX    D3DXMatrixPerspectiveFovLH matProj, g_pi / 4, 1, 1, 1000    g_D3DDevice.SetTransform D3DTS_PROJECTION, matProjEnd Sub''-----------------------------------------------------------------------------'' Name: SetupLights()'' Desc: Sets up the lights and materials for the scene.''-----------------------------------------------------------------------------Sub SetupLights()         Dim col As D3DCOLORVALUE            '' Set up a material. The material here just has the diffuse and ambient    '' colors set to yellow. Note that only one material can be used at a time.    Dim mtrl As D3DMATERIAL8    With col:    .r = 1: .g = 1: .b = 0: .a = 1:   End With    mtrl.diffuse = col    mtrl.Ambient = col    g_D3DDevice.SetMaterial mtrl        '' Set up a white, directional light, with an oscillating direction.    '' Note that many lights may be active at a time (but each one slows down    '' the rendering of our scene). However, here we are just using one. Also,    '' we need to set the D3DRS_LIGHTING renderstate to enable lighting        Dim light As D3DLIGHT8    light.Type = D3DLIGHT_DIRECTIONAL    light.diffuse.r = 1#    light.diffuse.g = 1#    light.diffuse.b = 1#    light.Direction.x = Cos(Timer * 2)    light.Direction.y = 1#    light.Direction.z = Sin(Timer * 2)    light.Range = 1000#        g_D3DDevice.SetLight 0, light                   ''let d3d know about the light    g_D3DDevice.LightEnable 0, 1                    ''turn it on    g_D3DDevice.SetRenderState D3DRS_LIGHTING, 1    ''make sure lighting is enabled    '' Finally, turn on some ambient light.    '' Ambient light is light that scatters and lights all objects evenly    g_D3DDevice.SetRenderState D3DRS_AMBIENT, &H202020    End Sub''-----------------------------------------------------------------------------'' Name: InitGeometry()'' Desc: Load Mesh and textures''-----------------------------------------------------------------------------Function InitGeometry() As Boolean    Dim MtrlBuffer As D3DXBuffer    ''a d3dxbuffer is a generic chunk of memory    Dim i As Long        '' Load the mesh from the specified file    ''   filename = x file to load    ''   flags = D3DXMESH_MANAGED  allow d3dx manage the memory usage of this geometry    ''   device = g_d3ddevice (if we destroy the device we have to reload the geomerty)    ''   adjacenyBuffer = nothing (we dont need it)    ''   materialBuffer = MtrlBuffer (this variable will be filled in with a new object)    Set g_Mesh = g_D3DX.LoadMeshFromX(App.Path + "\Tiger.x", D3DXMESH_MANAGED, _                                   g_D3DDevice, Nothing, MtrlBuffer, g_NumMaterials)                                       If g_Mesh Is Nothing Then Exit Function         ''allocate space for our materials and textures    ReDim g_MeshMaterials(g_NumMaterials - 1)    ReDim g_MeshTextures(g_NumMaterials - 1)        Dim strTexName As String        '' We need to extract the material properties and texture names    '' from the MtrlBuffer        For i = 0 To g_NumMaterials - 1            '' Copy the material using the d3dx helper function        g_D3DX.BufferGetMaterial MtrlBuffer, i, g_MeshMaterials(i)        '' Set the ambient color for the material (D3DX does not do this)        g_MeshMaterials(i).Ambient = g_MeshMaterials(i).diffuse             '' Create the texture        strTexName = g_D3DX.BufferGetTextureName(MtrlBuffer, i)        If strTexName <> "" Then            Set g_MeshTextures(i) = g_D3DX.CreateTextureFromFile(g_D3DDevice, App.Path + "\" + strTexName)        End If            Next        Set MtrlBuffer = Nothing    InitGeometry = TrueEnd Function''-----------------------------------------------------------------------------'' Name: Cleanup()'' Desc: Releases all previously initialized objects''-----------------------------------------------------------------------------Sub Cleanup()    Erase g_MeshTextures    Erase g_MeshMaterials        Set g_Mesh = Nothing    Set g_D3DDevice = Nothing    Set g_D3D = NothingEnd Sub''-----------------------------------------------------------------------------'' Name: Render()'' Desc: Draws the scene''-----------------------------------------------------------------------------Sub Render()    Dim i As Long        If g_D3DDevice Is Nothing Then Exit Sub    '' Clear the backbuffer to a blue color (ARGB = 000000ff)    '' Clear the z buffer to 1    g_D3DDevice.Clear 0, ByVal 0, D3DCLEAR_TARGET Or D3DCLEAR_ZBUFFER, &HFF&, 1#, 0             '' Setup the world, view, and projection matrices    SetupMatrices         '' Begin the scene    g_D3DDevice.BeginScene        '' Meshes are divided into subsets, one for each material.    '' Render them in a loop    For i = 0 To g_NumMaterials - 1            '' Set the material and texture for this subset        g_D3DDevice.SetMaterial g_MeshMaterials(i)        g_D3DDevice.SetTexture 0, g_MeshTextures(i)                '' Draw the mesh subset        g_Mesh.DrawSubset i    Next                '' End the scene    g_D3DDevice.EndScene             '' Present the backbuffer contents to the front buffer (screen)    g_D3DDevice.Present ByVal 0, ByVal 0, 0, ByVal 0    End Sub''-----------------------------------------------------------------------------'' Name: vec3()'' Desc: helper function''-----------------------------------------------------------------------------Function vec3(x As Single, y As Single, z As Single) As D3DVECTOR    vec3.x = x    vec3.y = y    vec3.z = zEnd Function  

  VERSION 5.00Begin VB.Form frmPixelShader    BorderStyle     =   3  ''Fixed Dialog   Caption         =   "VB Pixel Shader"   ClientHeight    =   3195   ClientLeft      =   60   ClientTop       =   330   ClientWidth     =   4680   Icon            =   "frmPixelShader.frx":0000   LinkTopic       =   "Form1"   MaxButton       =   0   ''False   MinButton       =   0   ''False   ScaleHeight     =   3195   ScaleWidth      =   4680   StartUpPosition =   3  ''Windows DefaultEndAttribute VB_Name = "frmPixelShader"Attribute VB_GlobalNameSpace = FalseAttribute VB_Creatable = FalseAttribute VB_PredeclaredId = TrueAttribute VB_Exposed = FalseOption Explicit''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''  Copyright (C) 1999-2001 Microsoft Corporation.  All Rights Reserved.''''  File:       FrmPixelShader.frm''  Content:    This sample shows how to use Pixel Shaders. It renders a few polys with''              different pixel shader functions to manipulate the way the textures look.'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' This sample will use 7 different shaders.Private Const NUM_PIXELSHADERS = 7'' A structure to describe the type of vertices the app will use.Private Type VERTEX2TC_    x As Single    y As Single    z As Single    rhw As Single    color0 As Long    color1 As Long    tu0 As Single    tv0 As Single    tu1 As Single    tv1 As SingleEnd TypeDim VERTEX2TC(3) As VERTEX2TC_Dim verts(3) As VERTEX2TC_'' Describe the vertex format that the vertices use.Private Const FVFVERTEX2TC = (D3DFVF_XYZRHW Or D3DFVF_DIFFUSE Or D3DFVF_SPECULAR Or D3DFVF_TEX2)'' Allocate a few DirectX object variables that the app needs to use.Dim dX As DirectX8Dim d3d As Direct3D8Dim dev As Direct3DDevice8Dim d3dx As D3DX8Dim d3dvb As Direct3DVertexBuffer8Dim d3dt(1) As Direct3DTexture8''Keep the present params around for resetting the device if neededDim g_d3dpp As D3DPRESENT_PARAMETERS'' This string array will store the shader functionsDim sPixelShader(6) As String'' This array will store the pointers to the assembled pixel shadersDim hPixelShader(6) As LongPrivate Sub Form_Load()    ''************************************************************************'''' Here the app will call functions to set up D3D, create a device,'' initialize the vertices, initialize the vertex buffers, create the'' textures, setup the shader string arrays, and assemble the pixel shaders.'' Finally, it calls Form_Paint to render everything.''''************************************************************************            ''Set the width and height of the window    Me.Width = 125 * Screen.TwipsPerPixelX    Me.Height = 225 * Screen.TwipsPerPixelY    Me.Show    DoEvents        Call InitD3D    Call InitTextures    Call InitVerts    Call SetupShaders    Call InitDevice    Call PaintMe    ''Call Form_Paint    End SubPrivate Sub InitVB()    ''************************************************************************'''' This sub creates the vertex buffer that the app will use.'''' PARAMETERS:''           None.''************************************************************************                                '' Create the vertex buffer, It will hold 4 vertices (two primitives).    Set d3dvb = dev.CreateVertexBuffer(4 * Len(VERTEX2TC(0)), D3DUSAGE_WRITEONLY, FVFVERTEX2TC, D3DPOOL_MANAGED)    Call MoveVBVerts(0, 0)End SubPrivate Sub MoveVBVerts(dX As Single, dY As Single)''************************************************************************'''' This sub moves the vertices in the vertex buffer to a new location.'''' PARAMETERS:''           dx: A single that represents the new X coordinate for the upper left hand corner of the vertices.''           dy: A single that represents the new Y coordinate for the upper left hand corner of the vertices.''''************************************************************************        Dim pVBVerts(3) As VERTEX2TC_    Dim pData As Long, i As Long, lSize As Long        ''Store the size of a vertex    lSize = Len(VERTEX2TC(0))        ''Lock and retrieve the data in the vertex buffer    Call D3DAUX.D3DVertexBuffer8GetData(d3dvb, 0, lSize * 4, 0, pVBVerts(0))        For i = 0 To 3        ''Set this vertex to equal the global vertex        pVBVerts(i) = verts(i)        ''Add the X component to this vertex        pVBVerts(i).x = verts(i).x + dX        ''Add the Y component to this vertex        pVBVerts(i).y = verts(i).y + dY    Next        ''Set and unlock the data in the vertex buffer.    Call D3DAUX.D3DVertexBuffer8SetData(d3dvb, 0, lSize * 4, 0, pVBVerts(0))    End SubPrivate Sub InitVerts()''************************************************************************'''' This sub initializes the vertices'''' PARAMETERS:''           None.''''************************************************************************    With verts(0)        .x = 10: .y = 10: .z = 0.5        .rhw = 1        .color0 = MakeRGB(&H0, &HFF, &HFF)        .color1 = MakeRGB(&HFF, &HFF, &HFF)        .tu0 = 0: .tv0 = 0        .tu1 = 0: .tv1 = 0    End With        With verts(1)        .x = 40: .y = 10: .z = 0.5        .rhw = 1        .color0 = MakeRGB(&HFF, &HFF, &H0)        .color1 = MakeRGB(&HFF, &HFF, &HFF)        .tu0 = 1: .tv0 = 0        .tu1 = 1: .tv1 = 0    End With        With verts(2)        .x = 40: .y = 40: .z = 0.5        .rhw = 1        .color0 = MakeRGB(&HFF, &H0, &H0)        .color1 = MakeRGB(&H0, &H0, &H0)        .tu0 = 1: .tv0 = 1        .tu1 = 1: .tv1 = 1    End With        With verts(3)        .x = 10: .y = 40: .z = 0.5        .rhw = 1        .color0 = MakeRGB(&H0, &H0, &HFF)        .color1 = MakeRGB(&H0, &H0, &H0)        .tu0 = 0: .tv0 = 1        .tu1 = 0: .tv1 = 1    End With    End SubPrivate Sub InitTextures()        ''************************************************************************'''' This sub initializes the textures that will be used.'''' PARAMETERS:''           None.''''************************************************************************    Dim sFile As String        sFile = FindMediaDir("lake.bmp") & "lake.bmp"    Set d3dt(1) = d3dx.CreateTextureFromFile(dev, sFile)    sFile = FindMediaDir("seafloor.bmp") & "seafloor.bmp"    Set d3dt(0) = d3dx.CreateTextureFromFile(dev, sFile)    End SubPrivate Sub SetupShaders()    ''************************************************************************'''' This sub sets up the string arrays that contains each pixel shader.'''' PARAMETERS:''           None.''''************************************************************************    '' 0: Display texture 0 (t0)    sPixelShader(0) = _    "ps.1.0 " & _    "tex t0 " & _    "mov r0,t0"        '' 1: Display texture 1 (t1)    sPixelShader(1) = _    "ps.1.0 " & _    "tex t1 " & _    "mov r0,t1"        '' 2: Blend between tex0 and tex1, using vertex 1 as the input (v1)    sPixelShader(2) = _    "ps.1.0 " & _    "tex t0 " & _    "tex t1 " & _    "mov r1,t1 " & _    "lrp r0,v1,r1,t0"    '' 3: Scale texture 0 by vertex color 1 and add to texture 1    sPixelShader(3) = _    "ps.1.0 " & _    "tex t0 " & _    "tex t1 " & _    "mov r1,t0 " & _    "mad r0,t1,r1,v1"    '' 4: Add all: texture 0, 1, and color 0, 1    sPixelShader(4) = _    "ps.1.0 " & _    "tex t0 " & _    "tex t1 " & _    "add r1,t0,v1 " & _    "add r1,r1,t1 " & _    "add r1,r1,v0 " & _    "mov r0,r1"        '' 5: Modulate t0 by constant register c0    sPixelShader(5) = _    "ps.1.0 " & _    "tex t0 " & _    "mul r1,c0,t0 " & _    "mov r0,r1"        '' 6: Lerp by t0 and t1 by constant register c1    sPixelShader(6) = _    "ps.1.0 " & _    "tex t0 " & _    "tex t1 " & _    "mov r1,t1 " & _    "lrp r0,c1,t0,r1"            End SubPrivate Sub InitPixelShaders()''************************************************************************'''' This sub creates the pixel shaders, and stores the pointer (handle) to them.'''' PARAMETERS:''           None.''''************************************************************************    Dim pCode As D3DXBuffer    Dim i As Long, lArray() As Long, lSize As Long    ''Loop through each pixel shader string    For i = 0 To UBound(sPixelShader)                ''Assemble the pixel shader        Set pCode = d3dx.AssembleShader(sPixelShader(i), 0, Nothing)                ''Get the size of the assembled pixel shader        lSize = pCode.GetBufferSize() / 4                ''Resize the array        ReDim lArray(lSize - 1)                ''Retrieve the contents of the buffer        Call d3dx.BufferGetData(pCode, 0, 4, lSize, lArray(0))                ''Create the pixel shader.        hPixelShader(i) = dev.CreatePixelShader(lArray(0))                Set pCode = Nothing            NextEnd SubPrivate Sub InitDevice()''************************************************************************'''' This sub initializes the device to states that won''t change, and sets'' the constant values that some of the pixel shaders use.'''' PARAMETERS:''           None.''''************************************************************************    '' Constant registers store values that the pixel shaders can use. Each    '' constant is an array of 4 singles that contain information about color    '' and alpha components. This 2d array represents two pixel shader constants.    Dim fPSConst(3, 1) As Single        ''Used to set the constant values for c0 (used in pixel shader 5)    ''Red    fPSConst(0, 0) = 0.15    ''Green    fPSConst(1, 0) = 0.75    ''Blue    fPSConst(2, 0) = 0.25    ''Alpha    fPSConst(3, 0) = 0        ''Used to set the constant values for c1 (used in pixel shader 6)    ''Red    fPSConst(0, 1) = 0.15    ''Green    fPSConst(1, 1) = 1    ''Blue    fPSConst(2, 1) = 0.5    ''Alpha    fPSConst(3, 1) = 0    ''Create the vertex buffer    Call InitVB        ''Create the pixel shaders    Call InitPixelShaders    With dev                ''Lighting isn''t needed, since the vertices are prelit        Call .SetRenderState(D3DRS_LIGHTING, False)                ''Point the stream source to the vertex buffer that contains the vertices for rendering.        Call .SetStreamSource(0, d3dvb, Len(VERTEX2TC(0)))                ''Set the vertex shader to the flexible vertex format the app describes.        Call .SetVertexShader(FVFVERTEX2TC)                ''Set the pixel shader constans to the values that were set above.        Call .SetPixelShaderConstant(0, fPSConst(0, 0), 2)            End WithEnd SubPrivate Sub PaintMe()    ''************************************************************************'''' This sub is where all rendering happens. The vertices get moved to'' a new position, and then rendered.'''' PARAMETERS:''              None.''''************************************************************************                Dim hr As Long    Static bNotReady As Boolean        If Not dev Is Nothing And Me.ScaleHeight > 0 And Not d3dvb Is Nothing Then            ''Call TestCooperativeLevel to see what state the device is in.        hr = dev.TestCooperativeLevel                If hr = D3DERR_DEVICELOST Then                        ''If the device is lost, exit and wait for it to come back.            bNotReady = True            Exit Sub                ElseIf hr = D3DERR_DEVICENOTRESET Then                        ''The device is back, now it needs to be reset.            hr = 0            hr = ResetDevice            If hr Then Exit Sub                        bNotReady = False                    End If                ''Make sure the app is ready and that the form''s height is greater than 0        If bNotReady Or Me.ScaleHeight < 1 Then Exit Sub                        With dev                                                Call .BeginScene            Call .Clear(0, ByVal 0, D3DCLEAR_TARGET, MakeRGB(0, 0, 255), 0, 0)            ''To just show the interpolation of each vertex color, remove all of the textures.            Call .SetTexture(0, Nothing)            Call .SetTexture(1, Nothing)                        ''Move the vertices.            Call MoveVBVerts(0, 0)            ''No pixel shader will be used for this one.            Call .SetPixelShader(0)            ''Draw the two primitives.            Call .DrawPrimitive(D3DPT_TRIANGLEFAN, 0, 2)                                                ''Now set the two textures on the device.            Call .SetTexture(0, d3dt(0))            Call .SetTexture(1, d3dt(1))                        ''Move the vertices            Call MoveVBVerts(50, 0)            ''Use pixel shader 0            Call .SetPixelShader(hPixelShader(0))            Call .DrawPrimitive(D3DPT_TRIANGLEFAN, 0, 2)                        ''The rest of the calls just move the vertices to a new position, set            ''the next pixel shader, and render the two primitives.            Call MoveVBVerts(0, 50)            Call .SetPixelShader(hPixelShader(1))            Call .DrawPrimitive(D3DPT_TRIANGLEFAN, 0, 2)            Call MoveVBVerts(50, 50)            Call .SetPixelShader(hPixelShader(2))            Call .DrawPrimitive(D3DPT_TRIANGLEFAN, 0, 2)                    Call MoveVBVerts(0, 100)            Call .SetPixelShader(hPixelShader(3))            Call .DrawPrimitive(D3DPT_TRIANGLEFAN, 0, 2)            Call MoveVBVerts(50, 100)            Call .SetPixelShader(hPixelShader(4))            Call .DrawPrimitive(D3DPT_TRIANGLEFAN, 0, 2)            Call MoveVBVerts(0, 150)            Call .SetPixelShader(hPixelShader(5))            Call .DrawPrimitive(D3DPT_TRIANGLEFAN, 0, 2)                Call MoveVBVerts(50, 150)            Call .SetPixelShader(hPixelShader(6))            Call .DrawPrimitive(D3DPT_TRIANGLEFAN, 0, 2)                Call .EndScene            Call .Present(ByVal 0, ByVal 0, 0, ByVal 0)                End With            End IfEnd SubPrivate Function MakeRGB(r As Long, g As Long, b As Long) As Long''************************************************************************'''' This function takes three longs and packs them into a single long to'' create an RGB color. Each parameter has to be in the range of 0-255.'''' PARAMETERS:''           r   Long that represents the red component''           g   Long that represents the green component''           b   Long that represents the blue component'''' RETURNS:''           A long that.''''************************************************************************    MakeRGB = b    MakeRGB = MakeRGB Or (g * (2 ^ 8))    MakeRGB = MakeRGB Or (r * (2 ^ 16))End FunctionPrivate Sub InitD3D()    ''************************************************************************'''' This sub initializes all the object variables, and creates the 3d device.'''' PARAMETERS:''            None.''''************************************************************************    Dim d3ddm As D3DDISPLAYMODE        ''Turn off error handling, the app will handle any errors that occur.    On Local Error Resume Next            ''Get a new D3DX object    Set d3dx = New D3DX8    ''Get a new DirectX object    Set dX = New DirectX8    ''Create a Direct3D object    Set d3d = dX.Direct3DCreate()        ''Grab some information about the current display mode to see if the display    ''was switched to something that isn''t supported.    Call d3d.GetAdapterDisplayMode(D3DADAPTER_DEFAULT, d3ddm)        ''Make sure that the adapter is in a color bit depth greater than 8 bits per pixel.    If d3ddm.Format = D3DFMT_P8 Or d3ddm.Format = D3DFMT_A8P8 Then                ''Device is running in some variation of an 8 bit format. Sample will have to exit at this point.        MsgBox " For this sample to run, the primary display needs to be in 16 bit or higher color depth.", vbCritical        Unload Me        End            End If        With g_d3dpp                ''This app will run windowed.        .Windowed = 1                ''The backbuffer format is unknown. Since this is windowed mode,        ''the app can just use whatever mode the device is in now.        .BackBufferFormat = d3ddm.Format                ''When running windowed, the information contained in the        ''backbuffer is copied to the front buffer when Direct3DDevice.Present is called.        .SwapEffect = D3DSWAPEFFECT_COPY            End With        ''Create the device using the default adapter on the system using software vertex processing.    Set dev = d3d.CreateDevice(D3DADAPTER_DEFAULT, D3DDEVTYPE_REF, Me.hWnd, D3DCREATE_SOFTWARE_VERTEXPROCESSING, g_d3dpp)            ''Check to make sure the device was created successfully. If not, exit.    If dev Is Nothing Then        MsgBox "Unable to initialize Direct3D. App will now exit."        Unload Me        End    End If    End SubPrivate Sub Form_Paint()        If d3dvb Is Nothing Then Exit Sub        ''Anytime the window receives a paint message, repaint the scene.    Call PaintMe    End SubPrivate Sub Form_Resize()        If d3dvb Is Nothing Then Exit Sub        ''Anytime the form is resized, redraw the scene.    Call PaintMe    End Sub        Private Function ResetDevice() As Long''***********************************************************************'''' This subroutine is called whenever the app needs to be resized, or the'' device has been lost.'''' Parameters:''''   None.''''***********************************************************************            Dim d3ddm As D3DDISPLAYMODE        On Local Error Resume Next        ''Call the sub that destroys the vertex buffer and shaders.    Call DestroyAll        ''Set the width and height of the window    Me.Width = 110 * Screen.TwipsPerPixelX    Me.Height = 225 * Screen.TwipsPerPixelY         ''Grab some information about the current adapters display mode.    ''This may have changed since startup or the last D3DDevice8.Reset().    Call d3d.GetAdapterDisplayMode(D3DADAPTER_DEFAULT, d3ddm)            ''Refresh the backbuffer format using the retrieved format.     g_d3dpp.BackBufferFormat = d3ddm.Format        ''Now reset the device.    Call dev.Reset(g_d3dpp)        ''If something happens during the reset, trap any possible errors. This probably failed    ''because the app doesn''t have focus yet, but could fail is the user switched to an incompatible    ''display mode.        If Err.Number Then                        ''Make sure that the adapter is in a color bit-depth greater than 8 bits per pixel.        If d3ddm.Format = D3DFMT_P8 Or d3ddm.Format = D3DFMT_A8P8 Then                        ''Device is running in some variation of an 8 bit format. Sample will have to exit at this point.            MsgBox " For this sample to run, the primary display needs to be in 16 bit or higher color depth.", vbCritical            Unload Me            End                    Else                        ''More than likely the app just lost the display adapter. Keep spinning until the adapter becomes available.            ResetDevice = Err.Number            Exit Function                    End If    End If            ''Now get the device ready again    Call InitDevice        ''Redraw the scene    PaintMe    End FunctionPrivate Sub Form_Unload(Cancel As Integer)    '' When the app is exiting, call the DestroyAll() function to clean up.    Call DestroyAll    End SubPrivate Sub DestroyAll()''***********************************************************************'''' This sub releases all the objects and pixel shader handles.'''' PARAMETERS:''           None.''''***********************************************************************        Dim i As Long            On Error Resume Next        ''Loop through and delete all pixel shaders.    For i = 0 To UBound(hPixelShader)        If hPixelShader(i) Then            Call dev.DeletePixelShader(hPixelShader(i))            hPixelShader(i) = 0        End If    Next        ''Destroy the vertex buffer if it exists.    If Not d3dvb Is Nothing Then Set d3dvb = Nothing    End Sub