Visual Basic Game Programming for Teens/VBGPFT.cdr/DirectX8/dx8vbsdk.exe/samples/multimedia/vbsamples/direct3d/vertexblend/vertexblend.frm

Visual Basic Form | 2000-10-09 | 12.5 KB | 325 lines

VERSION 5.00
Begin VB.Form Form1
   Caption         =   "Vertex Blend"
   ClientHeight    =   4485
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5640
   Icon            =   "vertexblend.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   299
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   376
   StartUpPosition =   3  'Windows Default
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'-----------------------------------------------------------------------------
' File: VertexBlend.frm
' Desc: Example code showing how to do a skinning effect, using the vertex
'       blending feature of Direct3D. Normally, Direct3D transforms each
'       vertex through the world matrix. The vertex blending feature,
'       however, uses mulitple world matrices and a per-vertex blend factor
'       to transform each vertex.
' Copyright (c) 1997-2000 Microsoft Corporation. All rights reserved.
'-----------------------------------------------------------------------------
Option Explicit
Const D3DVBF_DISABLE = 0    '     Disable vertex blending
Const D3DVBF_1WEIGHTS = 1   '     2 matrix blending
Const D3DVBF_2WEIGHTS = 2   '     3 matrix blending
Const D3DVBF_3WEIGHTS = 3   '     4 matrix blending
Const D3DVBF_0WEIGHTS = 256 '     one matrix is used with weight 1.0
'-----------------------------------------------------------------------------
' Name: struct D3DBLENDVERTEX
' Desc: Custom vertex which includes a blending factor
'-----------------------------------------------------------------------------
Private Type D3DBLENDVERTEX
    v As D3DVECTOR
    blend As Single
    n As D3DVECTOR
    tu As Single
    tv As Single
End Type
Const D3DFVF_BLENDVERTEX = (D3DFVF_XYZB1 Or D3DFVF_NORMAL Or D3DFVF_TEX1)
Dim m_Object As CD3DMesh
Dim m_matUpperArm As D3DMATRIX
Dim m_matLowerArm As D3DMATRIX
Dim m_mediadir As String
Dim g_ftime As Single
Dim m_bInit As Boolean                  ' Indicates that d3d has been initialized
Dim m_bMinimized As Boolean             ' Indicates that display window is minimized
'-----------------------------------------------------------------------------
' Name: Form_Load()
' Desc:
'-----------------------------------------------------------------------------
Private Sub Form_Load()
    ' Show the form
    Me.Show
    DoEvents
    Me.Caption = "VertexBlend: Surface Skinning Example"

    ' Initialize D3D
    ' Note: D3DUtil_Init will attempt to use D3D Hardware acceleartion.
    ' If it is not available it attempt to use the Software Reference Rasterizer.
    ' If all fail it will display a message box indicating so.
    '
    m_bInit = D3DUtil_Init(Me.hwnd, True, 0, 0, D3DDEVTYPE_HAL, Nothing)
    If Not (m_bInit) Then End

    ' Find and set the path to our media
    m_mediadir = FindMediaDir("mslogo.x")
    D3DUtil_SetMediaPath m_mediadir
    ' Create new D3D mesh objects and loads content from disk
    InitDeviceObjects
    ' Sets the state for those objects and the current D3D device
    RestoreDeviceObjects
    ' Start our timer
    DXUtil_Timer TIMER_start
    ' Run the simulation forever
    ' See Form_Keydown for exit processing
    Do While True
        ' Increment the simulation
        FrameMove

        ' Render one image of the simulation
        Render

        ' Present the image to the screen
        D3DUtil_PresentAll g_focushwnd

        ' Allow for events to get processed
        DoEvents

    Loop
End Sub
'-----------------------------------------------------------------------------
' Name: Form_KeyDown()
' Desc: Process key messages for exit and change device
'-----------------------------------------------------------------------------
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
     Select Case KeyCode

        Case vbKeyEscape
            Unload Me

        Case vbKeyF2

            ' Pause the timer
            DXUtil_Timer TIMER_STOP

            ' Bring up the device selection dialog
            ' we pass in the form so the selection process
            ' can make calls into InitDeviceObjects
            ' and RestoreDeviceObjects
            frmSelectDevice.SelectDevice Me

            ' Restart the timer
            DXUtil_Timer TIMER_start

        Case vbKeyReturn

            ' Check for Alt-Enter if not pressed exit
            If Shift <> 4 Then Exit Sub

            ' If we are windowed go fullscreen
            ' If we are fullscreen returned to windowed
            If g_d3dpp.Windowed Then
                 D3DUtil_ResetFullscreen
            Else
                 D3DUtil_ResetWindowed
            End If

            ' Call Restore after ever mode change
            ' because calling reset looses state that needs to
            ' be reinitialized
            RestoreDeviceObjects

    End Select
End Sub
'-----------------------------------------------------------------------------
' Name: Form_Resize()
' Desc: hadle resizing of the D3D backbuffer
'-----------------------------------------------------------------------------
Private Sub Form_Resize()
    ' If D3D is not initialized then exit
    If Not m_bInit Then Exit Sub
    ' If we are in a minimized state stop the timer and exit
    If Me.WindowState = vbMinimized Then
        DXUtil_Timer TIMER_STOP
        m_bMinimized = True
        Exit Sub

    ' If we just went from a minimized state to maximized
    ' restart the timer
    Else
        If m_bMinimized = True Then
            DXUtil_Timer TIMER_start
            m_bMinimized = False
        End If
    End If
    ' Dont let the window get too small
    If Me.ScaleWidth < 10 Then
        Me.width = Screen.TwipsPerPixelX * 10
        Exit Sub
    End If
    If Me.ScaleHeight < 10 Then
        Me.height = Screen.TwipsPerPixelY * 10
        Exit Sub
    End If
    'reset and resize our D3D backbuffer to the size of the window
    D3DUtil_ResizeWindowed Me.hwnd
    'All state get losts after a reset so we need to reinitialze it here
    g_lWindowWidth = Me.ScaleWidth
    g_lWindowHeight = Me.ScaleHeight
    RestoreDeviceObjects
End Sub
'-----------------------------------------------------------------------------
' Name: Form_Unload()
' Desc:
'-----------------------------------------------------------------------------
Private Sub Form_Unload(Cancel As Integer)
    DeleteDeviceObjects
    End
End Sub
'-----------------------------------------------------------------------------
' Name: FrameMove()
' Desc: Called once per frame, the call is the entry point for animating
'       the scene.
'-----------------------------------------------------------------------------
Sub FrameMove()
    g_ftime = DXUtil_Timer(TIMER_GETAPPTIME)
    ' Set the vertex blending matrices for this frame
    D3DXMatrixIdentity m_matUpperArm
    Dim vAxis As D3DVECTOR
    vAxis = vec3(2 + Sin(g_ftime * 3.1), 2 + Sin(g_ftime * 3.3), Sin(g_ftime * 3.5))
    D3DXMatrixRotationAxis m_matLowerArm, vAxis, Sin(3 * g_ftime)
End Sub
'-----------------------------------------------------------------------------
' Name: Render()
' Desc: Called once per frame, the call is the entry point for 3d
'       rendering. This function sets up render states, clears the
'       viewport, and renders the scene.
'-----------------------------------------------------------------------------
Sub Render()
    Dim hr As Long
    'See what state the device is in.
    hr = g_dev.TestCooperativeLevel
    If hr = D3DERR_DEVICENOTRESET Then
        g_dev.Reset g_d3dpp
        RestoreDeviceObjects
    End If
    'dont bother rendering if we are not ready yet
    If hr <> 0 Then Exit Sub
    ' Clear the backbuffer
    D3DUtil_ClearAll &HFF&
    With g_dev
        .BeginScene

        ' Enable vertex blending
        .SetRenderState D3DRS_VERTEXBLEND, D3DVBF_1WEIGHTS
        .SetTransform D3DTS_WORLD, m_matUpperArm
        .SetTransform D3DTS_WORLD1, m_matLowerArm

        ' Display the object
        m_Object.Render g_dev
        ' End the scene.
        .EndScene
    End With
End Sub
'-----------------------------------------------------------------------------
' Name: InitDeviceObjects()
' Desc: Initialize scene objects.
'-----------------------------------------------------------------------------
Function InitDeviceObjects() As Boolean
    Dim b As Boolean
    Set m_Object = New CD3DMesh
    b = m_Object.InitFromFile(g_dev, m_mediadir + "mslogo.x")
    If Not b Then
        MsgBox "media not found"
        End
    End If
    ' Set a custom FVF for the mesh
    m_Object.SetFVF g_dev, D3DFVF_BLENDVERTEX
    Dim VertB As Direct3DVertexBuffer8
    Dim Vertices() As D3DBLENDVERTEX
    Dim NumVertices As Long
    Dim MinX As Single
    Dim MaxX As Single
    Dim a As Single
    Dim i As Long
    NumVertices = m_Object.mesh.GetNumVertices()
    Set VertB = m_Object.mesh.GetVertexBuffer()
    MinX = 10000000000#
    MaxX = -10000000000#
    ReDim Vertices(NumVertices)
    'copy data into our own array
    D3DVertexBuffer8GetData VertB, 0, NumVertices * Len(Vertices(0)), 0, Vertices(0)
    ' Calculate the min/max z values for all the vertices
    For i = 0 To NumVertices - 1
        If Vertices(i).v.x < MinX Then MinX = Vertices(i).v.x
        If Vertices(i).v.x > MaxX Then MaxX = Vertices(i).v.x
    Next
    ' Set the blend factors for the vertices
    For i = 0 To NumVertices - 1
        a = (Vertices(i).v.x - MinX) / (MaxX - MinX)
        Vertices(i).blend = 1 - Sin(a * g_pi * 1)
    Next
    D3DVertexBuffer8SetData VertB, 0, NumVertices * Len(Vertices(0)), 0, Vertices(0)
    Set VertB = Nothing
    InitDeviceObjects = True
End Function
'-----------------------------------------------------------------------------
' Name: RestoreDeviceObjects()
' Desc: Restore device-memory objects and state after a device is created or
'       resized.
'-----------------------------------------------------------------------------
Sub RestoreDeviceObjects()
    ' Restore mesh's local memory objects
    m_Object.RestoreDeviceObjects g_dev
    ' Set miscellaneous render states
    With g_dev
        .SetRenderState D3DRS_ZENABLE, 1  'TRUE
        .SetRenderState D3DRS_AMBIENT, &H444444

        ' Set the projection matrix
        Dim matProj As D3DMATRIX
        D3DXMatrixPerspectiveFovLH matProj, g_pi / 4, Me.ScaleHeight / Me.ScaleWidth, 1#, 10000#
        .SetTransform D3DTS_PROJECTION, matProj
        ' Set the app view matrix for normal viewing
        Dim vEyePt As D3DVECTOR, vLookatPt As D3DVECTOR, vUpVec As D3DVECTOR
        Dim matView As D3DMATRIX
        vEyePt = vec3(0#, -5#, -10#)
        vLookatPt = vec3(0#, 0#, 0#)
        vUpVec = vec3(0#, 1#, 0#)
        D3DXMatrixLookAtLH matView, vEyePt, vLookatPt, vUpVec
        .SetTransform D3DTS_VIEW, matView
        ' Create a directional light
        Dim light As D3DLIGHT8
        D3DUtil_InitLight light, D3DLIGHT_DIRECTIONAL, 1, -1, 1
        .SetLight 1, light
        .LightEnable 1, 1  'True
        .SetRenderState D3DRS_LIGHTING, 1 'TRUE


    End With
End Sub
'-----------------------------------------------------------------------------
' Name: InvalidateDeviceObjects()
' Desc: Called when the device-dependant objects are about to be lost.
'-----------------------------------------------------------------------------
Sub InvalidateDeviceObjects()
    m_Object.InvalidateDeviceObjects
End Sub
'-----------------------------------------------------------------------------
' Name: DeleteDeviceObjects()
' Desc: Called when the app is exitting, or the device is being changed,
'       this function deletes any device dependant objects.
'-----------------------------------------------------------------------------
Sub DeleteDeviceObjects()
    m_Object.Destroy
    Set m_Object = Nothing
    m_bInit = False
End Sub