home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Game Programming for Teens / VBGPFT.cdr / DirectX8 / dx8a_sdk.exe / samples / multimedia / vbsamples / direct3d / pixelshader / frmpixelshader.frm (.txt) next >
Encoding:
Visual Basic Form  |  2000-10-02  |  20.3 KB  |  530 lines
  1. VERSION 5.00
  2. Begin VB.Form frmPixelShader 
  3.    Caption         =   "VB Pixel Shader"
  4.    ClientHeight    =   3195
  5.    ClientLeft      =   60
  6.    ClientTop       =   345
  7.    ClientWidth     =   4680
  8.    Icon            =   "frmPixelShader.frx":0000
  9.    LinkTopic       =   "Form1"
  10.    ScaleHeight     =   3195
  11.    ScaleWidth      =   4680
  12.    StartUpPosition =   3  'Windows Default
  13. Attribute VB_Name = "frmPixelShader"
  14. Attribute VB_GlobalNameSpace = False
  15. Attribute VB_Creatable = False
  16. Attribute VB_PredeclaredId = True
  17. Attribute VB_Exposed = False
  18. Option Explicit
  19. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  20. '  Copyright (C) 2000 Microsoft Corporation.  All Rights Reserved.
  21. '  File:       FrmPixelShader.frm
  22. '  Content:    This sample shows how to use Pixel Shaders. It renders a few polys with
  23. '              different pixel shader functions to manipulate the way the textures look.
  24. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  25. ' This sample will use 7 different shaders.
  26. Private Const NUM_PIXELSHADERS = 7
  27. ' A structure to describe the type of vertices the app will use.
  28. Private Type VERTEX2TC_
  29.     x As Single
  30.     y As Single
  31.     z As Single
  32.     rhw As Single
  33.     color0 As Long
  34.     color1 As Long
  35.     t00 As Single
  36.     t01 As Single
  37. End Type
  38. Dim VERTEX2TC(3) As VERTEX2TC_
  39. Dim verts(3) As VERTEX2TC_
  40. ' Describe the vertex format that the vertices use.
  41. Private Const FVFVERTEX2TC = (D3DFVF_XYZRHW Or D3DFVF_DIFFUSE Or D3DFVF_SPECULAR Or D3DFVF_TEX1)
  42. ' Allocate a few DirectX object variables that the app needs to use.
  43. Dim dX As DirectX8
  44. Dim d3d As Direct3D8
  45. Dim dev As Direct3DDevice8
  46. Dim d3dx As D3DX8
  47. Dim d3dvb As Direct3DVertexBuffer8
  48. Dim d3dt(1) As Direct3DTexture8
  49. 'Keep the present params around for resetting the device if needed
  50. Dim g_d3dpp As D3DPRESENT_PARAMETERS
  51. ' This string array will store the shader functions
  52. Dim sPixelShader(6) As String
  53. ' This array will store the pointers to the assembled pixel shaders
  54. Dim hPixelShader(6) As Long
  55. Private Sub Form_Load()
  56. '************************************************************************
  57. ' Here the app will call functions to set up D3D, create a device,
  58. ' initialize the vertices, initialize the vertex buffers, create the
  59. ' textures, setup the shader string arrays, and assemble the pixel shaders.
  60. ' Finally, it calls Form_Paint to render everything.
  61. '************************************************************************
  62.         
  63.     'Set the width and height of the window
  64.     Me.Width = 110 * Screen.TwipsPerPixelX
  65.     Me.Height = 225 * Screen.TwipsPerPixelY
  66.     Me.Show
  67.     DoEvents
  68.     Call InitD3D
  69.     Call InitTextures
  70.     Call InitVerts
  71.     Call SetupShaders
  72.     Call InitDevice
  73.     Call PaintMe
  74.     'Call Form_Paint
  75. End Sub
  76. Private Sub InitVB()
  77. '************************************************************************
  78. ' This sub creates the vertex buffer that the app will use.
  79. ' PARAMETERS:
  80. '           None.
  81. '************************************************************************
  82.                             
  83.     ' Create the vertex buffer, It will hold 4 vertices (two primitives).
  84.     Set d3dvb = dev.CreateVertexBuffer(4 * Len(VERTEX2TC(0)), D3DUSAGE_WRITEONLY, FVFVERTEX2TC, D3DPOOL_MANAGED)
  85.     Call MoveVBVerts(0, 0)
  86. End Sub
  87. Private Sub MoveVBVerts(dX As Single, dY As Single)
  88. '************************************************************************
  89. ' This sub moves the vertices in the vertex buffer to a new location.
  90. ' PARAMETERS:
  91. '           dx: A single that represents the new X coordinate for the upper left hand corner of the vertices.
  92. '           dy: A single that represents the new Y coordinate for the upper left hand corner of the vertices.
  93. '************************************************************************
  94.     Dim pVBVerts(3) As VERTEX2TC_
  95.     Dim pData As Long, i As Long, lSize As Long
  96.     'Store the size of a vertex
  97.     lSize = Len(VERTEX2TC(0))
  98.     'Lock and retrieve the data in the vertex buffer
  99.     Call D3DAUX.D3DVertexBuffer8GetData(d3dvb, 0, lSize * 4, 0, pVBVerts(0))
  100.     For i = 0 To 3
  101.         'Set this vertex to equal the global vertex
  102.         pVBVerts(i) = verts(i)
  103.         'Add the X component to this vertex
  104.         pVBVerts(i).x = verts(i).x + dX
  105.         'Add the Y component to this vertex
  106.         pVBVerts(i).y = verts(i).y + dY
  107.     Next
  108.     'Set and unlock the data in the vertex buffer.
  109.     Call D3DAUX.D3DVertexBuffer8SetData(d3dvb, 0, lSize * 4, 0, pVBVerts(0))
  110. End Sub
  111. Private Sub InitVerts()
  112. '************************************************************************
  113. ' This sub initializes the vertices
  114. ' PARAMETERS:
  115. '           None.
  116. '************************************************************************
  117.     With verts(0)
  118.         .x = 10: .y = 10: .z = 0.5
  119.         .rhw = 1
  120.         .color0 = MakeRGB(&H0, &HFF, &HFF)
  121.         .color1 = MakeRGB(&HFF, &HFF, &HFF)
  122.         .t00 = 0: .t01 = 0
  123.     End With
  124.     With verts(1)
  125.         .x = 40: .y = 10: .z = 0.5
  126.         .rhw = 1
  127.         .color0 = MakeRGB(&HFF, &HFF, &H0)
  128.         .color1 = MakeRGB(&HFF, &HFF, &HFF)
  129.         .t00 = 1: .t01 = 0
  130.     End With
  131.     With verts(2)
  132.         .x = 40: .y = 40: .z = 0.5
  133.         .rhw = 1
  134.         .color0 = MakeRGB(&HFF, &H0, &H0)
  135.         .color1 = MakeRGB(&H0, &H0, &H0)
  136.         .t00 = 1: .t01 = 1
  137.     End With
  138.     With verts(3)
  139.         .x = 10: .y = 40: .z = 0.5
  140.         .rhw = 1
  141.         .color0 = MakeRGB(&H0, &H0, &HFF)
  142.         .color1 = MakeRGB(&H0, &H0, &H0)
  143.         .t00 = 0: .t01 = 1
  144.     End With
  145. End Sub
  146. Private Sub InitTextures()
  147.         
  148. '************************************************************************
  149. ' This sub initializes the textures that will be used.
  150. ' PARAMETERS:
  151. '           None.
  152. '************************************************************************
  153.     Dim sFile As String
  154.     sFile = FindMediaDir("lake.bmp") & "lake.bmp"
  155.     Set d3dt(0) = d3dx.CreateTextureFromFile(dev, sFile)
  156.     sFile = FindMediaDir("seafloor.bmp") & "seafloor.bmp"
  157.     Set d3dt(1) = d3dx.CreateTextureFromFile(dev, sFile)
  158. End Sub
  159. Private Sub SetupShaders()
  160. '************************************************************************
  161. ' This sub sets up the string arrays that contains each pixel shader.
  162. ' PARAMETERS:
  163. '           None.
  164. '************************************************************************
  165.     ' 0: Display texture 0 (t0)
  166.     sPixelShader(0) = _
  167.     "ps.1.1 " & _
  168.     "tex t0 " & _
  169.     "mov r0, t0"
  170.     ' 1: Display texture 1 (t1)
  171.     sPixelShader(1) = _
  172.     "ps.1.1 " & _
  173.     "tex t1 " & _
  174.     "mov r0, t1"
  175.     ' 2: Blend between tex0 and tex1, using vertex 1 as the input (v1)
  176.     sPixelShader(2) = _
  177.     "ps.1.1 " & _
  178.     "tex t0 " & _
  179.     "tex t1 " & _
  180.     "lrp r1, v1, t0, t1 " & _
  181.     "mov r0, r1"
  182.     ' 3: Scale texture 0 by vertex color 1 and add to texture 1
  183.     sPixelShader(3) = _
  184.     "ps.1.1 " & _
  185.     "tex t0 " & _
  186.     "tex t1 " & _
  187.     "mad r1, t1, t0, v1 " & _
  188.     "mov r0, r1"
  189.     ' 4: Add all: texture 0, 1, and color 0, 1
  190.     sPixelShader(4) = _
  191.     "ps.1.1 " & _
  192.     "tex t0 " & _
  193.     "tex t1 " & _
  194.     "add r1, t0, v1 " & _
  195.     "add r1, r1, t1 " & _
  196.     "add r1, r1, v0 " & _
  197.     "mov r0, r1"
  198.     ' 5: Modulate t0 by constant register c0
  199.     sPixelShader(5) = _
  200.     "ps.1.1 " & _
  201.     "tex t0 " & _
  202.     "mul r1, c0, t0 " & _
  203.     "mov r0, r1"
  204.     ' 6: Lerp by t0 and t1 by constant register c1
  205.     sPixelShader(6) = _
  206.     "ps.1.1 " & _
  207.     "tex t0 " & _
  208.     "tex t1 " & _
  209.     "lrp r1, c1, t0, t1 " & _
  210.     "mov r0, r1"
  211.         
  212. End Sub
  213. Private Sub InitPixelShaders()
  214. '************************************************************************
  215. ' This sub creates the pixel shaders, and stores the pointer (handle) to them.
  216. ' PARAMETERS:
  217. '           None.
  218. '************************************************************************
  219.     Dim pCode As D3DXBuffer
  220.     Dim i As Long, lArray() As Long, lSize As Long
  221.     'Loop through each pixel shader string
  222.     For i = 0 To UBound(sPixelShader)
  223.         
  224.         'Assemble the pixel shader
  225.         Set pCode = d3dx.AssembleShader(sPixelShader(i), 0, Nothing)
  226.         
  227.         'Get the size of the assembled pixel shader
  228.         lSize = pCode.GetBufferSize() / 4
  229.         
  230.         'Resize the array
  231.         ReDim lArray(lSize - 1)
  232.         
  233.         'Retrieve the contents of the buffer
  234.         Call d3dx.BufferGetData(pCode, 0, 4, lSize, lArray(0))
  235.         
  236.         'Create the pixel shader.
  237.         hPixelShader(i) = dev.CreatePixelShader(lArray(0))
  238.         
  239.         Set pCode = Nothing
  240.         
  241.     Next
  242. End Sub
  243. Private Sub InitDevice()
  244. '************************************************************************
  245. ' This sub initializes the device to states that won't change, and sets
  246. ' the constant values that some of the pixel shaders use.
  247. ' PARAMETERS:
  248. '           None.
  249. '************************************************************************
  250.     ' Constant registers store values that the pixel shaders can use. Each
  251.     ' constant is an array of 4 singles that contain information about color
  252.     ' and alpha components. This 2d array represents two pixel shader constants.
  253.     Dim fPSConst(3, 1) As Single
  254.     'Used to set the constant values for c0 (used in pixel shader 5)
  255.     'Red
  256.     fPSConst(0, 0) = 0.15
  257.     'Green
  258.     fPSConst(1, 0) = 0.75
  259.     'Blue
  260.     fPSConst(2, 0) = 0.25
  261.     'Alpha
  262.     fPSConst(3, 0) = 0
  263.     'Used to set the constant values for c1 (used in pixel shader 6)
  264.     'Red
  265.     fPSConst(0, 1) = 0.15
  266.     'Green
  267.     fPSConst(1, 1) = 1
  268.     'Blue
  269.     fPSConst(2, 1) = 0.5
  270.     'Alpha
  271.     fPSConst(3, 1) = 0
  272.     'Create the vertex buffer
  273.     Call InitVB
  274.     'Create the pixel shaders
  275.     Call InitPixelShaders
  276.     With dev
  277.         
  278.         'Lighting isn't needed, since the vertices are prelit
  279.         Call .SetRenderState(D3DRS_LIGHTING, False)
  280.         
  281.         'Point the stream source to the vertex buffer that contains the vertices for rendering.
  282.         Call .SetStreamSource(0, d3dvb, Len(VERTEX2TC(0)))
  283.         
  284.         'Set the vertex shader to the flexible vertex format the app describes.
  285.         Call .SetVertexShader(FVFVERTEX2TC)
  286.         
  287.         'Set the pixel shader constans to the values that were set above.
  288.         Call .SetPixelShaderConstant(0, fPSConst(0, 0), 2)
  289.         
  290.     End With
  291. End Sub
  292. Private Sub PaintMe()
  293. '************************************************************************
  294. ' This sub is where all rendering happens. The vertices get moved to
  295. ' a new position, and then rendered.
  296. ' PARAMETERS:
  297. '              None.
  298. '************************************************************************
  299.             
  300.     Dim hr As Long
  301.     Static bNotReady As Boolean
  302.     If Not dev Is Nothing And Me.ScaleHeight > 0 And Not d3dvb Is Nothing Then
  303.         'Call TestCooperativeLevel to see what state the device is in.
  304.         hr = dev.TestCooperativeLevel
  305.         
  306.         If hr = D3DERR_DEVICELOST Then
  307.             
  308.             'If the device is lost, exit and wait for it to come back.
  309.             bNotReady = True
  310.             Exit Sub
  311.         
  312.         ElseIf hr = D3DERR_DEVICENOTRESET Then
  313.             
  314.             'The device is back, now it needs to be reset.
  315.             hr = 0
  316.             hr = ResetDevice
  317.             If hr Then Exit Sub
  318.             
  319.             bNotReady = False
  320.             
  321.         End If
  322.         
  323.         'Make sure the app is ready and that the form's height is greater than 0
  324.         If bNotReady Or Me.ScaleHeight < 1 Then Exit Sub
  325.                 
  326.         With dev
  327.                                     
  328.             Call .BeginScene
  329.             Call .Clear(0, ByVal 0, D3DCLEAR_TARGET, MakeRGB(0, 0, 255), 0, 0)
  330.             'To just show the interpolation of each vertex color, remove all of the textures.
  331.             Call .SetTexture(0, Nothing)
  332.             Call .SetTexture(1, Nothing)
  333.             
  334.             'Move the vertices.
  335.             Call MoveVBVerts(0, 0)
  336.             'No pixel shader will be used for this one.
  337.             Call .SetPixelShader(0)
  338.             'Draw the two primitives.
  339.             Call .DrawPrimitive(D3DPT_TRIANGLEFAN, 0, 2)
  340.                                     
  341.             'Now set the two textures on the device.
  342.             Call .SetTexture(0, d3dt(0))
  343.             Call .SetTexture(1, d3dt(1))
  344.             
  345.             'Move the vertices
  346.             Call MoveVBVerts(50, 0)
  347.             'Use pixel shader 0
  348.             Call .SetPixelShader(hPixelShader(0))
  349.             Call .DrawPrimitive(D3DPT_TRIANGLEFAN, 0, 2)
  350.             
  351.             'The rest of the calls just move the vertices to a new position, set
  352.             'the next pixel shader, and render the two primitives.
  353.             Call MoveVBVerts(0, 50)
  354.             Call .SetPixelShader(hPixelShader(1))
  355.             Call .DrawPrimitive(D3DPT_TRIANGLEFAN, 0, 2)
  356.             Call MoveVBVerts(50, 50)
  357.             Call .SetPixelShader(hPixelShader(2))
  358.             Call .DrawPrimitive(D3DPT_TRIANGLEFAN, 0, 2)
  359.         
  360.             Call MoveVBVerts(0, 100)
  361.             Call .SetPixelShader(hPixelShader(3))
  362.             Call .DrawPrimitive(D3DPT_TRIANGLEFAN, 0, 2)
  363.             Call MoveVBVerts(50, 100)
  364.             Call .SetPixelShader(hPixelShader(4))
  365.             Call .DrawPrimitive(D3DPT_TRIANGLEFAN, 0, 2)
  366.             Call MoveVBVerts(0, 150)
  367.             Call .SetPixelShader(hPixelShader(5))
  368.             Call .DrawPrimitive(D3DPT_TRIANGLEFAN, 0, 2)
  369.             Call MoveVBVerts(50, 150)
  370.             Call .SetPixelShader(hPixelShader(6))
  371.             Call .DrawPrimitive(D3DPT_TRIANGLEFAN, 0, 2)
  372.             Call .EndScene
  373.             Call .Present(ByVal 0, ByVal 0, 0, ByVal 0)
  374.         
  375.         End With
  376.         
  377.     End If
  378. End Sub
  379. Private Function MakeRGB(r As Long, g As Long, b As Long) As Long
  380. '************************************************************************
  381. ' This function takes three longs and packs them into a single long to
  382. ' create an RGB color. Each parameter has to be in the range of 0-255.
  383. ' PARAMETERS:
  384. '           r   Long that represents the red component
  385. '           g   Long that represents the green component
  386. '           b   Long that represents the blue component
  387. ' RETURNS:
  388. '           A long that.
  389. '************************************************************************
  390.     MakeRGB = b
  391.     MakeRGB = MakeRGB Or (g * (2 ^ 8))
  392.     MakeRGB = MakeRGB Or (r * (2 ^ 16))
  393. End Function
  394. Private Sub InitD3D()
  395. '************************************************************************
  396. ' This sub initializes all the object variables, and creates the 3d device.
  397. ' PARAMETERS:
  398. '            None.
  399. '************************************************************************
  400.     Dim d3ddm As D3DDISPLAYMODE
  401.     'Turn off error handling, the app will handle any errors that occur.
  402.     On Local Error Resume Next
  403.         
  404.     'Get a new D3DX object
  405.     Set d3dx = New D3DX8
  406.     'Get a new DirectX object
  407.     Set dX = New DirectX8
  408.     'Create a Direct3D object
  409.     Set d3d = dX.Direct3DCreate()
  410.     'Grab some information about the current display mode to see if the display
  411.     'was switched to something that isn't supported.
  412.     Call d3d.GetAdapterDisplayMode(D3DADAPTER_DEFAULT, d3ddm)
  413.     'Make sure that the adapter is in a color bit depth greater than 8 bits per pixel.
  414.     If d3ddm.Format = D3DFMT_P8 Or d3ddm.Format = D3DFMT_A8P8 Then
  415.         
  416.         'Device is running in some variation of an 8 bit format. Sample will have to exit at this point.
  417.         MsgBox " For this sample to run, the primary display needs to be in 16 bit or higher color depth.", vbCritical
  418.         Unload Me
  419.         End
  420.         
  421.     End If
  422.     With g_d3dpp
  423.         
  424.         'This app will run windowed.
  425.         .Windowed = 1
  426.         
  427.         'The backbuffer format is unknown. Since this is windowed mode,
  428.         'the app can just use whatever mode the device is in now.
  429.         .BackBufferFormat = d3ddm.Format
  430.         
  431.         'When running windowed, the information contained in the
  432.         'backbuffer is copied to the front buffer when Direct3DDevice.Present is called.
  433.         .SwapEffect = D3DSWAPEFFECT_COPY
  434.         
  435.     End With
  436.     'Create the device using the default adapter on the system using software vertex processing.
  437.     Set dev = d3d.CreateDevice(D3DADAPTER_DEFAULT, D3DDEVTYPE_REF, Me.hWnd, D3DCREATE_SOFTWARE_VERTEXPROCESSING, g_d3dpp)
  438.         
  439.     'Check to make sure the device was created successfully. If not, exit.
  440.     If dev Is Nothing Then
  441.         MsgBox "Unable to initialize Direct3D. App will now exit."
  442.         Unload Me
  443.         End
  444.     End If
  445. End Sub
  446. Private Sub Form_Paint()
  447.     If d3dvb Is Nothing Then Exit Sub
  448.     'Anytime the window receives a paint message, repaint the scene.
  449.     Call PaintMe
  450. End Sub
  451. Private Sub Form_Resize()
  452.     If d3dvb Is Nothing Then Exit Sub
  453.     'Anytime the form is resized, redraw the scene.
  454.     Call PaintMe
  455. End Sub
  456.         
  457. Private Function ResetDevice() As Long
  458. '***********************************************************************
  459. ' This subroutine is called whenever the app needs to be resized, or the
  460. ' device has been lost.
  461. ' Parameters:
  462. '   None.
  463. '***********************************************************************
  464.         
  465.     Dim d3ddm As D3DDISPLAYMODE
  466.     On Local Error Resume Next
  467.     'Call the sub that destroys the vertex buffer and shaders.
  468.     Call DestroyAll
  469.     'Set the width and height of the window
  470.     Me.Width = 110 * Screen.TwipsPerPixelX
  471.     Me.Height = 225 * Screen.TwipsPerPixelY
  472.      'Grab some information about the current adapters display mode.
  473.     'This may have changed since startup or the last D3DDevice8.Reset().
  474.     Call d3d.GetAdapterDisplayMode(D3DADAPTER_DEFAULT, d3ddm)
  475.         
  476.     'Refresh the backbuffer format using the retrieved format.
  477.      g_d3dpp.BackBufferFormat = d3ddm.Format
  478.     'Now reset the device.
  479.     Call dev.Reset(g_d3dpp)
  480.     'If something happens during the reset, trap any possible errors. This probably failed
  481.     'because the app doesn't have focus yet, but could fail is the user switched to an incompatible
  482.     'display mode.
  483.     If Err.Number Then
  484.                 
  485.         'Make sure that the adapter is in a color bit-depth greater than 8 bits per pixel.
  486.         If d3ddm.Format = D3DFMT_P8 Or d3ddm.Format = D3DFMT_A8P8 Then
  487.             
  488.             'Device is running in some variation of an 8 bit format. Sample will have to exit at this point.
  489.             MsgBox " For this sample to run, the primary display needs to be in 16 bit or higher color depth.", vbCritical
  490.             Unload Me
  491.             End
  492.             
  493.         Else
  494.             
  495.             'More than likely the app just lost the display adapter. Keep spinning until the adapter becomes available.
  496.             ResetDevice = Err.Number
  497.             Exit Function
  498.             
  499.         End If
  500.     End If
  501.         
  502.     'Now get the device ready again
  503.     Call InitDevice
  504.     'Redraw the scene
  505.     PaintMe
  506. End Function
  507. Private Sub Form_Unload(Cancel As Integer)
  508.     ' When the app is exiting, call the DestroyAll() function to clean up.
  509.     Call DestroyAll
  510. End Sub
  511. Private Sub DestroyAll()
  512. '***********************************************************************
  513. ' This sub releases all the objects and pixel shader handles.
  514. ' PARAMETERS:
  515. '           None.
  516. '***********************************************************************
  517.     Dim i As Long
  518.         
  519.     On Error Resume Next
  520.     'Loop through and delete all pixel shaders.
  521.     For i = 0 To UBound(hPixelShader)
  522.         If hPixelShader(i) Then
  523.             Call dev.DeletePixelShader(hPixelShader(i))
  524.             hPixelShader(i) = 0
  525.         End If
  526.     Next
  527.     'Destroy the vertex buffer if it exists.
  528.     If Not d3dvb Is Nothing Then Set d3dvb = Nothing
  529. End Sub
  530.