Initial commit: ROW Client source code

Game client codebase including:
- CharacterActionControl: Character and creature management
- GlobalScript: Network, items, skills, quests, utilities
- RYLClient: Main client application with GUI and event handlers
- Engine: 3D rendering engine (RYLGL)
- MemoryManager: Custom memory allocation
- Library: Third-party dependencies (DirectX, boost, etc.)
- Tools: Development utilities

🤖 Generated with [Claude Code](https://claude.com/claude-code)

Co-Authored-By: Claude <noreply@anthropic.com>
This commit is contained in:
2025-11-29 16:24:34 +09:00
commit e067522598
5135 changed files with 1745744 additions and 0 deletions

View File

@@ -0,0 +1,262 @@
VERSION 5.00
Begin VB.Form Form3
Caption = "Animate Key Frames"
ClientHeight = 6015
ClientLeft = 60
ClientTop = 345
ClientWidth = 7530
Icon = "AnimKeys.frx":0000
LinkTopic = "Form3"
ScaleHeight = 401
ScaleMode = 3 'Pixel
ScaleWidth = 502
StartUpPosition = 3 'Windows Default
End
Attribute VB_Name = "Form3"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' Copyright (C) 1999-2001 Microsoft Corporation. All Rights Reserved.
'
' File: AnimKeys.frm
' Content: Playback of animated geometry
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
Dim Character As CD3DFrame
Dim Animation As CD3DAnimation
Dim MediaDir As String
Dim m_bInit As Boolean
Dim m_bMinimized As Boolean
'-----------------------------------------------------------------------------
' Name: Form_Load()
' Desc: Main entry point for the sample
'-----------------------------------------------------------------------------
Private Sub Form_Load()
Dim hr As Long
' Show the form
Me.Show
DoEvents
' 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 a path to our media
MediaDir = FindMediaDir("skmech.x")
D3DUtil_SetMediaPath MediaDir
' Load Character and Animation Data
InitDeviceObjects
' Position camera and Lights
RestoreDeviceObjects
' Start our timer
DXUtil_Timer TIMER_start
' Loop forever rendering our animation
Do While True
'Have our animation pose our character
Animation.SetTime DXUtil_Timer(TIMER_GETAPPTIME) * 30
'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
'Clear the background to ARGB grey
D3DUtil_ClearAll &HFF909090
'Start the Scene
g_dev.BeginScene
'Render the character (g_dev defined in D3DUtil)
Character.Render g_dev
'End the scene
g_dev.EndScene
'Update the Scene to our window
D3DUtil_PresentAll Me.hwnd
End If
'Allow VB events to process
DoEvents
Loop
End Sub
'-----------------------------------------------------------------------------
' Name: InitDeviceObjects()
' Desc: Load Character and Animation Data
'-----------------------------------------------------------------------------
Sub InitDeviceObjects()
'Create an Animation object to hold any animations
Set Animation = New CD3DAnimation
'Create a Frame object from a file
'the Animation object will parent any animations in the file
Set Character = D3DUtil_LoadFromFile(MediaDir + "skmech.x", Nothing, Animation)
End Sub
'-----------------------------------------------------------------------------
' Name: InvalidateDeviceObjects()
' Desc: place code to release references to non-managed objects here
'-----------------------------------------------------------------------------
Sub InvalidateDeviceObjects()
'all objects are managed in this sample
End Sub
'-----------------------------------------------------------------------------
' Name: RestoreDeviceObjects()
' Desc: setup device state such as camera and light placement
'-----------------------------------------------------------------------------
Sub RestoreDeviceObjects()
' Set up some lights and camera
g_lWindowWidth = Me.ScaleWidth
g_lWindowHeight = Me.ScaleHeight
D3DUtil_SetupDefaultScene
' position the camera
D3DUtil_SetupCamera vec3(0, 0, 300), vec3(0, 0, 0), vec3(0, 1, 0)
End Sub
'-----------------------------------------------------------------------------
' Name: DeleteDeviceObjects()
' Desc: Called when the app is exitting, or the device is being changed,
' this function deletes any device dependant objects.
'-----------------------------------------------------------------------------
Public Sub DeleteDeviceObjects()
Set Character = Nothing
Set Animation = Nothing
m_bInit = False
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
RestoreDeviceObjects
End Sub
'-----------------------------------------------------------------------------
' Name: Form_Unload()
' Desc:
'-----------------------------------------------------------------------------
Private Sub Form_Unload(Cancel As Integer)
DeleteDeviceObjects
End
End Sub

View File

@@ -0,0 +1,45 @@
Type=Exe
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#stdole2.tlb#OLE Automation
Reference=*\G{E1211242-8E94-11D1-8808-00C04FC2C603}#1.0#0#dx8vb.dll#DirectX 8 for Visual Basic Type Library
Module=D3DInit; ..\..\common\D3DInit.bas
Module=D3DUtil; ..\..\common\D3DUtil.bas
Module=MediaDir; ..\..\common\media.bas
Class=CD3DPick; ..\..\common\D3DPick.cls
Class=CD3DAnimation; ..\..\common\D3DAnimation.cls
Class=CD3DFrame; ..\..\common\D3DFrame.cls
Class=CD3DMesh; ..\..\common\D3DMesh.cls
Form=AnimKeys.frm
Form=..\..\common\SelectDevice.frm
IconForm="Form3"
Startup="Form3"
HelpFile=""
Title="AnimKeys"
ExeName32="vb_AnimKeys.exe"
Command32=""
Name="AnimKeys"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="Microsoft"
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1
[MS Transaction Server]
AutoRefresh=1

View File

@@ -0,0 +1,45 @@
//-----------------------------------------------------------------------------
//
// Sample Name: AnimKeys Sample
//
// Copyright (C) 1999-2001 Microsoft Corporation. All rights reserved.
//
//-----------------------------------------------------------------------------
Description
===========
The AnimKeys sample illustrates how to use the d3d framework to load an x-file with
key framed animation and playback the animation.nt
Path
====
Source: DXSDK\Samples\Multimedia\VBSamples\Direct3D\AnimKeys
Executable: DXSDK\Samples\Multimedia\VBSamples\Direct3D\Bin
User's Guide
============
The following keys are implemented. The dropdown menus can be used for the
same controls.
<F2> Prompts user to select a new rendering device or display mode
<Alt+Enter> Toggles between fullscreen and windowed modes
<Esc> Exits the app.
Programming Notes
=================
Note that the last argument passed to D3DUtil_LoadFromFile is a CD3DAnimation
class that is the parent to any animations that are found in the xfile.
Subsequently Animation.SetTime can be used to pose the model.
This sample makes use of common DirectX code (consisting of helper functions,
etc.) that is shared with other samples on the DirectX SDK. All common
classes and modules can be found in the following directory:
DXSDK\Samples\Multimedia\VBSamples\Common

View File

@@ -0,0 +1,876 @@
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form Form1
BorderStyle = 3 'Fixed Dialog
Caption = "Auto Collision Parts Database"
ClientHeight = 8520
ClientLeft = 480
ClientTop = 615
ClientWidth = 10875
Icon = "auto.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 568
ScaleMode = 3 'Pixel
ScaleWidth = 725
Begin MSComctlLib.TreeView TreeView1
Height = 3495
Left = 120
TabIndex = 27
Top = 480
Width = 3975
_ExtentX = 7011
_ExtentY = 6165
_Version = 393217
HideSelection = 0 'False
Style = 7
Appearance = 1
End
Begin VB.TextBox Text8
Enabled = 0 'False
Height = 375
Left = 9000
TabIndex = 25
Top = 7380
Width = 1695
End
Begin VB.PictureBox Picture2
Height = 735
Left = 120
ScaleHeight = 675
ScaleWidth = 10515
TabIndex = 19
Top = 4080
Width = 10575
Begin VB.Label Label9
Caption = $"auto.frx":0442
Height = 495
Left = 120
TabIndex = 20
Top = 120
Width = 9495
End
End
Begin VB.CommandButton Command1
Caption = "Add To Invoice"
Height = 495
Left = 120
TabIndex = 16
Top = 7920
Width = 3975
End
Begin MSComctlLib.ListView ListView1
Height = 2355
Left = 4320
TabIndex = 15
Top = 4920
Width = 6375
_ExtentX = 11245
_ExtentY = 4154
View = 3
LabelWrap = -1 'True
HideSelection = 0 'False
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
NumItems = 5
BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Key = "price"
Text = "DESCRIPTION"
Object.Width = 5821
EndProperty
BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 1
Key = "part"
Text = "PRICE"
Object.Width = 2117
EndProperty
BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 2
Key = "id"
Text = "ID"
Object.Width = 2117
EndProperty
BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 3
Key = "modid"
Text = "MODID"
Object.Width = 0
EndProperty
BeginProperty ColumnHeader(5) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 4
Object.Width = 38100
EndProperty
End
Begin VB.CommandButton Command3
Caption = "Process Order"
Height = 495
Left = 7680
TabIndex = 3
Top = 7920
Width = 3015
End
Begin VB.CommandButton Command2
Caption = "Remove From Invoice"
Height = 495
Left = 4320
TabIndex = 2
Top = 7920
Width = 3135
End
Begin VB.PictureBox largepict
Height = 3495
Left = 4320
ScaleHeight = 229
ScaleMode = 3 'Pixel
ScaleWidth = 421
TabIndex = 1
Top = 480
Width = 6375
End
Begin VB.PictureBox Picture1
Height = 2835
Left = 120
ScaleHeight = 2775
ScaleWidth = 3915
TabIndex = 0
Top = 4920
Width = 3975
Begin VB.TextBox Text7
Enabled = 0 'False
Height = 285
Left = 1440
TabIndex = 26
Top = 2400
Width = 1695
End
Begin VB.TextBox Text6
Enabled = 0 'False
Height = 285
Left = 1440
TabIndex = 24
Top = 2040
Width = 1695
End
Begin VB.TextBox Text5
Enabled = 0 'False
Height = 285
Left = 1440
TabIndex = 13
Top = 1680
Width = 1695
End
Begin VB.TextBox Text4
Enabled = 0 'False
Height = 285
Left = 1440
TabIndex = 11
Top = 1320
Width = 1695
End
Begin VB.TextBox Text3
Enabled = 0 'False
Height = 285
Left = 1440
TabIndex = 9
Top = 960
Width = 1695
End
Begin VB.TextBox Text2
Enabled = 0 'False
Height = 285
Left = 1440
TabIndex = 7
Top = 600
Width = 1695
End
Begin VB.TextBox Text1
Enabled = 0 'False
Height = 285
Left = 1440
TabIndex = 4
Top = 240
Width = 1695
End
Begin VB.Label Label12
Caption = "MAKE"
Height = 255
Left = 120
TabIndex = 23
Top = 2400
Width = 735
End
Begin VB.Label Label11
Caption = "Label11"
Height = 15
Left = 240
TabIndex = 22
Top = 2640
Width = 735
End
Begin VB.Label Label10
Caption = "STOCK"
Height = 255
Left = 120
TabIndex = 21
Top = 2040
Width = 1095
End
Begin VB.Label Label5
Caption = "ASSEMBLY"
Height = 375
Left = 120
TabIndex = 12
Top = 1680
Width = 1335
End
Begin VB.Label Label4
Caption = "COMPAT PARTS"
Height = 255
Left = 120
TabIndex = 10
Top = 1320
Width = 1335
End
Begin VB.Label Label3
Caption = "PRICE"
Height = 255
Left = 120
TabIndex = 8
Top = 960
Width = 1095
End
Begin VB.Label Label2
Caption = "DESCRIPTION"
Height = 375
Left = 120
TabIndex = 6
Top = 600
Width = 1215
End
Begin VB.Label Label1
Caption = "PARTID"
Height = 255
Left = 120
TabIndex = 5
Top = 240
Width = 735
End
End
Begin VB.Label Label8
Caption = "Select Assembly"
Height = 255
Left = 120
TabIndex = 18
Top = 120
Width = 2895
End
Begin VB.Label Label7
Caption = "Click On a Part From Assembly - Use the mouse to Rotate the Assembly"
Height = 255
Left = 4320
TabIndex = 17
Top = 120
Width = 5895
End
Begin VB.Label Label6
Caption = "TOTAL"
Height = 255
Left = 4440
TabIndex = 14
Top = 7380
Width = 1455
End
Begin VB.Menu MENU_FILE
Caption = "&File"
Begin VB.Menu MENU_EXIT
Caption = "E&xit"
End
End
Begin VB.Menu MENU_HELP
Caption = "&Help"
Begin VB.Menu MENU_ABOUT
Caption = "&About..."
End
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'The model used by this sample, engine1.x, is provided courtesy of Viewpoint
'Digital, Inc. (www.viewpoint.com). It is provided for use with this sample
'only and cannot be distributed with any application without prior written
'consent. V6 Engine Model copyright 1999 Viewpoint Digital, Inc..
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' Copyright (C) 1999-2001 Microsoft Corporation. All Rights Reserved.
'
' File: auto.frm
' Content: Example of display and picking geometry
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim m_assemblies(100) As CD3DFrame
Dim m_assemblyName(100) As String
Dim m_nAssembly As Long
Dim m_scene As CD3DFrame
Dim m_root As CD3DFrame
Dim m_bMouseDown As Boolean
Dim m_lastX As Integer
Dim m_lastY As Integer
Dim m_current As CD3DFrame
Dim m_bInLoad As Boolean
Dim m_binit As Boolean
Dim m_data As New Data
Dim fLoading As Boolean
Dim m_backcolor As Long
Dim m_mediadir As String
Implements DirectXEvent8
Private Sub DirectXEvent8_DXCallback(ByVal eventid As Long)
Dim b As Boolean
End Sub
'- Form_Load
'
' Initialize the D3DUtil Framework
' Initialize the parts info text database
' Initialize the treeview control
Private Sub Form_Load()
Dim b As Boolean
Me.Show
DoEvents
' Initialize D3D Window
b = D3DUtil_DefaultInitWindowed(0, largepict.hwnd)
If b = False Then
MsgBox "Exiting, Unable to initialize 3D device"
End
End If
'Add some default light and turn on lighting
g_lWindowWidth = largepict.ScaleWidth
g_lWindowHeight = largepict.ScaleHeight
D3DUtil.D3DUtil_SetupDefaultScene
'Find Media Directory
m_mediadir = FindMediaDir("partstable.txt", False)
'Open Text Database
m_data.InitData m_mediadir + "partstable.txt"
'Save our initial background color
m_backcolor = &HFF90D090
'Fill the Tree view with its root node
FillTreeViewControl
End Sub
'- SelectPart
'
' fill in the text boxes given a certain identifier
' from a model. We query the database for the identifier
' and from there we get the rest of the info
Sub SelectPart(strName As String, strObject As String)
If m_data.MoveToModelPartRecord(strName) = False Then Exit Sub
Text1.Text = m_data.PartID
Text2.Text = m_data.Description
Text3.Text = format$(m_data.Price, "#0.00")
Text4.Text = m_data.CompatibleParts
Text5.Text = "Engine"
Text6.Text = m_data.Stock
Text7.Text = m_data.PartMake
If Not m_root Is Nothing Then
'Turn the selected object red
If Not m_current Is Nothing Then
With m_current.GetChildMesh(0)
.bUseMaterials = True
.bUseMaterialOverride = False
End With
End If
Set m_current = m_scene.FindChildObject(strObject, 0)
If Not (m_current Is Nothing) Then
Dim mat As D3DMATERIAL8
With m_current.GetChildMesh(0)
.bUseMaterials = False
.bUseMaterialOverride = True
mat.emissive.r = 0.5
mat.emissive.a = 1
mat.diffuse.r = 0.3
mat.diffuse.a = 1
.SetMaterialOverride mat
End With
End If
End If
errOut:
End Sub
'- Rotate Track ball
' given a point on the screen the mouse was moved to
' simulate a track ball
Private Sub RotateTrackBall(x As Integer, y As Integer)
Dim delta_x As Single, delta_y As Single
Dim delta_r As Single, radius As Single, denom As Single, angle As Single
' rotation axis in camcoords, worldcoords, sframecoords
Dim axisC As D3DVECTOR
Dim wc As D3DVECTOR
Dim axisS As D3DVECTOR
Dim base As D3DVECTOR
Dim origin As D3DVECTOR
delta_x = x - m_lastX
delta_y = y - m_lastY
m_lastX = x
m_lastY = y
delta_r = Sqr(delta_x * delta_x + delta_y * delta_y)
radius = 50
denom = Sqr(radius * radius + delta_r * delta_r)
If (delta_r = 0 Or denom = 0) Then Exit Sub
angle = (delta_r / denom)
axisC.x = (-delta_y / delta_r)
axisC.y = (-delta_x / delta_r)
axisC.z = 0
'transform camera space vector to world space
'm_largewindow.m_cameraFrame.Transform wc, axisC
g_dev.GetTransform D3DTS_VIEW, g_viewMatrix
D3DXVec3TransformCoord wc, axisC, g_viewMatrix
'transform world space vector into Model space
m_scene.UpdateFrames
axisS = m_root.InverseTransformCoord(wc)
'transform origen camera space to world coordinates
'm_largewindow.m_cameraFrame.Transform wc, origin
D3DXVec3TransformCoord wc, origin, g_viewMatrix
'transfer cam space origen to model space
base = m_root.InverseTransformCoord(wc)
axisS.x = axisS.x - base.x
axisS.y = axisS.y - base.y
axisS.z = axisS.z - base.z
m_root.AddRotation COMBINE_BEFORE, axisS.x, axisS.y, axisS.z, angle
End Sub
'- LoadAssembly
'
' See if we have the assembly loaded
' if not figure out which model to use from a db
' and load it
' by default it will attach it to the scene
Function LoadAssembly(sname As String) As Long
Dim i As Long
Dim strCap As String
Dim strModel As String
Static b As Boolean
If b = True Then Exit Function
b = True
'make sure we dont habe it already
For i = 1 To m_nAssembly
If sname = m_assemblyName(i) Then
LoadAssembly = i
b = False
Exit Function
End If
Next
m_nAssembly = m_nAssembly + 1
m_assemblyName(m_nAssembly) = sname
'look up the model we need to load
'for this example we only show 1 model
'but one could query for the files from a database
strModel = "engine1.x"
strCap = Me.Caption
Me.Caption = "Loading- please wait"
DoEvents
Err.Number = 0
Form2.Top = Me.Top + Me.height / 4
Form2.Left = Me.Left + Me.width / 8
Form2.Show
DoEvents
Set m_assemblies(m_nAssembly) = New CD3DFrame
b = m_assemblies(m_nAssembly).InitFromFile(g_dev, m_mediadir + strModel, Nothing, Nothing)
If b = False Then
Set m_assemblies(m_nAssembly) = Nothing
m_assemblyName(m_nAssembly) = ""
m_nAssembly = m_nAssembly - 1
Unload Form2
Me.Caption = strCap
GoTo errOut
End If
Me.Caption = strCap
m_assemblies(m_nAssembly).SetFVF g_dev, D3DFVF_VERTEX
m_assemblies(m_nAssembly).ComputeNormals
g_dev.SetRenderState D3DRS_AMBIENT, &H90909090
'Release the previous scene
Set m_scene = Nothing
Set m_root = Nothing
Set m_current = Nothing
'Create a root object for the scene
Set m_scene = New CD3DFrame
'Create a new root object to use for rotation matrix
Set m_root = D3DUtil_CreateFrame(m_scene)
'Add our assembly to the tree
m_root.AddChild m_assemblies(m_nAssembly)
'Position our assembly
m_assemblies(m_nAssembly).AddTranslation COMBINE_replace, 0, 0, 5
'Recolor m_assemblies(m_nAssembly)
LoadAssembly = m_nAssembly
Unload Form2
DoEvents
If fLoading Then End
RenderScene
DoEvents
Set m_root = m_assemblies(m_nAssembly)
m_binit = True
errOut:
b = False
TreeView1.Enabled = True
largepict.SetFocus
DoEvents
End Function
' Command1_Click
' Add To Invoice
'
Private Sub Command1_Click()
Dim itm As ListItem
If Text1.Text = "" Then Exit Sub
Set itm = ListView1.ListItems.Add(, , Text2.Text)
itm.SubItems(1) = Text3.Text
itm.SubItems(2) = Text1.Text
Set ListView1.SelectedItem = itm
itm.EnsureVisible
Text8.Text = format(val(Text8.Text) + val(Text3.Text), "#0.00")
End Sub
' Command1_Click
' Delete from Invoice
'
Private Sub Command2_Click()
If ListView1.SelectedItem Is Nothing Then Exit Sub
Text8 = format(val(Text8.Text) - val(ListView1.SelectedItem.SubItems(1)), "#0.00")
ListView1.ListItems.Remove ListView1.SelectedItem.index
End Sub
' Form_QueryUnload
'
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
fLoading = True
End Sub
'- MouseDown
'
Private Sub largepict_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If m_binit = False Then Exit Sub
Dim b As Boolean
Dim mb As CD3DMesh
Dim r As Integer, c As Integer
Dim f As CD3DFrame
Dim p As CD3DFrame
Dim strName As String
Dim pick As CD3DPick
Dim n As Long
'- save our current position
m_bMouseDown = True
m_lastX = x
m_lastY = y
If Button = 1 Then
'Get the frame under the the mouse
Set pick = New CD3DPick
If Not pick.ViewportPick(m_scene, x, y) Then Exit Sub
n = pick.FindNearest()
If n < 0 Then Exit Sub
Set f = pick.GetFrame(n)
'Get its id and call SelectPart
'to fill in our text boxes
strName = f.ObjectName
strName = Right$(strName, Len(strName) - 1)
'The words V6 and Chevy are part of the manifold cover.
If strName = "words" Or strName = "v6" Then strName = "manifoldt"
SelectPart strName, f.ObjectName
SelectTreeview strName
DoEvents
End If
RenderScene
End Sub
'- MOUSE MOVE
'
Private Sub largepict_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
'- dont do anything unless the mouse is down
If m_bMouseDown = False Then
Exit Sub
End If
'- Rotate the object
RotateTrackBall CInt(x), CInt(y)
'- Rerender
RenderScene
End Sub
'- MOUSE UP
' reset the mouse state
'
Private Sub largepict_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
m_bMouseDown = False
End Sub
'- largepict_Paint UP
'
Private Sub largepict_Paint()
If Not m_binit Then Exit Sub
RenderScene
End Sub
'- MENU_ABOUT_Click
'
Private Sub MENU_ABOUT_Click()
MsgBox "The model used by this sample, engine1.x, is provided courtesy of Viewpoint" + Chr(10) + Chr(13) + _
"Digital, Inc. (www.viewpoint.com). It is provided for use with this sample" + Chr(10) + Chr(13) + _
"only and cannot be distributed with any application without prior written" + Chr(10) + Chr(13) + _
"consent. V6 Engine Model copyright 1999 Viewpoint Digital, Inc.."
End Sub
' MENU_EXIT_Click
'
Private Sub MENU_EXIT_Click()
End
End Sub
' TreeView1_Expand
'
Private Sub TreeView1_Expand(ByVal Node As MSComctlLib.Node)
Dim i As Long
Static b As Boolean
If b Then Exit Sub
b = True
'See if they are asking for a new assembly alltogether
If Mid$(Node.Tag, 1, 8) = "ASSMBLY:" Then
m_bInLoad = True
i = LoadAssembly(Node.Tag)
If i = 0 Then
MsgBox "Assembly not available at this time- try a different Engine"
b = False
Exit Sub
End If
End If
b = False
End Sub
'- TreeView1_NodeClick
'
Private Sub TreeView1_NodeClick(ByVal Node As MSComctlLib.Node)
Static b As Boolean
If b Then Exit Sub
b = True
Dim o As CD3DFrame
Dim i As Long
If Node.Tag = "" Then
b = False
Exit Sub
End If
'Fill in the text boxes
SelectPart Node.Tag, "_" & Node.Tag
DoEvents
'Render
RenderScene
DoEvents
b = False
End Sub
'- FillTreeViewControl
Sub FillTreeViewControl()
TreeView1.Nodes.Clear
Dim sPartID As String
Dim sDesc As String
'A non-demo application would build the tree view
'from the database and dynamically load in new
'information into the treeview
Dim n As Node
Call TreeView1.Nodes.Add(, , "ASSEMBLIES", "Assemblies - [click here to start]")
Set n = TreeView1.Nodes.Add("ASSEMBLIES", tvwChild, "ENG V6 1996", "V6 4 Liter 1996 - [click here]")
n.Tag = "ASSMBLY:ENG V6 1996"
n.Selected = True
TreeView1.Nodes.Add("ASSEMBLIES", tvwChild, "ENG V8 1998", "V8 6 Liter 1998 - [not available]").Tag = ""
TreeView1.Nodes.Add("ASSEMBLIES", tvwChild, "OTHERENG", "Other Assemblies not available").Tag = ""
m_data.MoveTop
Do While m_data.IsEOF() = False
sPartID = m_data.ModelPart
sDesc = m_data.Description
TreeView1.Nodes.Add("ENG V6 1996", tvwChild, sPartID, sDesc).Tag = sPartID
m_data.MoveNext
Loop
End Sub
Sub SelectTreeview(sname As String)
On Local Error Resume Next
TreeView1.Nodes(sname).Selected = True
DoEvents
End Sub
'- RenderScene
'
Sub RenderScene()
Dim hr As Long
If m_scene Is Nothing Then Exit Sub
'See what state the device is in.
hr = g_dev.TestCooperativeLevel
If hr = D3DERR_DEVICENOTRESET Then
g_dev.Reset g_d3dpp
'reset our state
g_lWindowWidth = largepict.ScaleWidth
g_lWindowHeight = largepict.ScaleHeight
D3DUtil.D3DUtil_SetupDefaultScene
DoEvents
ElseIf hr <> 0 Then
Exit Sub
End If
D3DXMatrixLookAtLH g_viewMatrix, vec3(0, 0, -1), vec3(0, 0, 0), vec3(0, 1, 0)
g_dev.SetTransform D3DTS_VIEW, g_viewMatrix
D3DUtil_ClearAll m_backcolor
g_dev.BeginScene
m_scene.Render g_dev
g_dev.EndScene
D3DUtil_PresentAll 0
End Sub

View File

@@ -0,0 +1,56 @@
VERSION 5.00
Begin VB.Form Form2
BorderStyle = 0 'None
Caption = "Form2"
ClientHeight = 1080
ClientLeft = 0
ClientTop = 0
ClientWidth = 7575
LinkTopic = "Form2"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 1080
ScaleWidth = 7575
ShowInTaskbar = 0 'False
StartUpPosition = 3 'Windows Default
Begin VB.PictureBox Picture1
Height = 855
Left = 120
ScaleHeight = 795
ScaleWidth = 7275
TabIndex = 0
Top = 120
Width = 7335
Begin VB.Label Label1
Caption = "Loading Assembly Please Wait"
BeginProperty Font
Name = "MS Sans Serif"
Size = 24
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Left = 240
TabIndex = 1
Top = 120
Width = 6615
End
End
End
Attribute VB_Name = "Form2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' Copyright (C) 1999-2001 Microsoft Corporation. All Rights Reserved.
'
' File: AutoLoad.frm
' Content: Autoparts loading dialog
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

View File

@@ -0,0 +1,45 @@
Type=Exe
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#stdole2.tlb#OLE Automation
Reference=*\G{E1211242-8E94-11D1-8808-00C04FC2C603}#1.0#0#dx8vb.dll#DirectX 8 for Visual Basic Type Library
Object={86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0; MSCOMCT2.OCX
Object={831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0; MSCOMCTL.OCX
Form=auto.frm
Form=autoload.frm
Class=Data; data.cls
Class=CD3DFrame; ..\..\common\D3DFrame.cls
Class=CD3DAnimation; ..\..\common\D3DAnimation.cls
Class=CD3DMesh; ..\..\common\D3DMesh.cls
Class=CD3DPick; ..\..\common\D3DPick.cls
Module=D3DUtil; ..\..\common\D3DUtil.bas
Module=D3DInit; ..\..\common\D3DInit.bas
Module=MediaDir; ..\..\common\media.bas
Startup="Form1"
ExeName32="vb_autoparts.exe"
Command32=""
Name="Project1"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="Microsoft Corp"
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1
[MS Transaction Server]
AutoRefresh=1

View File

@@ -0,0 +1,176 @@
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "Data"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' Copyright (C) 1999-2001 Microsoft Corporation. All Rights Reserved.
'
' File: data.cls
' Content: DATA MIDDLEWARE
' replace with your favorite
' database code
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Type rec
AssemblyId As Long
ModelPart As String
PartID As String
Description As String
Price As Currency
CompatibleParts As String
Stock As String
PartMake As String
End Type
Dim rs() As rec
Dim index As Integer
Dim lastindex As Integer
Dim maxsize As Integer
Public Function MoveTop()
index = 0
MoveTop = True
End Function
Public Function IsEOF()
If index = -1 Then IsEOF = True
End Function
Public Function MoveNext()
If index = lastindex Then
index = -1
Exit Function
End If
index = index + 1
MoveNext = True
End Function
Public Property Get ModelPart() As String
ModelPart = rs(index).ModelPart
End Property
Public Property Get PartID() As String
PartID = rs(index).PartID
End Property
Public Property Get Description() As String
Description = rs(index).Description
End Property
Public Property Get Price() As Currency
Price = rs(index).Price
End Property
Public Property Get CompatibleParts() As String
CompatibleParts = rs(index).CompatibleParts
End Property
Public Property Get Stock() As String
Stock = rs(index).Stock
End Property
Public Property Get PartMake() As String
PartMake = rs(index).PartMake
End Property
Public Function MoveToModelPartRecord(sname As String) As Boolean
For index = 0 To lastindex
If (UCase(rs(index).ModelPart) = UCase(sname)) Then
MoveToModelPartRecord = True
Exit Function
End If
Next
MoveToModelPartRecord = False
End Function
Function InitData(sFile As String) As Boolean
Dim strData As String
On Local Error GoTo errOut
ReDim rs(100)
maxsize = 100
Dim fl As Long
fl = FreeFile
index = 0
Open sFile For Input As #fl
Line Input #fl, strData
Do While Not EOF(fl)
Line Input #fl, strData
Dim j As Long, q As Long
Dim r As rec
'Assembly ID - what assembly does this belong to
j = 1
q = InStr(j, strData, Chr(9))
r.AssemblyId = Mid$(strData, 1, q - 1)
'Unique ID for all parts
j = q + 1
q = InStr(j, strData, Chr(9))
r.PartID = Mid$(strData, j, q - j)
'Model Part .. whats the name of the part in the xfile
j = q + 1
q = InStr(j, strData, Chr(9))
r.ModelPart = Mid$(strData, j + 1, q - 2 - j)
'Part Price
j = q + 1
q = InStr(j, strData, Chr(9))
r.Price =val(Mid$(strData, j + 1, q - 1 - j))
'Description
j = q + 1
q = InStr(j, strData, Chr(9))
r.Description = Mid$(strData, j + 1, q - 2 - j)
'Stock
j = q + 1
q = InStr(j, strData, Chr(9))
r.Stock = Mid$(strData, j, q - j)
'PartMake
j = q + 1
q = InStr(j, strData, Chr(9))
r.PartMake = Mid$(strData, j + 1, q - j - 2)
'CompatibleParts
j = q + 1
r.CompatibleParts = Mid$(strData, j + 1)
q = Len(r.CompatibleParts) - 1
r.CompatibleParts = Mid$(r.CompatibleParts, 1, q)
If index > maxsize Then
maxsize = maxsize + 100
ReDim Preserve rs(maxsize)
End If
rs(index) = r
lastindex = index
index = index + 1
Loop
InitData = True
Exit Function
errOut:
InitData = False
End Function

View File

@@ -0,0 +1,43 @@
//-----------------------------------------------------------------------------
//
// Sample Name: AutoParts Sample
//
// Copyright (C) 1999-2001 Microsoft Corporation. All rights reserved.
//
//-----------------------------------------------------------------------------
Description
===========
The AutoParts sample illustrates the use of Picking against a 3D database.
Path
====
Source: DXSDF\Samples\Multimedia\VBSamples\Direct3D\AutoParts
Executable: DXSDF\Samples\Multimedia\VBSamples\Direct3D\Bin
User's Guide
============
click where it says "click here" in the Tree view to the left to load the engine model.
The model can be rotated by holding the left mouse button down and dragging.
When a part has been clicked on, it is described in the lower left hand corner.
The Add and Remove from Invoice button manage the Invoice list but the Order button has
no function.
Programming Notes
=================
Each object in the Engine model is named. These names are unique and can be used to cross
reference a database (a custom text database in this example for the sake of not requiring
the installation of MDAC). From that database more detailed information is gahtered on the
part such as price and part number.
This sample makes use of common DirectX code (consisting of helper functions,
etc.) that is shared with other samples on the DirectX SDK. All common
classes and modules can be found in the following directory:
DXSDF\Samples\Multimedia\VBSamples\Common

File diff suppressed because it is too large Load Diff

View File

@@ -0,0 +1,46 @@
Type=Exe
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#stdole2.tlb#OLE Automation
Reference=*\G{E1211242-8E94-11D1-8808-00C04FC2C603}#1.0#0#dx8vb.dll#DirectX 8 for Visual Basic Type Library
Form=BarGraph.frm
Class=DataEntry; DataEntry.cls
Class=CD3DFrame; ..\..\common\D3DFrame.cls
Class=CD3DMesh; ..\..\common\D3DMesh.cls
Class=CD3DPick; ..\..\common\D3DPick.cls
Module=D3DUtil; ..\..\common\d3dutil.bas
Module=D3DInit; ..\..\common\d3dinit.bas
Class=CD3DAnimation; ..\..\common\D3DAnimation.cls
Object={F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0; comdlg32.ocx
Module=MediaDir; ..\..\common\media.bas
Startup="GraphForm"
HelpFile=""
NoControlUpgrade=1
ExeName32="vb_BarGraph.exe"
Command32=""
Name="BarGraph"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="Microsoft"
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1
UseExistingBrowser=0
[MS Transaction Server]
AutoRefresh=1

View File

@@ -0,0 +1,9 @@
GraphForm = 154, 154, 649, 598, Z, 88, 1, 745, 525, C
DataEntry = 0, 0, 0, 0, C
CD3DFrame = 22, 22, 671, 419,
CD3DMesh = 44, 44, 693, 441,
CD3DPick = 44, 44, 693, 441,
D3DUtil = 110, 110, 605, 554,
D3DInit = 132, 132, 627, 576,
CD3DAnimation = 0, 0, 0, 0, C
MediaDir = 154, 154, 622, 598, C

View File

@@ -0,0 +1,39 @@
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "DataEntry"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' Copyright (C) 1999-2001 Microsoft Corporation. All Rights Reserved.
'
' File: DataEntry.cls
' Content: Class for one data point
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public dataname As String
Public X As Single
Public Y As Single
Public z As Single
Public datax As Double
Public datay As Double
Public dataz As Double
Public dataSize As Double
Public size As Double
Public color As Long
Public data As Variant
Public mesh As D3DXMesh

View File

@@ -0,0 +1,60 @@
//-----------------------------------------------------------------------------
//
// Sample Name: BarGraph Sample
//
// Copyright (C) 1999-2001 Microsoft Corporation. All rights reserved.
//
//-----------------------------------------------------------------------------
Description
===========
The BarGraph sample describes how one might use Direct3D for graphic visualization.
It makes heavy use of the RenderToSurface features of D3DX to render text and bitmaps
dynamically.
Path
====
Source: DXSDK\Samples\Multimedia\VBSamples\Direct3D\BarGraph
Executable: DXSDK\Samples\Multimedia\VBSamples\Direct3D\Bin
User's Guide
============
right click to bring up a pop up menu.
from this menu you can load new data from a .csv (comma delimeted file)
such a file can be exported from excel or any spreadsheet package.
The file must be formated such that the first row and columns are headers
that title the data. They can contain the tag TEXTURE:filename.bmp to indicate
that the header contains a picture. the rest of the data must be numeric
see bargraphdata.csv in Mssd\Samples\Multimedia\VBSamples\Media for an example
Holding the left mouse button and dragging will rotate the graph.
Right Arrow moves the camera right
Left Arrow moves the camera left
Up Arrow moves the camera up
Down Arrow moves the camera down
W moves the camera forward
S moves the camera backward
E rotates the camera right
Q rotates the camera left
A rotates the camera up
Z rotates the camera down
Programming Notes
=================
This sample makes use of common DirectX code (consisting of helper functions,
etc.) that is shared with other samples on the DirectX SDK. All common
classes and modules can be found in the following directory:
DXSDK\Samples\Multimedia\VBSamples\Common

View File

@@ -0,0 +1,736 @@
VERSION 5.00
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 4290
ClientLeft = 60
ClientTop = 345
ClientWidth = 5580
Icon = "billboard.frx":0000
LinkTopic = "Form1"
ScaleHeight = 286
ScaleMode = 3 'Pixel
ScaleWidth = 372
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
'-----------------------------------------------------------------------------
' File: Billboard.frm
'
' Desc: Example code showing how to do billboarding. The sample uses
' billboarding to draw some trees.
'
' Note: this implementation is for billboards that are fixed to rotate
' about the Y-axis, which is good for things like trees. For
' unconstrained billboards, like explosions in a flight sim, the
' technique is the same, but the the billboards are positioned slightly
' different. Try using the inverse of the view matrix, TL-vertices, or
' some other technique.
'
' Copyright (C) 1999-2001 Microsoft Corporation. All rights reserved.
'-----------------------------------------------------------------------------
Option Explicit
'-----------------------------------------------------------------------------
' Defines, constants, and global variables
'-----------------------------------------------------------------------------
Const NUM_TREES = 200
Const D3DFVF_TREEVERTEX = (D3DFVF_XYZ Or D3DFVF_DIFFUSE Or D3DFVF_TEX1)
Const NUMTREETEXTURES = 3
' Custom vertex type for the trees
Private Type TREEVERTEX
p As D3DVECTOR
color As Long
tu As Single
tv As Single
End Type
Dim m_bInit As Boolean ' Indicates that d3d has been initialized
Dim m_bMinimized As Boolean ' Indicates that display window is minimized
'-----------------------------------------------------------------------------
' Name: Tree
' Desc: Simple structure to hold data for rendering a tree
'-----------------------------------------------------------------------------
Private Type TREE
v(3) As TREEVERTEX
vPos As D3DVECTOR
iTreeTexture As Long
iNext As Long
dist As Single
End Type
Private Type HILLVERTEX
x As Single
y As Single
z As Single
tu As Single
tv As Single
End Type
Dim m_vEyePt As D3DVECTOR
Dim m_strTreeTextures(3) As String
Dim m_media As String
Dim m_Terrain As CD3DMesh
Dim m_SkyBox As CD3DMesh ' Skybox background object
Dim m_TreeVB As Direct3DVertexBuffer8 ' Vertex buffer for rendering a tree
Dim m_TreeTextures(NUMTREETEXTURES) ' Tree images
Dim m_matBillboardMatrix As D3DMATRIX ' Used for billboard orientation
Dim m_Trees(NUM_TREES) As TREE ' Array of tree info
Dim m_fTime As Single
Dim m_iTreeHead As Long
Dim m_iSortHead As Long
'-----------------------------------------------------------------------------
' Name: Form_Load()
' Desc:
'-----------------------------------------------------------------------------
Private Sub Form_Load()
Me.Show
DoEvents
'Setup defaults
Init
' 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 media and set media directory
m_media = FindMediaDir("Tree02S.tga")
D3DUtil_SetMediaPath m_media
' Initialize Application Data
OneTimeSceneInit
' Create and load mesh objects
InitDeviceObjects
' Sets the state for those objects and the current D3D device
' (setup camera and lights etc)
RestoreDeviceObjects
' Start application 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
If Render Then 'Success
' Present the image to the screen
D3DUtil_PresentAll g_focushwnd
End If
' 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)
Dim hr As Long
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
hr = D3DUtil_ResetFullscreen
Else
hr = D3DUtil_ResetWindowed
End If
' Call Restore after ever mode change
' because calling reset looses state that needs to
' be reinitialized
If (hr = D3D_OK) Then
RestoreDeviceObjects
End If
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
RestoreDeviceObjects
End Sub
'-----------------------------------------------------------------------------
' Name: Form_Unload()
' Desc:
'-----------------------------------------------------------------------------
Private Sub Form_Unload(Cancel As Integer)
DeleteDeviceObjects
End
End Sub
' Simple function to define "hilliness" for terrain
Function HeightField(x As Single, y As Single) As Single
HeightField = 9 * (Cos(x / 20 + 0.2) * Cos(y / 15 - 0.2) + 1#)
End Function
Sub Init()
m_strTreeTextures(0) = "Tree02S.tga"
m_strTreeTextures(1) = "Tree35S.tga"
m_strTreeTextures(2) = "Tree01S.tga"
Me.Caption = ("Billboard: D3D Billboarding Example")
Set m_SkyBox = New CD3DMesh
Set m_Terrain = New CD3DMesh
Set m_TreeVB = Nothing
End Sub
'-----------------------------------------------------------------------------
' Name: OneTimeSceneInit()
' Desc: Called during initial app startup, this function performs all the
' permanent initialization.
'-----------------------------------------------------------------------------
Sub OneTimeSceneInit()
Dim i As Long
Dim fTheta As Single, fRadius As Single, fWidth As Single, fHeight As Single
Dim r As Long, g As Long, b As Long, treecolor As Long
Rnd (1)
' Initialize the tree data
For i = 0 To NUM_TREES - 1
' Position the trees randomly
fTheta = 2 * g_pi * Rnd()
fRadius = 25 + 55 * Rnd()
m_Trees(i).vPos.x = fRadius * Sin(fTheta)
m_Trees(i).vPos.z = fRadius * Cos(fTheta)
m_Trees(i).vPos.y = HeightField(m_Trees(i).vPos.x, m_Trees(i).vPos.z)
' Size the trees randomly
fWidth = 1 + 0.2 * (Rnd() - Rnd())
fHeight = 1.4 + 0.4 * (Rnd() - Rnd())
' Each tree is a random color between red and green
r = (255 - 190) + CLng(190 * Rnd())
g = (255 - 190) + CLng(190 * Rnd())
b = 0
treecolor = &HFF000000 + r * 2 ^ 16 + g * 2 ^ 8 + b
m_Trees(i).v(0).p = vec3(-fWidth, 0 * fHeight, 0)
m_Trees(i).v(0).color = treecolor
m_Trees(i).v(0).tu = 0: m_Trees(i).v(0).tv = 1
m_Trees(i).v(1).p = vec3(-fWidth, 2 * fHeight, 0)
m_Trees(i).v(1).color = treecolor
m_Trees(i).v(1).tu = 0: m_Trees(i).v(1).tv = 0
m_Trees(i).v(2).p = vec3(fWidth, 0 * fHeight, 0)
m_Trees(i).v(2).color = treecolor
m_Trees(i).v(2).tu = 1: m_Trees(i).v(2).tv = 1
m_Trees(i).v(3).p = vec3(fWidth, 2 * fHeight, 0)
m_Trees(i).v(3).color = treecolor
m_Trees(i).v(3).tu = 1: m_Trees(i).v(3).tv = 0
' Size the trees randomly
m_Trees(i).iTreeTexture = CLng((NUMTREETEXTURES - 1) * Rnd())
m_Trees(i).iNext = i + 1
Next
m_Trees(NUM_TREES - 1).iNext = -1 'use -1 to indicate end of the list
End Sub
'-----------------------------------------------------------------------------
' Name: Sort
' Desc: Callback function for sorting trees in back-to-front order
'-----------------------------------------------------------------------------
Sub DoSort()
Dim i As Long
Dim dx As Single, dz As Single, dist As Single
'calculate the square of the distance to the eyept
'to best approximate sort order
'CONSIDER transforming the position into screen space and sorting on z/w
For i = 0 To NUM_TREES - 1
dx = m_Trees(i).vPos.x - m_vEyePt.x
dz = m_Trees(i).vPos.z - m_vEyePt.z
m_Trees(i).dist = dx * dx + dz * dz
Next
Dim iAtU As Long
Dim iPrevU As Long
Dim iNextU As Long
iAtU = m_iTreeHead
iPrevU = -1
iNextU = -1
m_iSortHead = -1
Dim z As Long
Dim q As Long
Do While iAtU <> -1
dist = m_Trees(iAtU).dist
iNextU = m_Trees(iAtU).iNext
InsertIntoList iAtU, dist
'advance to next item in Unsorted list
iPrevU = iAtU
iAtU = iNextU
Loop
m_iTreeHead = m_iSortHead
End Sub
Sub InsertIntoList(iNode As Long, dist2 As Single)
Dim iAtS As Long
Dim iPrevS As Long
iAtS = m_iSortHead
iPrevS = -1
'If Sorted list is empty add first node
If iAtS = -1 Then
m_iSortHead = iNode
m_Trees(iNode).iNext = -1
Exit Sub
End If
'see if we need to add at begining
If m_Trees(m_iSortHead).dist < dist2 Then
m_Trees(iNode).iNext = m_iSortHead
m_iSortHead = iNode
Exit Sub
End If
'we dont have an empty list
'we dont need to add to front of list
Do While iAtS <> -1
If m_Trees(iAtS).dist < dist2 Then
'add to sorted list
m_Trees(iNode).iNext = m_Trees(iPrevS).iNext
m_Trees(iPrevS).iNext = iNode
Exit Sub
End If
'advance to next item in sorted list
iPrevS = iAtS
iAtS = m_Trees(iAtS).iNext
Loop
'must go at end of list
m_Trees(iPrevS).iNext = iNode
m_Trees(iNode).iNext = -1
End Sub
'-----------------------------------------------------------------------------
' Name: FrameMove()
' Desc: Called once per frame, the call is the entry point for animating
' the scene.
'-----------------------------------------------------------------------------
Sub FrameMove()
m_fTime = DXUtil_Timer(TIMER_GETAPPTIME)
' Get the eye and lookat points from the camera's path
Dim vUpVec As D3DVECTOR, vEyePt As D3DVECTOR, vLookAtpt As D3DVECTOR
vUpVec = vec3(0, 1, 0)
vEyePt.x = 30 * Cos(0.8 * (m_fTime + 1))
vEyePt.z = 30 * Sin(0.8 * (m_fTime + 1))
vEyePt.y = 4 + HeightField(vEyePt.x, vEyePt.z)
vLookAtpt.x = 30 * Cos(0.8 * (m_fTime + 1.5))
vLookAtpt.z = 30 * Sin(0.8 * (m_fTime + 1.5))
vLookAtpt.y = vEyePt.y - 1
' Set the app view matrix for normal viewing
Dim matView As D3DMATRIX
D3DXMatrixLookAtLH matView, vEyePt, vLookAtpt, vUpVec
g_dev.SetTransform D3DTS_VIEW, matView
' Set up a rotation matrix to orient the billboard towards the camera.
Dim vDir As D3DVECTOR
D3DXVec3Subtract vDir, vLookAtpt, vEyePt
If (vDir.x > 0) Then
D3DXMatrixRotationY m_matBillboardMatrix, -Atn(vDir.z / vDir.x) + (g_pi / 2)
Else
D3DXMatrixRotationY m_matBillboardMatrix, -Atn(vDir.z / vDir.x) - (g_pi / 2)
End If
' Sort trees in back-to-front order
m_vEyePt = vEyePt
DoSort
End Sub
'-----------------------------------------------------------------------------
' Name: DrawTrees()
' Desc:
'-----------------------------------------------------------------------------
Sub DrawTrees()
Dim i As Long
' Set diffuse blending for alpha set in vertices.
g_dev.SetRenderState D3DRS_ALPHABLENDENABLE, 1 'TRUE
g_dev.SetRenderState D3DRS_SRCBLEND, D3DBLEND_SRCALPHA
g_dev.SetRenderState D3DRS_DESTBLEND, D3DBLEND_INVSRCALPHA
' Enable alpha testing (skips pixels with less than a certain alpha.)
If ((g_d3dCaps.AlphaCmpCaps And D3DPCMPCAPS_GREATEREQUAL) = D3DPCMPCAPS_GREATEREQUAL) Then
g_dev.SetRenderState D3DRS_ALPHATESTENABLE, 1 'TRUE
g_dev.SetRenderState D3DRS_ALPHAREF, &H8&
g_dev.SetRenderState D3DRS_ALPHAFUNC, D3DCMP_GREATEREQUAL
End If
' Loop through and render all trees
'For i = 0 To NUM_TREES
i = m_iTreeHead
Do While i <> -1
' Set the tree texture
g_dev.SetTexture 0, m_TreeTextures(m_Trees(i).iTreeTexture)
' Translate the billboard into place
m_matBillboardMatrix.m41 = m_Trees(i).vPos.x
m_matBillboardMatrix.m42 = m_Trees(i).vPos.y
m_matBillboardMatrix.m43 = m_Trees(i).vPos.z
g_dev.SetTransform D3DTS_WORLD, m_matBillboardMatrix
' Copy tree mesh into vertexbuffer
Dim v As TREEVERTEX
D3DVertexBuffer8SetData m_TreeVB, 0, Len(v) * 4, 0, m_Trees(i).v(0)
' Render the billboards one at a time
' CONSIDER: putting this in larger vertex buffers sorted by texture
g_dev.SetStreamSource 0, m_TreeVB, Len(v)
g_dev.SetVertexShader D3DFVF_TREEVERTEX
g_dev.DrawPrimitive D3DPT_TRIANGLESTRIP, 0, 2
i = m_Trees(i).iNext
Loop
'Next
' Restore state
Dim matWorld As D3DMATRIX
D3DXMatrixIdentity matWorld
g_dev.SetTransform D3DTS_WORLD, matWorld
g_dev.SetRenderState D3DRS_ALPHATESTENABLE, 0 ' FALSE
g_dev.SetRenderState D3DRS_ALPHABLENDENABLE, 0 ' FALSE
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.
'-----------------------------------------------------------------------------
Function Render() As Boolean
Dim matView As D3DMATRIX, matViewSave As D3DMATRIX, hr As Long
Render = False
'See what state the device is in.
hr = g_dev.TestCooperativeLevel
If hr = D3DERR_DEVICENOTRESET Then
On Error Resume Next
g_dev.Reset g_d3dpp
If (Err.Number = D3D_OK) Then
RestoreDeviceObjects
End If
On Error GoTo 0
ElseIf hr <> 0 Then
Exit Function 'dont bother rendering if we are not ready yet
End If
Render = True
' Clear the viewport
g_dev.Clear ByVal 0, ByVal 0, D3DCLEAR_ZBUFFER, &H0, 1, 0
' Begin the scene
g_dev.BeginScene
' Render the Skybox
' Center view matrix for skybox and disable zbuffer
g_dev.GetTransform D3DTS_VIEW, matViewSave
matView = matViewSave
matView.m41 = 0: matView.m42 = -0.3: matView.m43 = 0
g_dev.SetTransform D3DTS_VIEW, matView
g_dev.SetRenderState D3DRS_ZENABLE, 0 ' FALSE
' Render the skybox
m_SkyBox.Render g_dev
' Restore the render states
g_dev.SetTransform D3DTS_VIEW, matViewSave
g_dev.SetRenderState D3DRS_ZENABLE, 1 'TRUE
' Draw the terrain
m_Terrain.Render g_dev
' Draw the trees
DrawTrees
' End the scene.
g_dev.EndScene
End Function
'-----------------------------------------------------------------------------
' Name: InitDeviceObjects()
' Desc: This creates all device-dependant managed objects, such as managed
' textures and managed vertex buffers.
'-----------------------------------------------------------------------------
Sub InitDeviceObjects()
Dim i As Long
Dim v As TREEVERTEX
' Create the tree textures
For i = 0 To NUMTREETEXTURES - 1
Set m_TreeTextures(i) = g_d3dx.CreateTextureFromFileEx(g_dev, m_media + m_strTreeTextures(i), 256, 256, D3DX_DEFAULT, 0, D3DFMT_A1R5G5B5, D3DPOOL_MANAGED, D3DX_DEFAULT, D3DX_DEFAULT, &HFF000000, ByVal 0, ByVal 0)
Next
' Create a quad for rendering each tree
Set m_TreeVB = g_dev.CreateVertexBuffer(4 * Len(v), 0, D3DFVF_TREEVERTEX, D3DPOOL_MANAGED)
' Load the skybox
m_SkyBox.InitFromFile g_dev, m_media + "SkyBox2.x"
' Load the terrain
m_Terrain.InitFromFile g_dev, m_media + "SeaFloor.x"
' Add some "hilliness" to the terrain
Dim HillVB As Direct3DVertexBuffer8, NumHillVerts As Long
Dim HillVerts() As HILLVERTEX
Set HillVB = m_Terrain.mesh.GetVertexBuffer()
NumHillVerts = m_Terrain.mesh.GetNumVertices
ReDim HillVerts(NumHillVerts)
D3DVertexBuffer8GetData HillVB, 0, NumHillVerts * Len(HillVerts(0)), 0, HillVerts(0)
For i = 0 To NumHillVerts - 1
HillVerts(i).y = HeightField(HillVerts(i).x, HillVerts(i).z)
Next
D3DVertexBuffer8SetData HillVB, 0, NumHillVerts * Len(HillVerts(0)), 0, HillVerts(0)
End Sub
'-----------------------------------------------------------------------------
' Name: RestoreDeviceObjects()
' Desc: Restore device-memory objects and state after a device is created or
' resized.
'-----------------------------------------------------------------------------
Sub RestoreDeviceObjects()
' Restore the device objects for the meshes and fonts
m_Terrain.RestoreDeviceObjects g_dev
m_SkyBox.RestoreDeviceObjects g_dev
' Set the transform matrices (view and world are updated per frame)
Dim matProj As D3DMATRIX
D3DXMatrixPerspectiveFovLH matProj, g_pi / 4, Me.ScaleHeight / Me.ScaleWidth, 1, 100
g_dev.SetTransform D3DTS_PROJECTION, matProj
' Set up the default texture states
g_dev.SetTextureStageState 0, D3DTSS_COLOROP, D3DTOP_SELECTARG1
g_dev.SetTextureStageState 0, D3DTSS_COLORARG1, D3DTA_TEXTURE
g_dev.SetTextureStageState 0, D3DTSS_ALPHAOP, D3DTOP_SELECTARG1
g_dev.SetTextureStageState 0, D3DTSS_ALPHAARG1, D3DTA_TEXTURE
g_dev.SetTextureStageState 0, D3DTSS_MINFILTER, D3DTEXF_LINEAR
g_dev.SetTextureStageState 0, D3DTSS_MAGFILTER, D3DTEXF_LINEAR
g_dev.SetTextureStageState 0, D3DTSS_ADDRESSU, D3DTADDRESS_CLAMP
g_dev.SetTextureStageState 0, D3DTSS_ADDRESSV, D3DTADDRESS_CLAMP
g_dev.SetRenderState D3DRS_DITHERENABLE, 1 'TRUE
g_dev.SetRenderState D3DRS_ZENABLE, 1 'TRUE )
g_dev.SetRenderState D3DRS_LIGHTING, 0 'FALSE )
End Sub
'-----------------------------------------------------------------------------
' Name: InvalidateDeviceObjects()
' Desc: Called when the device-dependant objects are about to be lost.
'-----------------------------------------------------------------------------
Sub InvalidateDeviceObjects()
m_Terrain.InvalidateDeviceObjects
m_SkyBox.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()
Dim i As Long
m_Terrain.Destroy
m_SkyBox.Destroy
For i = 0 To NUMTREETEXTURES - 1
Set m_TreeTextures(i) = Nothing
Next
m_bInit = False
End Sub
'-----------------------------------------------------------------------------
' Name: FinalCleanup()
' Desc: Called before the app exits, this function gives the app the chance
' to cleanup after itself.
'-----------------------------------------------------------------------------
Sub FinalCleanup()
Set m_Terrain = Nothing
Set m_SkyBox = Nothing
End Sub
'-----------------------------------------------------------------------------
' Name: VerifyDevice()
' Desc: Called during device intialization, this code checks the device
' for some minimum set of capabilities
'-----------------------------------------------------------------------------
Public Function VerifyDevice(usageflags As Long, format As CONST_D3DFORMAT) As Boolean
' This sample uses alpha textures and/or straight alpha. Make sure the
' device supports them
If ((g_d3dCaps.TextureCaps And D3DPTEXTURECAPS_ALPHAPALETTE) = D3DPTEXTURECAPS_ALPHAPALETTE) Then VerifyDevice = True
If ((g_d3dCaps.TextureCaps And D3DPTEXTURECAPS_ALPHA) = D3DPTEXTURECAPS_ALPHA) Then VerifyDevice = True
End Function

View File

@@ -0,0 +1,41 @@
Type=Exe
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#stdole2.tlb#OLE Automation
Reference=*\G{E1211242-8E94-11D1-8808-00C04FC2C603}#1.0#0#dx8vb.dll#DirectX 8 for Visual Basic Type Library
Form=billboard.frm
Module=MediaDir; ..\..\common\media.bas
Module=D3DInit; ..\..\common\D3DInit.bas
Module=D3DUtil; ..\..\common\D3DUtil.bas
Class=CD3DFrame; ..\..\common\D3DFrame.cls
Class=CD3DAnimation; ..\..\common\D3DAnimation.cls
Class=CD3DMesh; ..\..\common\D3DMesh.cls
Form=..\..\common\SelectDevice.frm
Startup="Form1"
ExeName32="vb_billboard.exe"
Command32=""
Name="Billboard"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="Microsoft"
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1
[MS Transaction Server]
AutoRefresh=1

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.1 KiB

View File

@@ -0,0 +1,60 @@
//-----------------------------------------------------------------------------
// Name: Billboard Direct3D Sample
//
// Copyright (C) 1999-2001 Microsoft Corporation. All rights reserved.
//-----------------------------------------------------------------------------
Description
===========
The Billboard sample illustrates the billboarding technique. Rather than
rendering complex 3D models (such as a high-polygon tree model),
billboarding renders a 2D image of the model and rotates it to always face
the eyepoint. This technique is commonly used to render trees, clouds,
smoke, explosions, and more. For more information, see
Common Techniques and Special Effects.
The sample has a camera fly around a 3D scene with a tree-covered hill. The
trees look like 3D objects, but they are actually 2-D billboarded images
that are rotated towards the eye point. The hilly terrain and the skybox
(6-sided cube containing sky textures) are just objects loaded from .x
files, used for visual effect, and are unrelated to the billboarding
technique.
Path
====
Source: DXSDK\Samples\Multimedia\Vbsamples\Direct3D\Billboard
Executable: DXSDK\Samples\Multimedia\vbsamples\Direct3D\Bin
User's Guide
============
The following keys are implemented. The dropdown menus can be used for the
same controls.
<F2> Prompts user to select a new rendering device or display mode
<Alt+Enter> Toggles between fullscreen and windowed modes
<Esc> Exits the app.
Programming Notes
=================
The billboarding technique is the focus of this sample. Each frame, the
camera is moved, so the viewpoint changes accordingly. As the viewpoint
changes, a rotation matrix is generated to rotate the billboards about
the y-axis so that they face the new viewpoint. The computation of the
billboard matrix occurs in the FrameMove() function. The trees are also
sorted in that function, as required for proper alpha blanding, since
billboards typically have some transparent pixels. The trees are
rendered from a vertex buffer in the DrawTrees() function.
Note that the billboards in this sample are constrained to rotate about the
y-axis only, as otherwise the tree trunks would appear to not be fixed to
the ground. In a 3D flight sim or space shooter, for effects like
explosions, billboards are typically not constrained to one axis.
This sample makes use of common DirectX code (consisting of helper functions,
etc.) that is shared with other samples on the DirectX SDK. All common
classes and modules can be found in the following directory:
DXSDK\Samples\Multimedia\VBSamples\Common

View File

@@ -0,0 +1,723 @@
VERSION 5.00
Begin VB.Form Form1
Caption = "Dolphin: Blending Meshes in Real Time"
ClientHeight = 4290
ClientLeft = 60
ClientTop = 345
ClientWidth = 5580
Icon = "dolphin.frx":0000
LinkTopic = "Form1"
ScaleHeight = 286
ScaleMode = 3 'Pixel
ScaleWidth = 372
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
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' Copyright (C) 1999-2001 Microsoft Corporation. All Rights Reserved.
'
' File: Dolphin.frm
' Content: Sample of swimming dolphin
' This code uses the D3D Framework helper library.
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
'-----------------------------------------------------------------------------
' Globals variables and definitions
'-----------------------------------------------------------------------------
Const WATER_COLOR = &H6688&
Const AMBIENT_COLOR = &H33333333
Const kMesh1 = 0
Const kMesh2 = 1
Const kMesh3 = 2
'Vertex type to be sent to D3D
Private Type DOLPHINVERTEX
p As D3DVECTOR 'position of vertex
n As D3DVECTOR 'normal of vertex
tu As Single 'texture coordinate u
tv As Single 'texture coordinate v
End Type
'VertexFormat to be sent to D3D to describe what
'elements DOLPHINVERTEX uses
Const VertexFVF& = D3DFVF_XYZ Or D3DFVF_NORMAL Or D3DFVF_TEX1
'Helper structure to manage moving vertex information
'from d3dvertex buffers to a vb array
Private Type MESHTOOL
VertB As Direct3DVertexBuffer8
NumVertices As Long
Vertices() As DOLPHINVERTEX
End Type
'Dolphin objects
Dim m_DolphinGroupObject As CD3DFrame ' Frame that contains all mesh poses
Dim m_DolphinMesh01 As CD3DMesh ' Dolphin Mesh in pose 1
Dim m_DolphinMesh02 As CD3DMesh ' Dolphin Mesh in pose 2 (rest pose)
Dim m_DolphinMesh03 As CD3DMesh ' Dolphin Mesh in pose 3
Dim m_DolphinObject As CD3DFrame ' Frame that contains current pose
Dim m_DolphinMesh As CD3DMesh ' Dolphin Mesh in current pose
Dim m_DolphinTex As Direct3DTexture8 ' Dolphin texture
'Seafloor objects
Dim m_FloorObject As CD3DFrame ' Frame that contains seafloor mesh
Dim m_SeaFloorMesh As CD3DMesh ' Seafloor Mesh
Dim m_meshtool(3) As MESHTOOL ' VertexInformation on the 3 poses
Dim m_dest As MESHTOOL ' VertexInformation on the current pose
'Textures for the water caustics
Dim m_CausticTextures() As Direct3DTexture8 ' Array of caustic textures
Dim m_CurrentCausticTexture As Direct3DTexture8 ' Current texture
Dim m_media As String ' Path to media
Dim g_ftime As Single ' Current time in simulation
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: Main entry point for the sample
'-----------------------------------------------------------------------------
Private Sub Form_Load()
' Show the form
Me.Show
DoEvents
' 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_media = FindMediaDir("dolphin_group.x")
D3DUtil_SetMediaPath m_media
' 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
If Render Then 'It was successfull
' Present the image to the screen
D3DUtil_PresentAll g_focushwnd
End If
' 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
RestoreDeviceObjects
End Sub
'-----------------------------------------------------------------------------
' Name: Form_Unload()
' Desc:
'-----------------------------------------------------------------------------
Private Sub Form_Unload(Cancel As Integer)
DeleteDeviceObjects
End
End Sub
'-----------------------------------------------------------------------------
' Name: InitDeviceObjects()
' Desc: Create mesh and texture objects
'-----------------------------------------------------------------------------
Function InitDeviceObjects() As Boolean
Dim b As Boolean
Dim t As Long
Dim strName As String
Dim i As Long
'Allocate an array for the caustic textures
ReDim m_CausticTextures(32)
'Load caustic textures into an array
For t = 0 To 31
strName = m_media + "Caust" + format$(t, "00") + ".tga"
Set m_CausticTextures(t) = D3DUtil_CreateTexture(g_dev, strName, D3DFMT_UNKNOWN)
If m_CausticTextures(t) Is Nothing Then Debug.Print "Unable to find media " + strName
Next
' Load the file-based mesh objects
Set m_DolphinGroupObject = D3DUtil_LoadFromFile(m_media + "dolphin_group.x", Nothing, Nothing)
Set m_DolphinObject = D3DUtil_LoadFromFile(m_media + "dolphin.x", Nothing, Nothing)
Set m_FloorObject = D3DUtil_LoadFromFile(m_media + "seafloor.x", Nothing, Nothing)
' Gain access to the meshes from the parent frames
Set m_DolphinMesh01 = m_DolphinGroupObject.FindChildObject("Dolph01", 0)
Set m_DolphinMesh02 = m_DolphinGroupObject.FindChildObject("Dolph02", 0)
Set m_DolphinMesh03 = m_DolphinGroupObject.FindChildObject("Dolph03", 0)
Set m_DolphinMesh = m_DolphinObject.FindChildObject("Dolph02", 0).GetChildMesh(0)
Set m_SeaFloorMesh = m_FloorObject.FindChildObject("SeaFloor", 0)
' Set the FVF (flexible vertex format) to one we reconginze
Call m_DolphinMesh01.SetFVF(g_dev, VertexFVF)
Call m_DolphinMesh02.SetFVF(g_dev, VertexFVF)
Call m_DolphinMesh03.SetFVF(g_dev, VertexFVF)
Call m_DolphinMesh.SetFVF(g_dev, VertexFVF)
Call m_SeaFloorMesh.SetFVF(g_dev, VertexFVF)
' Load the texture for the dolphin's skin
Set m_DolphinTex = D3DUtil_CreateTexture(g_dev, m_media + "dolphin.bmp", D3DFMT_UNKNOWN)
' The folowing scales the sea floor vertices, and adds some bumpiness
Dim seafloortool As MESHTOOL
' Meshtool init copies mesh vertices from the mesh object into the
' seafloortool.vertices array
MESHTOOL_INIT seafloortool, m_SeaFloorMesh.mesh
' Loop through and modify height (y) of vertices
For i = 0 To seafloortool.NumVertices - 1
seafloortool.Vertices(i).p.y = seafloortool.Vertices(i).p.y + Rnd(1) + Rnd(1) + Rnd(1)
seafloortool.Vertices(i).tu = seafloortool.Vertices(i).tu * 10
seafloortool.Vertices(i).tv = seafloortool.Vertices(i).tv * 10
Next
' Save modified vertices back to the vertex buffer and cleanup seafloortool object
D3DVertexBuffer8SetData seafloortool.VertB, 0, Len(seafloortool.Vertices(0)) * seafloortool.NumVertices, 0, seafloortool.Vertices(0)
MESHTOOL_DESTROY seafloortool
' Extract vertex information for the 3 dolphin poses
MESHTOOL_INIT m_meshtool(kMesh1), m_DolphinMesh01.mesh
MESHTOOL_INIT m_meshtool(kMesh2), m_DolphinMesh02.mesh
MESHTOOL_INIT m_meshtool(kMesh3), m_DolphinMesh03.mesh
' size Vertices array for the current pose
MESHTOOL_INIT m_dest, m_DolphinMesh.mesh
InitDeviceObjects = True
End Function
'-----------------------------------------------------------------------------
' Name: RestoreDeviceObjects()
' Desc: Restore device-memory objects and state after a device is created or
' resized.
'-----------------------------------------------------------------------------
Public Sub RestoreDeviceObjects()
'Restore Mesh objects
m_DolphinGroupObject.RestoreDeviceObjects g_dev
m_DolphinObject.RestoreDeviceObjects g_dev
m_FloorObject.RestoreDeviceObjects g_dev
With g_dev
' Set world transform
Dim matWorld As D3DMATRIX
D3DXMatrixIdentity matWorld
.SetTransform D3DTS_WORLD, matWorld
' Set the view matrix for normal viewing
Dim vEyePt As D3DVECTOR, vLookatPt As D3DVECTOR, vUpVec As D3DVECTOR
Dim matView As D3DMATRIX
vEyePt = vec3(0, 0, -5)
vLookatPt = vec3(0, 0, 0)
vUpVec = vec3(0, 1, 0)
D3DXMatrixLookAtLH matView, vEyePt, vLookatPt, vUpVec
.SetTransform D3DTS_VIEW, matView
' Set the projection matrix
Dim matProj As D3DMATRIX
Dim fAspect As Single
fAspect = Me.ScaleHeight / Me.ScaleWidth
D3DXMatrixPerspectiveFovLH matProj, g_pi / 3, fAspect, 1, 10000
.SetTransform D3DTS_PROJECTION, matProj
' Set texture stages to modulate the diffuse color with the texture color
.SetTextureStageState 0, D3DTSS_COLORARG1, D3DTA_TEXTURE
.SetTextureStageState 0, D3DTSS_COLORARG2, D3DTA_DIFFUSE
.SetTextureStageState 0, D3DTSS_COLOROP, D3DTOP_MODULATE
.SetTextureStageState 0, D3DTSS_MINFILTER, D3DTEXF_LINEAR
.SetTextureStageState 0, D3DTSS_MAGFILTER, D3DTEXF_LINEAR
.SetTextureStageState 1, D3DTSS_MINFILTER, D3DTEXF_LINEAR
.SetTextureStageState 1, D3DTSS_MAGFILTER, D3DTEXF_LINEAR
' Set default render states
.SetRenderState D3DRS_DITHERENABLE, 1 'True
.SetRenderState D3DRS_SPECULARENABLE, 0 'False
.SetRenderState D3DRS_ZENABLE, 1 'True
.SetRenderState D3DRS_NORMALIZENORMALS, 1 'True
' Turn on fog, for underwater effect
Dim fFogStart As Single
Dim fFogEnd As Single
fFogStart = 1
fFogEnd = 50
.SetRenderState D3DRS_FOGENABLE, 1 ' True
.SetRenderState D3DRS_FOGCOLOR, WATER_COLOR
.SetRenderState D3DRS_FOGTABLEMODE, D3DFOG_NONE
.SetRenderState D3DRS_FOGVERTEXMODE, D3DFOG_LINEAR
.SetRenderState D3DRS_RANGEFOGENABLE, 0 'False
.SetRenderState D3DRS_FOGSTART, FtoDW(fFogStart)
.SetRenderState D3DRS_FOGEND, FtoDW(fFogEnd)
' Create a directional light pointing straight down
Dim light As D3DLIGHT8
D3DUtil_InitLight light, D3DLIGHT_DIRECTIONAL, 0, -1, 0
.SetLight 0, light
.LightEnable 0, 1 'True
.SetRenderState D3DRS_LIGHTING, 1 'TRUE
.SetRenderState D3DRS_AMBIENT, AMBIENT_COLOR
End With
End Sub
'-----------------------------------------------------------------------------
' Name: MESHTOOL_INIT()
' Desc:
'-----------------------------------------------------------------------------
Private Sub MESHTOOL_INIT(mt As MESHTOOL, m As D3DXMesh)
Set mt.VertB = m.GetVertexBuffer
mt.NumVertices = m.GetNumVertices
ReDim mt.Vertices(mt.NumVertices)
D3DVertexBuffer8GetData mt.VertB, 0, mt.NumVertices * Len(mt.Vertices(0)), 0, mt.Vertices(0)
End Sub
'-----------------------------------------------------------------------------
' Name: MESHTOOL_DESTROY()
' Desc:
'-----------------------------------------------------------------------------
Private Sub MESHTOOL_DESTROY(mt As MESHTOOL)
Set mt.VertB = Nothing
ReDim mt.Vertices(0)
End Sub
'-----------------------------------------------------------------------------
' Name: FrameMove()
' Desc: Called once per image frame, the call is the entry point for animating
' the scene.
'-----------------------------------------------------------------------------
Sub FrameMove()
'Dont do anything if in a minimized state
If m_bMinimized = True Then Exit Sub
'Get the time as a single
g_ftime = DXUtil_Timer(TIMER_GETAPPTIME) * 0.9
Dim fKickFreq As Single, fPhase As Single, fBlendWeight As Single
'compute time based inputs
fKickFreq = g_ftime * 2
fPhase = g_ftime / 3
fBlendWeight = Sin(fKickFreq)
' Blend the meshes (which makes the dolphin appear to swim)
Call BlendMeshes(fBlendWeight)
' Move the dolphin in a circle and have it undulate
Dim vTrans As D3DVECTOR
Dim qRot As D3DQUATERNION
Dim matDolphin As D3DMATRIX
Dim matTrans As D3DMATRIX, matRotate1 As D3DMATRIX, matRotate2 As D3DMATRIX
'Scale dolphin geometery to 1/100 original
D3DXMatrixScaling matDolphin, 0.01, 0.01, 0.01
'add up and down roation (since modeled along x axis)
D3DXMatrixRotationZ matRotate1, -Cos(fKickFreq) / 6
D3DXMatrixMultiply matDolphin, matDolphin, matRotate1
'add rotation to make dolphin point at tangent to the circle
D3DXMatrixRotationY matRotate2, fPhase
D3DXMatrixMultiply matDolphin, matDolphin, matRotate2
'add traslation to make the dolphin move in a circle and bob up and down
'in sync with its flippers
D3DXMatrixTranslation matTrans, -5 * Sin(fPhase), Sin(fKickFreq) / 2, 10 - 10 * Cos(fPhase)
D3DXMatrixMultiply matDolphin, matDolphin, matTrans
m_DolphinObject.SetMatrix matDolphin
' Animate the caustic textures
Dim tex As Long
tex = CLng((g_ftime * 32)) Mod 32
Set m_CurrentCausticTexture = m_CausticTextures(tex)
End Sub
'-----------------------------------------------------------------------------
' Name: BlendMeshes()
' Desc: Does a linear interpolation between all vertex positions and normals
' in two source meshes and outputs the result to the destination mesh.
' Note: all meshes must contain the same number of vertices, and the
' destination mesh must be in device memory.
'-----------------------------------------------------------------------------
Sub BlendMeshes(ByVal fWeight As Single)
Dim fWeight1 As Single, fWeight2 As Single
Dim vTemp1 As D3DVECTOR, vTemp2 As D3DVECTOR
Dim i As Long, j As Long
If (fWeight < 0) Then
j = kMesh3
Else
j = kMesh1
End If
' compute blending factors
fWeight1 = fWeight
If fWeight < 0 Then fWeight1 = -fWeight1
fWeight2 = 1 - fWeight1
' Linearly Interpolate (LERP)positions and normals
For i = 0 To m_dest.NumVertices - 1
D3DXVec3Scale vTemp1, m_meshtool(kMesh2).Vertices(i).p, fWeight2
D3DXVec3Scale vTemp2, m_meshtool(j).Vertices(i).p, fWeight1
D3DXVec3Add m_dest.Vertices(i).p, vTemp1, vTemp2
D3DXVec3Scale vTemp1, m_meshtool(kMesh2).Vertices(i).n, fWeight2
D3DXVec3Scale vTemp2, m_meshtool(j).Vertices(i).n, fWeight1
D3DXVec3Add m_dest.Vertices(i).n, vTemp1, vTemp2
Next
'Copy the data into the d3dvertex buffer
D3DVertexBuffer8SetData m_dest.VertB, 0, m_dest.NumVertices * Len(m_dest.Vertices(0)), 0, m_dest.Vertices(0)
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.
'-----------------------------------------------------------------------------
Function Render() As Boolean
'Dont do anything if in a minimized state
If m_bMinimized = True Then Exit Function
On Local Error Resume Next
Dim mat As D3DMATRIX
Dim mat2 As D3DMATRIX
Dim hr As Long
Render = False
'See what state the device is in.
hr = g_dev.TestCooperativeLevel
If hr = D3DERR_DEVICENOTRESET Then
g_dev.Reset g_d3dpp
RestoreDeviceObjects
ElseIf hr <> 0 Then 'dont bother rendering if we are not ready yet
Exit Function
End If
Render = True
' Clear the backbuffer
D3DUtil_ClearAll WATER_COLOR
With g_dev
.BeginScene
' Render the Seafloor. For devices that support one-pass multi-
' texturing, use the second texture stage to blend in the animated
' water caustics texture.
If (g_d3dCaps.MaxTextureBlendStages > 1) Then
' Set up the 2nd texture stage for the animated water caustics
.SetTexture 1, m_CurrentCausticTexture
.SetTextureStageState 1, D3DTSS_COLOROP, D3DTOP_MODULATE
.SetTextureStageState 1, D3DTSS_COLORARG1, D3DTA_TEXTURE
.SetTextureStageState 1, D3DTSS_COLORARG2, D3DTA_CURRENT
' Tell D3D to automatically generate texture coordinates from the
' model's position in camera space. The texture transform matrix is
' setup so that the 'x' and 'z' coordinates are scaled to become the
' resulting 'tu' and 'tv' texture coordinates. The resulting effect
' is that the caustic texture is draped over the geometry from above.
mat.m11 = 0.05: mat.m12 = 0#
mat.m21 = 0#: mat.m22 = 0#
mat.m31 = 0#: mat.m32 = 0.05
mat.m41 = Sin(g_ftime) / 8: mat.m42 = (Cos(g_ftime) / 10) - (g_ftime / 10)
.SetTransform D3DTS_TEXTURE1, mat
.SetTextureStageState 1, D3DTSS_TEXCOORDINDEX, D3DTSS_TCI_CAMERASPACEPOSITION
.SetTextureStageState 1, D3DTSS_TEXTURETRANSFORMFLAGS, D3DTTFF_COUNT2
End If
g_dev.SetRenderState D3DRS_AMBIENT, &HB0B0B0B0
' Finally, render the actual seafloor with the above states
m_FloorObject.Render g_dev
' Disable the second texture stage
If (g_d3dCaps.MaxTextureBlendStages > 1) Then
.SetTextureStageState 1, D3DTSS_COLOROP, D3DTOP_DISABLE
End If
' Render the dolphin in it's first pass.
.SetRenderState D3DRS_AMBIENT, AMBIENT_COLOR
m_DolphinObject.Render g_dev
' For devices that support one-pass multi-texturing, use the second
' texture stage to blend in the animated water caustics texture for
' the dolphin. This a little tricky because we only want caustics on
' the part of the dolphin that is lit from above. To acheive this
' effect, the dolphin is rendered alpha-blended with a second pass
' which has the caustic effects modulating the diffuse component
' which contains lighting-only information) of the geometry.
If (g_d3dCaps.MaxTextureBlendStages > 1) Then
' For the 2nd pass of rendering the dolphin, turn on the caustic
' effects. Start with setting up the 2nd texture stage state, which
' will modulate the texture with the diffuse component. This actually
' only needs one stage, except that using a CD3DFile object makes that
' a little tricky.
.SetTexture 1, m_CurrentCausticTexture
.SetTextureStageState 1, D3DTSS_COLOROP, D3DTOP_MODULATE
.SetTextureStageState 1, D3DTSS_COLORARG1, D3DTA_TEXTURE
.SetTextureStageState 1, D3DTSS_COLORARG2, D3DTA_DIFFUSE
' Now, set up D3D to generate texture coodinates. This is the same as
' with the seafloor the 'x' and 'z' position coordinates in camera
' space are used to generate the 'tu' and 'tv' texture coordinates),
' except our scaling factors are different in the texture matrix, to
' get a better looking result.
mat2.m11 = 0.5: mat2.m12 = 0#
mat2.m21 = 0#: mat2.m22 = 0#
mat2.m31 = 0#: mat2.m32 = 0.5
mat2.m41 = 0#: mat2.m42 = 0#
.SetTransform D3DTS_TEXTURE1, mat2
.SetTextureStageState 1, D3DTSS_TEXCOORDINDEX, D3DTSS_TCI_CAMERASPACEPOSITION
.SetTextureStageState 1, D3DTSS_TEXTURETRANSFORMFLAGS, D3DTTFF_COUNT2
' Set the ambient color and fog color to pure black. Ambient is set
' to black because we still have a light shining from above, but we
' don't want any caustic effects on the dolphin's underbelly. Fog is
' set to black because we want the caustic effects to fade out in the
' distance just as the model does with the WATER_COLOR.
.SetRenderState D3DRS_AMBIENT, &H0&
.SetRenderState D3DRS_FOGCOLOR, &H0&
' Set up blending modes to add this caustics-only pass with the
' previous pass.
.SetRenderState D3DRS_ALPHABLENDENABLE, 1 ' True
.SetRenderState D3DRS_SRCBLEND, D3DBLEND_SRCCOLOR
.SetRenderState D3DRS_DESTBLEND, D3DBLEND_ONE
' Finally, render the caustic effects for the dolphin
m_DolphinObject.Render g_dev
' After all is well and done, restore any munged texture stage states
.SetTextureStageState 1, D3DTSS_COLOROP, D3DTOP_DISABLE
.SetRenderState D3DRS_AMBIENT, AMBIENT_COLOR
.SetRenderState D3DRS_FOGCOLOR, WATER_COLOR
.SetRenderState D3DRS_ALPHABLENDENABLE, 0 'False
End If
skipcaustic:
' End the scene.
.EndScene
End With
End Function
'-----------------------------------------------------------------------------
' Name: InvalidateDeviceObjects()
' Desc: Called when the device-dependant objects are about to be lost.
'-----------------------------------------------------------------------------
Public Sub InvalidateDeviceObjects()
m_FloorObject.InvalidateDeviceObjects
m_DolphinGroupObject.InvalidateDeviceObjects
m_DolphinObject.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.
'-----------------------------------------------------------------------------
Public Sub DeleteDeviceObjects()
m_FloorObject.Destroy
m_DolphinGroupObject.Destroy
m_DolphinObject.Destroy
MESHTOOL_DESTROY m_meshtool(0)
MESHTOOL_DESTROY m_meshtool(1)
MESHTOOL_DESTROY m_meshtool(2)
MESHTOOL_DESTROY m_dest
Set m_DolphinGroupObject = Nothing
Set m_DolphinObject = Nothing
Set m_DolphinMesh = Nothing
Set m_DolphinMesh01 = Nothing
Set m_DolphinMesh02 = Nothing
Set m_DolphinMesh03 = Nothing
Set m_FloorObject = Nothing
Set m_SeaFloorMesh = Nothing
Set m_DolphinTex = Nothing
ReDim m_CausticTextures(0)
Set m_CurrentCausticTexture = Nothing
m_bInit = False
End Sub
'-----------------------------------------------------------------------------
' Name: VerifyDevice()
' Desc: Called when the app is trying to find valid display modes
'-----------------------------------------------------------------------------
Public Function VerifyDevice(usageflags As Long, format As CONST_D3DFORMAT) As Boolean
VerifyDevice = True
End Function

View File

@@ -0,0 +1,41 @@
Type=Exe
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#stdole2.tlb#OLE Automation
Reference=*\G{E1211242-8E94-11D1-8808-00C04FC2C603}#1.0#0#dx8vb.dll#DirectX 8 for Visual Basic Type Library
Form=dolphin.frm
Module=D3DUtil; ..\..\common\D3DUtil.bas
Module=D3DInit; ..\..\common\D3DInit.bas
Class=CD3DMesh; ..\..\common\D3DMesh.cls
Class=CD3DFrame; ..\..\common\D3DFrame.cls
Class=CD3DAnimation; ..\..\common\D3DAnimation.cls
Module=MediaDir; ..\..\common\media.bas
Form=..\..\common\SelectDevice.frm
Startup="Form1"
ExeName32="vb_Dolphin.exe"
Command32=""
Name="Project1"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="Microsoft"
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1
[MS Transaction Server]
AutoRefresh=1

View File

@@ -0,0 +1,58 @@
//-----------------------------------------------------------------------------
// Name: Dolphin Direct3D Sample
//
// Copyright (C) 1999-2001 Microsoft Corporation. All rights reserved.
//-----------------------------------------------------------------------------
Description
===========
The Dolphin sample shows an underwater scene of a dolphin swimming, with
caustic effects on the dolphin and seafloor. The dolphin is animated using
a technique called "tweening". The underwater effect simply uses fog, and
the water caustics use an animated set of textures.
Path
====
Source: DXSDK\Samples\Multimedia\VBSamples\Direct3D\Dolphin
Executable: DXSDK\Samples\Multimedia\VBSamples\Direct3D\Bin
User's Guide
============
The following keys are implemented. The dropdown menus can be used for the
same controls.
<F2> Prompts user to select a new rendering device or display mode
<Alt+Enter> Toggles between fullscreen and windowed modes
<Esc> Exits the app.
Programming Notes
=================
Several things are happening in this sample. First of all is the use of
fog to give an underwater effect. The fog parameters are set up in the
InitDeviceObjects() function.
The water caustics are achieved by animating a set of 32 different textures
(caust00.tga through caust31.tga). The caustics can be blending into the
scene using multitexturing or multi-pass blending techniques. It is
straightforward except for one tricky situation. Since the bottom of the
dolphin should not have caustic effects, a separate pass is done where
ambient light is removed and the dolphin is lit from above, and then
blending the diffuse color with the caustic texture.
The dolphin is animated using a technique called "tweening", in which the
dolphin model's vertices are linearly blending from multiple other sets of
vertices. The source models for these other sets of vertices is loaded
from dolphin_group.x, which consists of the dolphin model in three
different positions. Each frame, a destination mesh is generated by
blending some combination of the positions and normals from these meshes
together.
This sample makes use of common DirectX code (consisting of helper functions,
etc.) that is shared with other samples on the DirectX SDK. All common
classes and modules can be found in the following directory:
DXSDK\Samples\Multimedia\VBSamples\Common

File diff suppressed because it is too large Load Diff

View File

@@ -0,0 +1,38 @@
Type=Exe
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#stdole2.tlb#OLE Automation
Reference=*\G{E1211242-8E94-11D1-8808-00C04FC2C603}#1.0#0#dx8vb.dll#DirectX 8 for Visual Basic Type Library
Form=Donuts.frm
Module=MediaDir; ..\..\common\media.bas
IconForm="frmVBDonuts"
Startup="frmVBDonuts"
HelpFile=""
Title="VB Donuts"
ExeName32="VB_Donuts.exe"
Command32=""
Name="VBDonuts"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="ms"
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1
[MS Transaction Server]
AutoRefresh=1

View File

@@ -0,0 +1,35 @@
//-----------------------------------------------------------------------------
//
// Sample Name: Donuts Sample
//
// Copyright (C) 1999-2001 Microsoft Corporation. All rights reserved.
//
//-----------------------------------------------------------------------------
Description
===========
The Donuts sample illustrates how to use d3d to create a 2d sprite engine.
Path
====
Source: DXSDK\Samples\Multimedia\VBSamples\Direct3D\Donuts
Executable: DXSDK\Samples\Multimedia\VBSamples\Direct3D\Bin
User's Guide
============
<Alt-Enter> will bring you fullscreen to 640x480 and back to windowed mode
<Esc> exits the application
Programming Notes
=================
The background is rendered with 2 TLVertex (screen space) triangles. The sprites
are defined as an array of user defined type that is a container for sprite properties
such as position, direction, speed and size. Each of the sprites is rendered as 2
TLVertex triangles each frame.

View File

@@ -0,0 +1,33 @@
Type=Exe
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#stdole2.tlb#OLE Automation
Reference=*\G{E1211242-8E94-11D1-8808-00C04FC2C603}#1.0#0#dx8vb.dll#DirectX 8 for Visual Basic Type Library
Form=frmPixelShader.frm
Module=MediaDir; ..\..\common\media.bas
Startup="frmPixelShader"
HelpFile=""
ExeName32="VB_PixelShader.exe"
Command32=""
Name="VBPixelShader"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="ms"
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1

View File

@@ -0,0 +1,692 @@
VERSION 5.00
Begin 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 Default
End
Attribute VB_Name = "frmPixelShader"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option 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 Single
End Type
Dim 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 DirectX8
Dim d3d As Direct3D8
Dim dev As Direct3DDevice8
Dim d3dx As D3DX8
Dim d3dvb As Direct3DVertexBuffer8
Dim d3dt(1) As Direct3DTexture8
'Keep the present params around for resetting the device if needed
Dim g_d3dpp As D3DPRESENT_PARAMETERS
' This string array will store the shader functions
Dim sPixelShader(6) As String
' This array will store the pointers to the assembled pixel shaders
Dim hPixelShader(6) As Long
Private 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 Sub
Private 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 Sub
Private 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 Sub
Private 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 Sub
Private 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 Sub
Private 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 Sub
Private 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
Next
End Sub
Private 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 With
End Sub
Private 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 If
End Sub
Private 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 Function
Private 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 Sub
Private Sub Form_Paint()
If d3dvb Is Nothing Then Exit Sub
'Anytime the window receives a paint message, repaint the scene.
Call PaintMe
End Sub
Private 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 Function
Private Sub Form_Unload(Cancel As Integer)
' When the app is exiting, call the DestroyAll() function to clean up.
Call DestroyAll
End Sub
Private 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

View File

@@ -0,0 +1,43 @@
//-----------------------------------------------------------------------------
// Name: PixelShader Direct3D Sample
//
// Copyright (C) 1999-2001 Microsoft Corporation. All rights reserved.
//-----------------------------------------------------------------------------
Description
===========
This sample shows some of the effects that can be achieved using pixel
shaders. Each of the 8 thumbnails shown is the result of using a different
pixel shader to render a rectangle
Pixel shaders use a set of instructions, executed by the 3D
device on a per-pixel basis, that can affect the colorof the
pixel based on a varient of inputs. Pixel shaders can be used in place of
the texture stage pipeline.
Note that not all cards may support all the various features pixel shaders.
For more information on pixel shaders, refer to the DirectX SDK
documentation.
Path
====
Source: DXSDK\Samples\Multimedia\VBSamples\Direct3D\PixelShader
Executable: DXSDK\Samples\Multimedia\VBSamples\Direct3D\Bin
User's Guide
============
This sample has no user interaction
Programming Notes
=================
Programming pixel shaders is not a trivial task. Please read any pixel
shader-specific documentation accompanying the DirectX SDK.
This sample makes use of common DirectX code (consisting of helper functions,
etc.) that is shared with other samples on the DirectX SDK. All common
classes and modules can be found in the following directory:
DXSDK\Samples\Multimedia\VBSamples\Common

View File

@@ -0,0 +1,603 @@
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "CParticle"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'-----------------------------------------------------------------------------
' Global data for the particles
'-----------------------------------------------------------------------------
Private Type CUSTOMVERTEX
v As D3DVECTOR
color As Long
tu As Single
tv As Single
End Type
Const D3DFVF_COLORVERTEX = (D3DFVF_XYZ Or D3DFVF_DIFFUSE Or D3DFVF_TEX1)
Private Type PARTICLE
m_bSpark As Boolean ' Spark? or real particle?
m_vPos As D3DVECTOR ' Current position
m_vVel As D3DVECTOR ' Current velocity
m_vPos0 As D3DVECTOR ' Initial Position
m_vVel0 As D3DVECTOR ' Initial Velocity
m_fTime0 As Single ' Time of creation
m_clrDiffuse As D3DCOLORVALUE ' Initial diffuse color
m_clrFade As D3DCOLORVALUE ' Faded diffuse color
m_fFade As Single ' Fade progression
iNext As Long ' Next particle in list
End Type
Dim m_Particles() As PARTICLE 'we leave 0 element unused to make code convenient
'so think of this as a 1 based array
Dim m_fRadius As Single
Dim m_MaxParticles As Long
Dim m_NumParticles As Long
Dim m_ParticlesLim As Long
Dim m_iFree As Long 'index of first free particle (0 = empty)
Dim m_iUsed As Long 'index of first particle in list (0 = empty)
Dim m_iLast As Long
'Geometry
Dim m_VertB As Direct3DVertexBuffer8
Dim m_IndxB As Direct3DIndexBuffer8
Dim m_Verts() As CUSTOMVERTEX
Dim m_binit As Boolean
'-----------------------------------------------------------------------------
' Name: Init
' Desc:
'-----------------------------------------------------------------------------
Sub Init(MaxParticles As Long, fRadius As Single)
m_fRadius = fRadius
m_MaxParticles = MaxParticles
m_NumParticles = 0
m_ParticlesLim = 1800
m_iFree = 0
m_iUsed = 0
Set m_VertB = Nothing
Set m_IndxB = Nothing
m_binit = True
ReDim m_Verts(MaxParticles * 6)
ReDim m_Particles(m_ParticlesLim)
End Sub
'-----------------------------------------------------------------------------
' Name: InitDeviceObjects
' Desc:
'-----------------------------------------------------------------------------
Sub InitDeviceObjects(dev As Direct3DDevice8)
Dim v As CUSTOMVERTEX
Dim j As Long, i As Long
Dim indices() As Integer
Dim indxbuffsize As Long
' Create the particle system's vertex buffer and index buffer.
' Each particle requires four vertices and 6 indices
Set m_VertB = dev.CreateVertexBuffer(4 * m_MaxParticles * Len(v), D3DUSAGE_SOFTWAREPROCESSING, D3DFVF_COLORVERTEX, D3DPOOL_MANAGED)
indxbuffsize = 6 * m_MaxParticles * 4 'each entry is 4 bytes (vb integer)
Set m_IndxB = dev.CreateIndexBuffer(indxbuffsize, D3DUSAGE_SOFTWAREPROCESSING, D3DFMT_INDEX16, D3DPOOL_MANAGED)
' Fill the index buffer
ReDim indices(6 * m_MaxParticles) 'we have 2 triangles per particle
j = 0
For i = 0 To m_MaxParticles - 1
indices(j) = 4 * i + 0: j = j + 1
indices(j) = 4 * i + 3: j = j + 1
indices(j) = 4 * i + 1: j = j + 1
indices(j) = 4 * i + 1: j = j + 1
indices(j) = 4 * i + 3: j = j + 1
indices(j) = 4 * i + 2: j = j + 1
Next
' Set the data on the d3d buffer
D3DIndexBuffer8SetData m_IndxB, 0, indxbuffsize, 0, indices(0)
End Sub
'-----------------------------------------------------------------------------
' Name: DeleteDeviceObjects
' Desc:
'-----------------------------------------------------------------------------
Sub DeleteDeviceObjects()
Set m_VertB = Nothing
Set m_IndxB = Nothing
End Sub
'-----------------------------------------------------------------------------
' Name: Class_Terminate
' Desc:
'-----------------------------------------------------------------------------
Private Sub Class_Terminate()
DeleteDeviceObjects
ReDim m_Particles(0)
End Sub
'-----------------------------------------------------------------------------
' Name:
' Desc:
'-----------------------------------------------------------------------------
Sub Update(fSecsPerFrame As Single, NumParticlesToEmit As Long, _
clrEmitColor As D3DCOLORVALUE, _
clrFadeColor As D3DCOLORVALUE, _
fEmitVel As Single, _
vPosition As D3DVECTOR)
If m_binit = False Then Exit Sub
Static fTime As Single
Dim i As Long
Dim iSpark As Long, inew As Long
Dim fRand1 As Single, fRand2 As Single
'advance simulation
fTime = fTime + fSecsPerFrame
Dim iCurrent As Long
Dim iPrevious As Long
iCurrent = m_iUsed
iPrevious = 0
'For each particle in the In Use list ...
'calculate its age and test if the particle is too old
Do While (iCurrent > 0)
With m_Particles(iCurrent)
Dim ft As Single
Dim fGravity As Single
'Calculate current lifetime
ft = fTime - .m_fTime0
'normal particle become sparks at the end of their
'life time and have different behaviour
'that we define here
If .m_bSpark Then
'sparks float higher and fade faster
fGravity = -5#
.m_fFade = .m_fFade - fSecsPerFrame * 2.25
Else
'other particles fall to ground faster but live longer
fGravity = -9.8
End If
'Our newposition computed from velocity and initial position
'pNew=pInit+t*velocity + accl * t * t
'the first terms
.m_vPos.x = .m_vVel0.x * ft + .m_vPos0.x
.m_vPos.y = .m_vVel0.y * ft + .m_vPos0.y
.m_vPos.z = .m_vVel0.z * ft + .m_vPos0.z
'we add gravity in for the accleration terms on y axis
.m_vPos.y = .m_vPos.y + (0.5 * fGravity) * (ft * ft)
'compute new Velocity given acceleartion
'vNew=vInit+t*vCurrent
.m_vVel.y = .m_vVel0.y + fGravity * ft
'clamp fading to zero
If (.m_fFade < 0#) Then .m_fFade = 0
'Normal particles die and turn into 5 sparks when they are
'above a certain height from the ground
'Sparks die when they fall below the surface
'We test here if any particle is dead
If (.m_vPos.y < m_fRadius) Then '
'if we have a normal particle
'lets turn it into 5 sparks
If (Not .m_bSpark) Then
For i = 0 To 4
'If there are particles in the free list, use them
If (m_iFree) Then
iSpark = m_iFree
m_iFree = m_Particles(m_iFree).iNext
'other wise get a new one
Else
If m_iLast >= m_ParticlesLim Then
' 'm_bReset = True
Exit For
End If
m_iLast = m_iLast + 1
iSpark = m_iLast
End If
'put this new particle on the used list
m_Particles(iSpark).iNext = m_iUsed
m_iUsed = iSpark
m_NumParticles = m_NumParticles + 1
'have the spark start out in the same position
'as where the normal particle is now
m_Particles(iSpark).m_bSpark = True
m_Particles(iSpark).m_vPos0 = .m_vPos
m_Particles(iSpark).m_vPos0.y = m_fRadius
fRand1 = Rnd(1) * g_pi * 2
fRand2 = Rnd(1) * g_pi * 0.25
'have the sparks velocity vere off from the normal particle
m_Particles(iSpark).m_vVel0.x = .m_vVel.x * 0.25 + Cos(fRand1) * Sin(fRand2)
m_Particles(iSpark).m_vVel0.z = .m_vVel.z * 0.25 + Sin(fRand1) * Sin(fRand2)
m_Particles(iSpark).m_vVel0.y = Cos(fRand2) * Rnd(1) * 1.5
'set the sparks current position = initial position
'set the sparks current velocitu = initial velocity
m_Particles(iSpark).m_vPos = .m_vPos0
m_Particles(iSpark).m_vVel = .m_vVel0
' set the initial color of the particle to be that of
'what it was as a normal particle
D3DXColorLerp m_Particles(iSpark).m_clrDiffuse, .m_clrFade, .m_clrDiffuse, .m_fFade
'set the spark to fade to blue
m_Particles(iSpark).m_clrFade = ColorValue4(0#, 0#, 0#, 1#)
'set its life time indicator to be newly created
m_Particles(iSpark).m_fFade = 1#
'save the time of creation
m_Particles(iSpark).m_fTime0 = fTime
Next
End If
' Kill the current particle
'remove it form used list
'put it on free list
If iPrevious > 0 Then
m_Particles(iPrevious).iNext = .iNext
Else
m_iUsed = .iNext
End If
Dim iTemp As Long
iTemp = .iNext
.iNext = m_iFree
m_iFree = iCurrent
iCurrent = iTemp
m_NumParticles = m_NumParticles - 1
Else
iPrevious = iCurrent
iCurrent = .iNext
End If
End With
Loop
' Emit new particles
Dim NumParticlesEmit As Long
NumParticlesEmit = m_NumParticles + NumParticlesToEmit
Do While (m_NumParticles < m_ParticlesLim And m_NumParticles < NumParticlesEmit)
' If there is a particle in the free list, use it
If (m_iFree) Then
inew = m_iFree
m_iFree = m_Particles(m_iFree).iNext
'other wise get an new one
Else
If m_iLast >= m_ParticlesLim Then
Exit Do
End If
m_iLast = m_iLast + 1
inew = m_iLast
End If
'put it on the used list
'put this new particle on the used list
m_Particles(inew).iNext = m_iUsed
m_iUsed = inew
m_NumParticles = m_NumParticles + 1
' Emit new particle
fRand1 = Rnd(1) * g_pi * 2
fRand2 = Rnd(1) * g_pi * 0.25
With m_Particles(inew)
.m_bSpark = False
D3DXVec3Add .m_vPos0, vPosition, vec3(0, m_fRadius, 0)
.m_vVel0.x = Cos(fRand1) * Sin(fRand2) * 2.5
.m_vVel0.z = Sin(fRand1) * Sin(fRand2) * 2.5
.m_vVel0.y = Cos(fRand2) * (Rnd(1) * fEmitVel)
.m_vPos = .m_vPos0
.m_vVel = .m_vVel0
.m_clrDiffuse = clrEmitColor
.m_clrFade = clrFadeColor
.m_fFade = 1
.m_fTime0 = fTime
End With
Loop
End Sub
'-----------------------------------------------------------------------------
' Name: Render()
' Desc: Renders the particle system using either pointsprites
'
'-----------------------------------------------------------------------------
Sub Render(dev As Direct3DDevice8)
Dim v As CUSTOMVERTEX
Dim iCurrent As Long, i As Long
With dev
Dim DWFloat0 As Long
Dim DWFloat1 As Long
Dim DWFloatp08 As Long
DWFloat0 = FtoDW(0)
DWFloat1 = FtoDW(1)
DWFloatp08 = FtoDW(0.08)
' Set the render states for using point sprites
.SetRenderState D3DRS_POINTSPRITE_ENABLE, 1 'True
.SetRenderState D3DRS_POINTSCALE_ENABLE, 1 'True
.SetRenderState D3DRS_POINTSIZE, DWFloatp08
.SetRenderState D3DRS_POINTSIZE_MIN, DWFloat0
.SetRenderState D3DRS_POINTSCALE_A, DWFloat0
.SetRenderState D3DRS_POINTSCALE_B, DWFloat0
.SetRenderState D3DRS_POINTSCALE_C, DWFloat1
' Set up the vertex buffer to be rendered
.SetStreamSource 0, m_VertB, Len(v)
.SetVertexShader D3DFVF_COLORVERTEX
End With
Dim NumParticlesToRender As Long
' Render each particle
iCurrent = m_iUsed
Dim vPos As D3DVECTOR, vVel As D3DVECTOR
Dim fLengthSq As Single, steps As Long
Do While (iCurrent <> 0)
With m_Particles(iCurrent)
vPos = .m_vPos
vVel = .m_vVel
fLengthSq = D3DXVec3LengthSq(vVel)
If (fLengthSq < 1#) Then
steps = 2
ElseIf (fLengthSq < 4#) Then
steps = 3
ElseIf (fLengthSq < 9#) Then
steps = 4
ElseIf (fLengthSq < 12.25) Then
steps = 5
ElseIf (fLengthSq < 16#) Then
steps = 6
ElseIf (fLengthSq < 20.25) Then
steps = 7
Else
steps = 8
End If
D3DXVec3Scale vVel, vVel, (-0.04 / steps)
Dim clrDiffuse As D3DCOLORVALUE
D3DXColorLerp clrDiffuse, .m_clrFade, .m_clrDiffuse, .m_fFade
Dim clrDiffuseLong As Long
clrDiffuseLong = D3DCOLORVALUEtoLONG(clrDiffuse)
Dim iVert As Long
' Render each particle a bunch of times to get a blurring effect
For i = 0 To steps - 1
m_Verts(iVert).v = vPos
m_Verts(iVert).color = clrDiffuseLong
NumParticlesToRender = NumParticlesToRender + 1
iVert = iVert + 1
If (NumParticlesToRender = m_MaxParticles) Then
' we have a full Vertex buffer
D3DVertexBuffer8SetData m_VertB, 0, Len(v) * m_MaxParticles, 0, m_Verts(0)
dev.DrawPrimitive D3DPT_POINTLIST, 0, NumParticlesToRender
NumParticlesToRender = 0
iVert = 0
End If
D3DXVec3Add vPos, vPos, vVel
Next
iCurrent = .iNext
End With
Loop
' Render any remaining particles
If (NumParticlesToRender <> 0) Then
D3DVertexBuffer8SetData m_VertB, 0, Len(v) * NumParticlesToRender, 0, m_Verts(0)
g_dev.DrawPrimitive D3DPT_POINTLIST, 0, NumParticlesToRender
End If
' Reset render states
g_dev.SetRenderState D3DRS_POINTSPRITE_ENABLE, 0 'False
g_dev.SetRenderState D3DRS_POINTSCALE_ENABLE, 0 'False
End Sub
'-----------------------------------------------------------------------------
' Name: RenderLights
' Desc:
'-----------------------------------------------------------------------------
Sub RenderLights(dev As Direct3DDevice8)
Dim vTL As D3DVECTOR, vBL As D3DVECTOR, vBR As D3DVECTOR, vTR As D3DVECTOR
Dim v As CUSTOMVERTEX
vTL = vec3(-1, 0, 1): vBL = vec3(-1, 0, -1)
vBR = vec3(1, 0, -1): vTR = vec3(1, 0, 1)
With dev
.SetStreamSource 0, m_VertB, Len(v)
.SetVertexShader D3DFVF_COLORVERTEX
.SetIndices m_IndxB, 0
End With
Dim iCurrent As Long
Dim NumParticlesToRender
Dim fY As Single
Dim fSize As Single
Dim clrDiffuse As D3DCOLORVALUE
Dim clrDiffuseTemp As D3DCOLORVALUE
Dim lngDiffuse As Long
Dim vPos As D3DVECTOR
Dim vTemp As D3DVECTOR
Dim j As Long
iCurrent = m_iUsed
Do While (iCurrent <> 0)
With m_Particles(iCurrent)
fY = .m_vPos.y
'if the particle is close to the ground we will add some lights effects
If (fY < 1) Then
'make sure particle cant go below ground
If (fY < 0) Then fY = 0
fSize = fY * 0.25 + m_fRadius
D3DXColorLerp clrDiffuse, .m_clrFade, .m_clrDiffuse, .m_fFade
D3DXColorScale clrDiffuseTemp, clrDiffuse, (1 - fY) * 0.5
lngDiffuse = D3DCOLORVALUEtoLONG(clrDiffuseTemp)
vPos = vec3(.m_vPos.x, 0#, .m_vPos.z)
D3DXVec3Scale vTemp, vTR, fSize
D3DXVec3Add m_Verts(j).v, vPos, vTemp
m_Verts(j).color = lngDiffuse
m_Verts(j).tu = 0: m_Verts(j).tv = 0
j = j + 1
D3DXVec3Scale vTemp, vBR, fSize
D3DXVec3Add m_Verts(j).v, vPos, vTemp
m_Verts(j).color = lngDiffuse
m_Verts(j).tu = 0: m_Verts(j).tv = 1
j = j + 1
D3DXVec3Scale vTemp, vBL, fSize
D3DXVec3Add m_Verts(j).v, vPos, vTemp
m_Verts(j).color = lngDiffuse
m_Verts(j).tu = 1: m_Verts(j).tv = 1
j = j + 1
D3DXVec3Scale vTemp, vTL, fSize
D3DXVec3Add m_Verts(j).v, vPos, vTemp
m_Verts(j).color = lngDiffuse
m_Verts(j).tu = 1: m_Verts(j).tv = 0
j = j + 1
NumParticlesToRender = NumParticlesToRender + 1
If (NumParticlesToRender = m_MaxParticles) Then
D3DVertexBuffer8SetData m_VertB, 0, Len(v) * 4 * NumParticlesToRender, 0, m_Verts(0)
dev.DrawIndexedPrimitive D3DPT_TRIANGLELIST, _
0, NumParticlesToRender * 4, _
0, NumParticlesToRender * 2
NumParticlesToRender = 0
j = 0
End If
End If
iCurrent = .iNext
End With
Loop
' Render remaining particles
If (NumParticlesToRender <> 0) Then
D3DVertexBuffer8SetData m_VertB, 0, Len(v) * 4 * NumParticlesToRender, 0, m_Verts(0)
dev.DrawIndexedPrimitive D3DPT_TRIANGLELIST, _
0, NumParticlesToRender * 4, _
0, NumParticlesToRender * 2
End If
End Sub

View File

@@ -0,0 +1,778 @@
VERSION 5.00
Begin VB.Form Form1
Caption = "Point Sprites"
ClientHeight = 4050
ClientLeft = 60
ClientTop = 345
ClientWidth = 5055
Icon = "PointSprites.frx":0000
LinkTopic = "Form1"
ScaleHeight = 270
ScaleMode = 3 'Pixel
ScaleWidth = 337
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
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' Copyright (C) 1999-2001 Microsoft Corporation. All Rights Reserved.
'
' File: PointSprites.frm
' Content: Sample showing how to use point sprites to do particle effects
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
Option Compare Text
Private Type CUSTOMVERTEX
v As D3DVECTOR
color As Long
tu As Single
tv As Single
End Type
Const D3DFVF_COLORVERTEX = (D3DFVF_XYZ Or D3DFVF_DIFFUSE Or D3DFVF_TEX1)
Const GROUND_GRIDSIZE = 8
Const GROUND_WIDTH = 256
Const GROUND_HEIGHT = 256
Const GROUND_TILE = 32
Const GROUND_COLOR = &HBBEEEEEE
Private Enum PARTICLE_COLORS
COLOR_WHITE = 0
COLOR_RED = 1
COLOR_GREEN = 2
COLOR_BLUE = 3
NUM_COLORS = 4
End Enum
Dim g_clrColor(4) As D3DCOLORVALUE
Dim g_clrColorFade(4) As D3DCOLORVALUE
Dim m_media As String
Dim m_ParticleSystem As CParticle
Dim m_ParticleTexture As Direct3DTexture8
Dim m_NumParticlesToEmit As Long
Dim m_bStaticParticle As Boolean
Dim m_nParticleColor As Long
Dim m_GroundTexture As Direct3DTexture8
Dim m_NumGroundVertices As Long
Dim m_NumGroundIndices As Long
Dim m_GroundIB As Direct3DIndexBuffer8
Dim m_GroundVB As Direct3DVertexBuffer8
Dim m_planeGround As D3DPLANE
Dim m_bDrawReflection As Boolean
Dim m_bCanDoAlphaBlend As Boolean
Dim m_bCanDoClipPlanes As Boolean
Dim m_bDrawHelp As Boolean
Dim m_matView As D3DMATRIX
Dim m_matOrientation As D3DMATRIX
Dim m_vPosition As D3DVECTOR
Dim m_vVelocity As D3DVECTOR
Dim m_fYaw As Single
Dim m_fYawVelocity As Single
Dim m_fPitch As Single
Dim m_fPitchVelocity As Single
Dim m_fElapsedTime As Single
Dim m_bKey(256) As Boolean
Dim g_fTime As Single
Dim g_fLastTime As Single
Dim m_grVerts() As CUSTOMVERTEX
Dim m_grVerts2() As CUSTOMVERTEX
Dim m_binit As Boolean
Dim m_bMinimized As Boolean
Dim m_bStopSim As Boolean
Const kMaxParticles = 128
Const kParticleRadius = 0.01
'-----------------------------------------------------------------------------
' Name: Form_KeyPress()
' Desc:
'-----------------------------------------------------------------------------
Private Sub Form_KeyPress(KeyAscii As Integer)
If Chr$(KeyAscii) = "r" Then m_bDrawReflection = Not m_bDrawReflection
End Sub
'-----------------------------------------------------------------------------
' Name: Form_Load()
' Desc:
'-----------------------------------------------------------------------------
Private Sub Form_Load()
Me.Show
DoEvents
'setup defaults
Init
' 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, Me)
If Not (m_binit) Then End
' find Media and set media path
m_media = FindMediaDir("ground2.bmp")
D3DUtil_SetMediaPath m_media
' Set initial state
OneTimeSceneInit
' Load Mesh and textures from media
InitDeviceObjects
' Set device render states, lighting, camera
RestoreDeviceObjects
' Start Timer
DXUtil_Timer TIMER_start
' 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
If Render Then
' Present the image to the screen
D3DUtil_PresentAll g_focushwnd
End If
' 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)
m_bKey(KeyCode) = True
Select Case KeyCode
Case vbKeyEscape
Unload Me
Case vbKeyF2
' Pause the timer
DXUtil_Timer TIMER_STOP
m_bStopSim = True
' 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
m_bStopSim = False
DXUtil_Timer TIMER_start
Case vbKeyReturn
' Check for Alt-Enter if not pressed exit
If Shift <> 4 Then Exit Sub
' stop simulation
DXUtil_Timer TIMER_STOP
m_bStopSim = True
' 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
' Restart simulation
DXUtil_Timer TIMER_STOP
m_bStopSim = False
End Select
End Sub
'-----------------------------------------------------------------------------
' Name: Form_KeyUp()
' Desc: Process key messages for exit and change device
'-----------------------------------------------------------------------------
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
m_bKey(KeyCode) = False
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
DXUtil_Timer (TIMER_STOP)
m_bStopSim = True
End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
DXUtil_Timer (TIMER_start)
m_bStopSim = False
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
m_bStopSim = 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
m_bStopSim = 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
m_ParticleSystem.DeleteDeviceObjects
Set m_ParticleSystem = Nothing
Set m_ParticleSystem = New CParticle
'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
RestoreDeviceObjects
DXUtil_Timer TIMER_STOP
m_ParticleSystem.Init kMaxParticles, kParticleRadius
m_ParticleSystem.InitDeviceObjects g_dev
DXUtil_Timer TIMER_RESET
End Sub
'-----------------------------------------------------------------------------
' Name: Form_Unload()
' Desc:
'-----------------------------------------------------------------------------
Private Sub Form_Unload(Cancel As Integer)
DeleteDeviceObjects
End
End Sub
'-----------------------------------------------------------------------------
' Name: Init()
' Desc: Constructor
'-----------------------------------------------------------------------------
Sub Init()
Me.Caption = "PointSprites: Using particle effects"
Set m_ParticleSystem = New CParticle
m_ParticleSystem.Init kMaxParticles, kParticleRadius
Set m_ParticleTexture = Nothing
m_NumParticlesToEmit = 10
m_bStaticParticle = True
m_nParticleColor = COLOR_WHITE
Set m_GroundTexture = Nothing
m_NumGroundVertices = (GROUND_GRIDSIZE + 1) * (GROUND_GRIDSIZE + 1)
m_NumGroundIndices = (GROUND_GRIDSIZE * GROUND_GRIDSIZE) * 6
Set m_GroundVB = Nothing
Set m_GroundIB = Nothing
m_planeGround = D3DPLANE4(0, 1, 0, 0)
m_bDrawReflection = False
m_bCanDoAlphaBlend = False
m_bCanDoClipPlanes = False
m_bDrawHelp = False
m_vPosition = vec3(0, 3, -4)
m_vVelocity = vec3(0, 0, 0)
m_fYaw = 0
m_fYawVelocity = 0
m_fPitch = 0.5
m_fPitchVelocity = 0
g_clrColor(0) = ColorValue4(1, 1, 1, 1)
g_clrColor(1) = ColorValue4(1, 0.5, 0.5, 1)
g_clrColor(2) = ColorValue4(0.5, 1, 0.5, 1)
g_clrColor(3) = ColorValue4(0.125, 0.5, 1, 1)
g_clrColorFade(0) = ColorValue4(1, 0.25, 0.25, 1)
g_clrColorFade(1) = ColorValue4(1, 0.25, 0.25, 1)
g_clrColorFade(2) = ColorValue4(0.25, 0.75, 0.25, 1)
g_clrColorFade(3) = ColorValue4(0.125, 0.25, 0.75, 1)
End Sub
'-----------------------------------------------------------------------------
' Name: OneTimeSceneInit()
' Desc: Called during initial app startup, this function performs all the
' permanent initialization.
'-----------------------------------------------------------------------------
Sub OneTimeSceneInit()
D3DXMatrixTranslation m_matView, 0, 0, 10
D3DXMatrixTranslation m_matOrientation, 0, 0, 0
End Sub
'-----------------------------------------------------------------------------
' Name: FrameMove()
' Desc: Called once per frame, the call is the entry point for animating
' the scene.
'-----------------------------------------------------------------------------
Sub FrameMove()
If m_bStopSim = True Then Exit Sub
g_fTime = DXUtil_Timer(TIMER_GETAPPTIME) * 1.3
m_fElapsedTime = g_fTime - g_fLastTime
g_fLastTime = g_fTime
If m_fElapsedTime < 0 Then Exit Sub
' Slow things down for the REF device
If (g_devType = D3DDEVTYPE_REF) Then m_fElapsedTime = 0.05
Dim fSpeed As Single
Dim fAngularSpeed
fSpeed = 5 * m_fElapsedTime
fAngularSpeed = 1 * m_fElapsedTime
' Slowdown the camera movement
D3DXVec3Scale m_vVelocity, m_vVelocity, 0.9
m_fYawVelocity = m_fYawVelocity * 0.9
m_fPitchVelocity = m_fPitchVelocity * 0.9
' Process keyboard input
If (m_bKey(vbKeyRight)) Then m_vVelocity.x = m_vVelocity.x + fSpeed ' Slide Right
If (m_bKey(vbKeyLeft)) Then m_vVelocity.x = m_vVelocity.x - fSpeed ' Slide Left
If (m_bKey(vbKeyUp)) Then m_vVelocity.y = m_vVelocity.y + fSpeed ' Move up
If (m_bKey(vbKeyDown)) Then m_vVelocity.y = m_vVelocity.y - fSpeed ' Move down
If (m_bKey(vbKeyW)) Then m_vVelocity.z = m_vVelocity.z + fSpeed ' Move Forward
If (m_bKey(vbKeyS)) Then m_vVelocity.z = m_vVelocity.z - fSpeed ' Move Backward
If (m_bKey(vbKeyE)) Then m_fYawVelocity = m_fYawVelocity + fSpeed ' Yaw right
If (m_bKey(vbKeyQ)) Then m_fYawVelocity = m_fYawVelocity - fSpeed ' Yaw left
If (m_bKey(vbKeyZ)) Then m_fPitchVelocity = m_fPitchVelocity + fSpeed ' turn down
If (m_bKey(vbKeyA)) Then m_fPitchVelocity = m_fPitchVelocity - fSpeed ' turn up
If (m_bKey(vbKeyAdd)) Then
If (m_NumParticlesToEmit < 10) Then m_NumParticlesToEmit = m_NumParticlesToEmit + 1
End If
If (m_bKey(vbKeySubtract)) Then
If (m_NumParticlesToEmit > 0) Then m_NumParticlesToEmit = m_NumParticlesToEmit - 1
End If
' Update the position vector
Dim vT As D3DVECTOR, vTemp As D3DVECTOR
D3DXVec3Scale vTemp, m_vVelocity, fSpeed
D3DXVec3Add vT, vT, vTemp
D3DXVec3TransformNormal vT, vT, m_matOrientation
D3DXVec3Add m_vPosition, m_vPosition, vT
If (m_vPosition.y < 1) Then m_vPosition.y = 1
' Update the yaw-pitch-rotation vector
m_fYaw = m_fYaw + fAngularSpeed * m_fYawVelocity
m_fPitch = m_fPitch + fAngularSpeed * m_fPitchVelocity
If (m_fPitch < 0) Then m_fPitch = 0
If (m_fPitch > g_pi / 2) Then m_fPitch = g_pi / 2
Dim qR As D3DQUATERNION, det As Single
D3DXQuaternionRotationYawPitchRoll qR, m_fYaw, m_fPitch, 0
D3DXMatrixAffineTransformation m_matOrientation, 1.25, vec3(0, 0, 0), qR, m_vPosition
D3DXMatrixInverse m_matView, det, m_matOrientation
' Update particle system
If (m_bStaticParticle) Then
m_ParticleSystem.Update m_fElapsedTime, m_NumParticlesToEmit, _
g_clrColor(m_nParticleColor), _
g_clrColorFade(m_nParticleColor), 8, _
vec3(0, 0, 0)
Else
m_ParticleSystem.Update m_fElapsedTime, m_NumParticlesToEmit, _
g_clrColor(m_nParticleColor), _
g_clrColorFade(m_nParticleColor), 8, _
vec3(3 * Sin(g_fTime), 0, 3 * Cos(g_fTime))
End If
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.
'-----------------------------------------------------------------------------
Function Render() As Boolean
Dim v As CUSTOMVERTEX
Dim hr As Long
'See what state the device is in.
Render = False
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 Function
Render = True
' Clear the backbuffer
D3DUtil_ClearAll &HFF&
With g_dev
.BeginScene
' Draw reflection of particles
If (m_bDrawReflection) Then
Dim matReflectedView As D3DMATRIX
D3DXMatrixReflect matReflectedView, m_planeGround
D3DXMatrixMultiply matReflectedView, matReflectedView, m_matView
.SetTransform D3DTS_VIEW, matReflectedView
'Dim clipplane As D3DCLIPPLANE
'LSet clipplane = m_planeGround
'.SetClipPlane 0, clipplane
.SetRenderState D3DRS_CLIPPLANEENABLE, D3DCLIPPLANE0
' Draw particles
.SetTexture 0, m_ParticleTexture
.SetRenderState D3DRS_ZWRITEENABLE, 0 'FALSE
.SetRenderState D3DRS_ALPHABLENDENABLE, 1 'TRUE
m_ParticleSystem.Render g_dev
.SetRenderState D3DRS_ALPHABLENDENABLE, 0 'False
.SetRenderState D3DRS_ZWRITEENABLE, 1 'True
.SetRenderState D3DRS_CLIPPLANEENABLE, 0 'FALSE
.SetRenderState D3DRS_ALPHABLENDENABLE, 1 'True
.SetRenderState D3DRS_SRCBLEND, D3DBLEND_SRCALPHA
.SetRenderState D3DRS_DESTBLEND, D3DBLEND_INVSRCALPHA
.SetTextureStageState 0, D3DTSS_ALPHAOP, D3DTOP_MODULATE
End If
.SetRenderState D3DRS_ALPHABLENDENABLE, 0 'False
.SetRenderState D3DRS_ZWRITEENABLE, 1 'True
.SetRenderState D3DRS_CLIPPLANEENABLE, 0 'FALSE
.SetRenderState D3DRS_ALPHABLENDENABLE, 1 '1 'True
.SetRenderState D3DRS_SRCBLEND, D3DBLEND_SRCALPHA
.SetRenderState D3DRS_DESTBLEND, D3DBLEND_INVSRCALPHA
.SetTextureStageState 0, D3DTSS_ALPHAOP, D3DTOP_MODULATE
' Draw ground
.SetTransform D3DTS_VIEW, m_matView
.SetTexture 0, m_GroundTexture
.SetVertexShader D3DFVF_COLORVERTEX
.SetStreamSource 0, m_GroundVB, Len(v)
.SetIndices m_GroundIB, 0
.DrawIndexedPrimitive D3DPT_TRIANGLELIST, _
0, m_NumGroundVertices, _
0, (m_NumGroundIndices / 3)
' Draw particles
.SetRenderState D3DRS_ALPHABLENDENABLE, 1 'True
.SetRenderState D3DRS_SRCBLEND, D3DBLEND_ONE
.SetRenderState D3DRS_DESTBLEND, D3DBLEND_ONE
.SetTextureStageState 0, D3DTSS_ALPHAOP, D3DTOP_SELECTARG1
.SetRenderState D3DRS_ZWRITEENABLE, 0 'False
.SetRenderState D3DRS_ZENABLE, 1 'TRUE
.SetTexture 0, m_ParticleTexture
.SetRenderState D3DRS_ZENABLE, 0 'False
.SetTexture 0, m_ParticleTexture
m_ParticleSystem.Render g_dev
.SetRenderState D3DRS_ALPHABLENDENABLE, 0 'False
.SetRenderState D3DRS_ZWRITEENABLE, 1 'True
.EndScene
End With
End Function
'-----------------------------------------------------------------------------
' Name: InitDeviceObjects()
' Desc: Initialize scene objects.
'-----------------------------------------------------------------------------
Function InitDeviceObjects() As Boolean
Dim i As Long
Dim v As CUSTOMVERTEX
Set m_GroundTexture = D3DUtil_CreateTexture(g_dev, "Ground2.bmp", D3DFMT_UNKNOWN)
Set m_ParticleTexture = D3DUtil_CreateTexture(g_dev, "Particle.bmp", D3DFMT_UNKNOWN)
' Check if we can do the reflection effect
m_bCanDoAlphaBlend = ((g_d3dCaps.SrcBlendCaps And D3DPBLENDCAPS_SRCALPHA) = D3DPBLENDCAPS_SRCALPHA) And _
((g_d3dCaps.DestBlendCaps And D3DPBLENDCAPS_INVSRCALPHA) = D3DPBLENDCAPS_INVSRCALPHA)
m_bCanDoClipPlanes = (g_d3dCaps.MaxUserClipPlanes >= 1)
' Note: all HW with Software Vertex Processing can do clipplanes
m_bCanDoClipPlanes = True
If (m_bCanDoAlphaBlend And m_bCanDoClipPlanes) Then m_bDrawReflection = True
' Create ground object
' Create vertex buffer for ground object
Set m_GroundVB = g_dev.CreateVertexBuffer(m_NumGroundVertices * Len(v), _
0, D3DFVF_COLORVERTEX, D3DPOOL_MANAGED)
' Fill vertex buffer
Dim zz As Long, xx As Long
ReDim m_grVerts(GROUND_GRIDSIZE * GROUND_GRIDSIZE * 6)
i = 0
For zz = 0 To GROUND_GRIDSIZE
For xx = 0 To GROUND_GRIDSIZE
m_grVerts(i).v.x = GROUND_WIDTH * ((xx / GROUND_GRIDSIZE) - 0.5)
m_grVerts(i).v.y = 0
m_grVerts(i).v.z = GROUND_HEIGHT * ((zz / GROUND_GRIDSIZE) - 0.5)
m_grVerts(i).color = GROUND_COLOR
m_grVerts(i).tu = xx * (GROUND_TILE / GROUND_GRIDSIZE)
m_grVerts(i).tv = zz * (GROUND_TILE / GROUND_GRIDSIZE)
i = i + 1
Next
Next
D3DVertexBuffer8SetData m_GroundVB, 0, Len(v) * (GROUND_GRIDSIZE + 1) * (GROUND_GRIDSIZE + 1), 0, m_grVerts(0)
Dim vtx As Long
Dim m_Indices() As Integer
ReDim m_Indices(m_NumGroundIndices * 4)
Dim z As Long, x As Long
' Create the index buffer
Set m_GroundIB = g_dev.CreateIndexBuffer(m_NumGroundIndices * 2, _
0, _
D3DFMT_INDEX16, D3DPOOL_MANAGED)
' Fill in indices
i = 0
For z = 0 To GROUND_GRIDSIZE - 1
For x = 0 To GROUND_GRIDSIZE - 1
vtx = x + z * (GROUND_GRIDSIZE + 1)
m_Indices(i) = vtx + 1: i = i + 1
m_Indices(i) = vtx + 0: i = i + 1
m_Indices(i) = vtx + 0 + (GROUND_GRIDSIZE + 1): i = i + 1
m_Indices(i) = vtx + 1: i = i + 1
m_Indices(i) = vtx + 0 + (GROUND_GRIDSIZE + 1): i = i + 1
m_Indices(i) = vtx + 1 + (GROUND_GRIDSIZE + 1): i = i + 1
Next
Next
D3DIndexBuffer8SetData m_GroundIB, 0, 2 * m_NumGroundIndices, 0, m_Indices(0)
' Initialize the particle system
m_ParticleSystem.InitDeviceObjects g_dev
InitDeviceObjects = True
End Function
'-----------------------------------------------------------------------------
' Name: VerifyDevice()
'-----------------------------------------------------------------------------
Function VerifyDevice(Behavior As Long, format As CONST_D3DFORMAT) As Boolean
' Make sure device can do ONE:ONE alphablending
If (0 = (g_d3dCaps.SrcBlendCaps And D3DPBLENDCAPS_ONE) = D3DPBLENDCAPS_ONE) Then Exit Function
If (0 = (g_d3dCaps.DestBlendCaps And D3DPBLENDCAPS_ONE) = D3DPBLENDCAPS_ONE) Then Exit Function
' We will run this app using software vertex processing
If (Behavior = D3DCREATE_HARDWARE_VERTEXPROCESSING) Then Exit Function
VerifyDevice = True
End Function
'-----------------------------------------------------------------------------
' Name: DeleteDeviceObjects()
' Desc: Called when the app is exitting, or the device is being changed,
' this function deletes any device dependant objects.
'-----------------------------------------------------------------------------
Sub DeleteDeviceObjects()
Set m_GroundTexture = Nothing
Set m_ParticleTexture = Nothing
Set m_GroundVB = Nothing
Set m_GroundIB = Nothing
If (m_ParticleSystem Is Nothing) Then Exit Sub
m_ParticleSystem.DeleteDeviceObjects
m_binit = False
End Sub
'-----------------------------------------------------------------------------
' Name: FinalCleanup()
' Desc: Called before the app exits, this function gives the app the chance
' to cleanup after itself.
'-----------------------------------------------------------------------------
Sub FinalCleanup()
Set m_GroundTexture = Nothing
Set m_ParticleTexture = Nothing
Set m_ParticleSystem = Nothing
End Sub
'-----------------------------------------------------------------------------
' Name: InvalidateDeviceObjects()
' Desc: Place code to release non managed objects here
'-----------------------------------------------------------------------------
Sub InvalidateDeviceObjects()
'all objects are managed in this sample
End Sub
'-----------------------------------------------------------------------------
' Name: RestoreDeviceObjects()
' Desc:
'-----------------------------------------------------------------------------
Sub RestoreDeviceObjects()
' Set the world matrix
Dim matWorld As D3DMATRIX
D3DXMatrixIdentity matWorld
g_dev.SetTransform D3DTS_WORLD, matWorld
' Set projection matrix
Dim matProj As D3DMATRIX
D3DXMatrixPerspectiveFovLH matProj, g_pi / 4, Me.ScaleHeight / Me.ScaleWidth, 0.1, 100
g_dev.SetTransform D3DTS_PROJECTION, matProj
' Set renderstates
With g_dev
Call .SetTextureStageState(0, D3DTSS_MINFILTER, D3DTEXF_LINEAR)
Call .SetTextureStageState(0, D3DTSS_MAGFILTER, D3DTEXF_LINEAR)
Call .SetTextureStageState(0, D3DTSS_MIPFILTER, D3DTEXF_LINEAR)
Call .SetTextureStageState(0, D3DTSS_COLOROP, D3DTOP_MODULATE)
Call .SetTextureStageState(0, D3DTSS_ALPHAOP, D3DTOP_SELECTARG1)
Call .SetTextureStageState(1, D3DTSS_COLOROP, D3DTOP_DISABLE)
Call .SetTextureStageState(1, D3DTSS_ALPHAOP, D3DTOP_DISABLE)
Call .SetRenderState(D3DRS_SRCBLEND, D3DBLEND_ONE)
Call .SetRenderState(D3DRS_DESTBLEND, D3DBLEND_ONE)
Call .SetRenderState(D3DRS_LIGHTING, 0) 'FALSE
Call .SetRenderState(D3DRS_CULLMODE, D3DCULL_CCW)
Call .SetRenderState(D3DRS_SHADEMODE, D3DSHADE_FLAT)
End With
End Sub

View File

@@ -0,0 +1,42 @@
Type=Exe
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#stdole2.tlb#OLE Automation
Reference=*\G{E1211242-8E94-11D1-8808-00C04FC2C603}#1.0#0#dx8vb.dll#DirectX 8 for Visual Basic Type Library
Form=PointSprites.frm
Module=D3DUtil; ..\..\common\D3DUtil.bas
Class=CD3DMesh; ..\..\common\D3DMesh.cls
Class=CD3DFrame; ..\..\common\D3DFrame.cls
Class=CD3DAnimation; ..\..\common\D3DAnimation.cls
Class=CParticle; D3DParticle.cls
Module=MediaDir; ..\..\common\media.bas
Module=D3DInit; ..\..\common\D3DInit.bas
Form=..\..\common\SelectDevice.frm
Startup="Form1"
ExeName32="vb_PointSprites.exe"
Command32=""
Name="Project1"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="Microsoft"
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1
[MS Transaction Server]
AutoRefresh=1

View File

@@ -0,0 +1,50 @@
//-----------------------------------------------------------------------------
// Name: PointSprites Direct3D Sample
//
// Copyright (C) 1999-2001 Microsoft Corporation. All rights reserved.
//-----------------------------------------------------------------------------
Description
===========
The PointSprites sample shows how to use the new Direct3D point sprites
feature. A point sprite is simply a forward-facing, textured quad that is
referenced only by (x,y,z) position coordinates. Point sprites are most
often used for particle systems and related effects.
Note that not all cards support all features for point sprites. For more
information on point sprites, refer to the DirectX SDK documentation.
Path
====
Source: DXSDK\Samples\Multimedia\VBSamples\Direct3D\PointSprites
Executable: DXSDK\Samples\Multimedia\VBSamples\Direct3D\Bin
User's Guide
============
The following keys are implemented.
<F2> Prompts user to select a new rendering device or display mode
<Alt+Enter> Toggles between fullscreen and windowed modes
<Esc> Exits the app.
Programming Notes
=================
Without Direct3D's support, point sprites can be implemented with four
vertices, that are oriented each frame towards the eyepoint (much like a
billboard). With Direct3D, though, you can refer to each point sprite by
just it's center position and a radius. This saves heavily on processor
computation time and on bandwidth uploading vertex information to the
graphics card.
In this sample, a particle system is implemented using point sprites. Each
particle is actually implemented using multiple alpha-blended point sprites,
giving the particle a motion-blur effect.
This sample makes use of common DirectX code (consisting of helper functions,
etc.) that is shared with other samples on the DirectX SDK. All common
classes and modules can be found in the following directory:
DXSDK\Samples\VBSamples\Multimedia\Common

View File

@@ -0,0 +1,39 @@
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "DataEntry"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' Copyright (C) 1999-2001 Microsoft Corporation. All Rights Reserved.
'
' File: DataEntry.cls
' Content: class that holds a data point
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public dataname As String
Public X As Single
Public Y As Single
Public z As Single
Public datax As Double
Public datay As Double
Public dataz As Double
Public dataSize As Double
Public size As Double
Public color As Long
Public data As Variant
Public mesh As D3DXMesh

File diff suppressed because it is too large Load Diff

View File

@@ -0,0 +1,46 @@
Type=Exe
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#stdole2.tlb#OLE Automation
Reference=*\G{E1211242-8E94-11D1-8808-00C04FC2C603}#1.0#0#dx8vb.dll#DirectX 8 for Visual Basic Type Library
Form=ScatterGraph.frm
Class=DataEntry; DataEntry.cls
Class=CD3DFrame; ..\..\common\D3DFrame.cls
Class=CD3DMesh; ..\..\common\D3DMesh.cls
Class=CD3DPick; ..\..\common\D3DPick.cls
Module=D3DUtil; ..\..\common\d3dutil.bas
Module=D3DInit; ..\..\common\d3dinit.bas
Class=CD3DAnimation; ..\..\common\D3DAnimation.cls
Object={F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0; comdlg32.ocx
Module=MediaDir; ..\..\common\media.bas
Startup="GraphForm"
HelpFile=""
NoControlUpgrade=1
ExeName32="vb_ScatterGraph.exe"
Command32=""
Name="ScatterGraph"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="Microsoft"
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1
UseExistingBrowser=0
[MS Transaction Server]
AutoRefresh=1

View File

@@ -0,0 +1,9 @@
GraphForm = 154, 154, 649, 598, Z, 149, -10, 644, 434, C
DataEntry = 0, 0, 0, 0, C
CD3DFrame = 0, 0, 0, 0, C
CD3DMesh = 0, 0, 0, 0, C
CD3DPick = 0, 0, 0, 0, C
D3DUtil = 101, 99, 596, 543,
D3DInit = 132, 132, 627, 576, C
CD3DAnimation = 0, 0, 0, 0, C
MediaDir = 176, 176, 644, 620,

View File

@@ -0,0 +1,81 @@
//-----------------------------------------------------------------------------
//
// Sample Name: ScatterGraph Sample
//
// Copyright (C) 1999-2001 Microsoft Corporation. All rights reserved.
//
//-----------------------------------------------------------------------------
Description
===========
The ScatterGraph sample describes how one might use Direct3D for graphic visualization.
It makes heavy use of the RenderToSurface features of D3DX to render text and bitmaps
dynamically.
Path
====
Source: DXSDK\Samples\Multimedia\VBSamples\Direct3D\ScatterGraph
Executable: DXSDK\Samples\Multimedia\VBSamples\Direct3D\Bin
User's Guide
============
right click to bring up a pop up menu for the following options
Load Data From File from this menu you can load new data from a .csv
(comma delimeted file) such a file can be exported
from excel or any spreadsheet package.
Reset Orientation reset the viewpoint to a know state
Show Connecting Lines if the order of the data is important
this connects the data points
Show Height Lines makes it easier to see the Y value in comparison
to other values
Show Foot lines makes it easier to see the X Z relation ship
Show Base plane plane where y=0
Auto rotate turn on and off rotation
Any csv file to be loaded must be formated such that the first row is a header.
The formating is as follows with [] indicating optional components:
Name, X Axis Name, Y Axis Name, Z Axis Name, [Size Name], [Color Name]
Entries for Axis and Size must be numeric. those for color must fit the format
&HFF102030, where 10 20 30 is the red,green and blue component.
see sampledata.csv in Mssd\Samples\Multimedia\VBSamples\Media for an example
Holding the left mouse button and dragging will rotate the graph.
Right Arrow moves the camera right
Left Arrow moves the camera left
Up Arrow moves the camera up
Down Arrow moves the camera down
W moves the camera forward
S moves the camera backward
E rotates the camera right
Q rotates the camera left
A rotates the camera up
Z rotates the camera down
Programming Notes
=================
This sample makes use of common DirectX code (consisting of helper functions,
etc.) that is shared with other samples on the DirectX SDK. All common
classes and modules can be found in the following directory:
DXSDK\Samples\Multimedia\VBSamples\Common

View File

@@ -0,0 +1,302 @@
VERSION 5.00
Begin VB.Form frmSkinnedMesh
Caption = "Skinned Mesh"
ClientHeight = 6015
ClientLeft = 60
ClientTop = 345
ClientWidth = 7530
Icon = "SkinnedMesh.frx":0000
LinkTopic = "Form3"
ScaleHeight = 401
ScaleMode = 3 'Pixel
ScaleWidth = 502
StartUpPosition = 3 'Windows Default
End
Attribute VB_Name = "frmSkinnedMesh"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' Copyright (C) 1999-2001 Microsoft Corporation. All Rights Reserved.
'
' File: skinnedMesh.frm
' Content: Animate Skinned Geometry
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
Dim Character As CD3DFrame
Dim Animation As CD3DAnimation
Dim MediaDir As String
Dim m_bInit As Boolean
Dim m_bMinimized As Boolean
Private Sub Form_Load()
Dim hr As Long
Me.Show
DoEvents
'find a path to our media
MediaDir = FindMediaDir("tiny.x")
D3DUtil_SetMediaPath MediaDir
' 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, Me)
If Not (m_bInit) Then End
' Create new D3D mesh and animation objects
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
If Render Then
' Present the image to the screen
D3DUtil_PresentAll g_focushwnd
End If
' Allow for events to get processed
DoEvents
Loop
End Sub
'-----------------------------------------------------------------------------
' Name: FrameMove()
' Desc:
'-----------------------------------------------------------------------------
Sub FrameMove()
Dim apptime As Single
'get ellapsed time since start of application
apptime = DXUtil_Timer(TIMER_GETAPPTIME)
'Have our animation pose our character
Animation.SetTime (apptime) * 4000
'Rotate the character
Character.AddRotation COMBINE_replace, 0, 0, 1, 3.14 + (apptime) / 8
'Update all frame matrices (required for skinning)
Character.UpdateFrames
End Sub
'-----------------------------------------------------------------------------
' Name: Render()
' Desc:
'-----------------------------------------------------------------------------
Function Render() As Boolean
Dim hr As Long
Render = False
'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 Function
Render = True
'Clear the background to ARGB grey
D3DUtil_ClearAll &HFF9090FF
'Start the Scene
g_dev.BeginScene
'Render the character
Character.RenderSkins
'End the scene
g_dev.EndScene
End Function
'-----------------------------------------------------------------------------
' Name: InitDeviceObjects()
' Desc:
'-----------------------------------------------------------------------------
Sub InitDeviceObjects()
'Create an Animation object to hold any animations
Set Animation = New CD3DAnimation
'Load a skinned character
Set Character = D3DUtil_LoadFromFileAsSkin(MediaDir + "tiny.x", Nothing, Animation)
End Sub
'-----------------------------------------------------------------------------
' Name: RestoreDeviceObjects()
' Desc:
'-----------------------------------------------------------------------------
Sub RestoreDeviceObjects()
'Set up some lights and camera
g_lWindowWidth = Me.ScaleWidth
g_lWindowHeight = Me.ScaleHeight
D3DUtil_SetupDefaultScene
'position the camera
D3DUtil_SetupCamera vec3(0, 800, 200), vec3(0, 0, 200), vec3(0, 0, 1)
End Sub
'-----------------------------------------------------------------------------
' Name: InvalidateDeviceObjects()
' Desc: Place code to release non managed objects here
'-----------------------------------------------------------------------------
Sub InvalidateDeviceObjects()
'all objects are managed
End Sub
'-----------------------------------------------------------------------------
' Name: DeleteDeviceObjects()
' Desc:
'-----------------------------------------------------------------------------
Sub DeleteDeviceObjects()
Set Animation = Nothing
Set Character = Nothing
m_bInit = False
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
RestoreDeviceObjects
End Sub
'-----------------------------------------------------------------------------
' Name: Form_Unload()
' Desc:
'-----------------------------------------------------------------------------
Private Sub Form_Unload(Cancel As Integer)
DeleteDeviceObjects
End
End Sub
'-----------------------------------------------------------------------------
' Name: Form_Unload()
' Desc:
'-----------------------------------------------------------------------------
Public Function VerifyDevice(flags As Long, format As CONST_D3DFORMAT) As Boolean
If flags = D3DCREATE_HARDWARE_VERTEXPROCESSING Then Exit Function
VerifyDevice = True
End Function

View File

@@ -0,0 +1,44 @@
Type=Exe
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#stdole2.tlb#OLE Automation
Reference=*\G{E1211242-8E94-11D1-8808-00C04FC2C603}#1.0#0#dx8vb.dll#DirectX 8 for Visual Basic Type Library
Module=D3DUtil; ..\..\common\D3DUtil.bas
Module=D3DInit; ..\..\common\D3DInit.bas
Module=MediaDir; ..\..\common\media.bas
Class=CD3DPick; ..\..\common\D3DPick.cls
Class=CD3DAnimation; ..\..\common\D3DAnimation.cls
Class=CD3DFrame; ..\..\common\D3DFrame.cls
Class=CD3DMesh; ..\..\common\D3DMesh.cls
Form=..\..\common\SelectDevice.frm
Form=SkinnedMesh.frm
Startup="frmSkinnedMesh"
HelpFile=""
Title="VB Skinned Mesh"
ExeName32="vb_SkinnedMesh.exe"
Command32=""
Name="SkinnedMesh"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="Microsoft"
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1
[MS Transaction Server]
AutoRefresh=1

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.1 KiB

View File

@@ -0,0 +1,48 @@
//-----------------------------------------------------------------------------
//
// Sample Name: SkinnedMesh Sample
//
// Copyright (C) 1999-2001 Microsoft Corporation. All rights reserved.
//
//-----------------------------------------------------------------------------
Description
===========
The SkinnedMesh sample illustrates how to use the d3d framework to load an x-file with
skinning and animation information in it.
Path
====
Source: DXSDK\Samples\Multimedia\VBSamples\Direct3D\SkinnedMesh
Executable: DXSDK\Samples\Multimedia\VBSamples\Direct3D\Bin
User's Guide
============
The following keys are implemented. The dropdown menus can be used for the
same controls.
<F2> Prompts user to select a new rendering device or display mode
<Alt+Enter> Toggles between fullscreen and windowed modes
<Esc> Exits the app.
Programming Notes
=================
Note that the last argument passed to D3DUtil_LoadFromFileAsSkin is a CD3DAnimation
class that is the parent to any animations that are found in the xfile.
Animation.SetTime must be called but will not pose the model.
Character.UpdateFrames computes the matrices for all joints on the character
Character.RenderSkin will render the character using the loaded skin
This sample makes use of common DirectX code (consisting of helper functions,
etc.) that is shared with other samples on the DirectX SDK. All common
classes and modules can be found in the following directory:
DXSDK\Samples\Multimedia\VBSamples\Common
The modeling exporters in the extras directory of the SDK can export to x with skinning infromation.

View File

@@ -0,0 +1,194 @@
VERSION 5.00
Begin 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
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute 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 DirectX8
Dim g_D3D As Direct3D8 'Used to create the D3DDevice
Dim 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()
Render
End Sub
'-----------------------------------------------------------------------------
' Name: Form_Unload()
'-----------------------------------------------------------------------------
Private Sub Form_Unload(Cancel As Integer)
End
End 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 = True
End Function
'-----------------------------------------------------------------------------
' Name: Cleanup()
' Desc: Releases all previously initialized objects
'-----------------------------------------------------------------------------
Sub Cleanup()
Set g_D3DDevice = Nothing
Set g_D3D = Nothing
End 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

View File

@@ -0,0 +1,34 @@
Type=Exe
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#stdole2.tlb#OLE Automation
Reference=*\G{E1211242-8E94-11D1-8808-00C04FC2C603}#1.0#0#dx8vb.dll#DirectX 8 for Visual Basic Type Library
Form=Tut01_CreateDevice.frm
Startup="Form1"
Command32=""
Name="Project1"
ExeName32="vb_Tut01_CreateDevice.exe"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="Microsoft"
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1
[MS Transaction Server]
AutoRefresh=1

View File

@@ -0,0 +1,25 @@
//-----------------------------------------------------------------------------
// Name: CreateDevice Direct3D Tutorial
//
// Copyright (C) 1999-2001 Microsoft Corporation. All rights reserved.
//-----------------------------------------------------------------------------
Description
===========
The CreateDevice tutorial is the first tutorial for using the new Direct3D
interfaces for DirectX 8. It shows how to create a Direct3DDevice8 object.
Path
====
Source: DXSDK\Samples\Multimedia\VBSamples\D3D\Tutorials\Tut01_CreateDevice
Programming Notes
=================
The first step of using Direct3D is creating a device. This tutorial is
so simple, that nothing is rendered with the device. The device is used
to clear the backbuffer and present the backbuffer contents, but that is
all.

View File

@@ -0,0 +1,300 @@
VERSION 5.00
Begin VB.Form Form1
BorderStyle = 1 'Fixed Single
Caption = "Vertices"
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
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'-----------------------------------------------------------------------------
' File: Tut02_Vertices.frm
'
' Desc: In this tutorial, we are rendering some vertices. This introduces the
' concept of the vertex buffer, a Direct3D object used to store
' vertices. Vertices can be defined any way we want by defining a
' custom structure and a custom FVF (flexible vertex format). In this
' tutorial, we are using vertices that are transformed (meaning they
' are already in 2D window coordinates) and lit (meaning we are not
' using Direct3D lighting, but are supplying our own colors).
'
' Copyright (C) 1999-2001 Microsoft Corporation. All rights reserved.
'-----------------------------------------------------------------------------
Option Explicit
'-----------------------------------------------------------------------------
' variables
'-----------------------------------------------------------------------------
Dim g_DX As New DirectX8
Dim g_D3D As Direct3D8 'Used to create the D3DDevice
Dim g_D3DDevice As Direct3DDevice8 'Our rendering device
Dim g_VB As Direct3DVertexBuffer8
' A structure for our custom vertex type
' representing a point on the screen
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
' Our custom FVF, which describes our custom vertex structure
Const D3DFVF_CUSTOMVERTEX = (D3DFVF_XYZRHW Or D3DFVF_DIFFUSE)
'-----------------------------------------------------------------------------
' 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
b = InitVB()
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()
Render
End Sub
'-----------------------------------------------------------------------------
' Name: Form_Unload()
'-----------------------------------------------------------------------------
Private Sub Form_Unload(Cancel As Integer)
End
End 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
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).
' Use the same format as 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 = True
End Function
'-----------------------------------------------------------------------------
' Name: InitVB()
' Desc: Creates a vertex buffer and fills it with our vertices. The vertex
' buffer is basically just a chuck of memory that holds vertices. After
' creating it, we must D3DVertexBuffer8SetData to fill it. For indices,
' D3D also uses index buffers. The special thing about vertex and index
' buffers is that they can be created in device memory, allowing some
' cards to process them in hardware, resulting in a dramatic
' performance gain.
'-----------------------------------------------------------------------------
Function InitVB() As Boolean
' Initialize three vertices for rendering a triangle
Dim Vertices(2) As CUSTOMVERTEX
Dim VertexSizeInBytes As Long
VertexSizeInBytes = Len(Vertices(0))
With Vertices(0): .x = 150: .y = 50: .z = 0.5: .rhw = 1: .color = &HFFFF0000: End With
With Vertices(1): .x = 250: .y = 250: .z = 0.5: .rhw = 1: .color = &HFF00FF00: End With
With Vertices(2): .x = 50: .y = 250: .z = 0.5: .rhw = 1: .color = &HFF00FFFF: End With
' Create the vertex buffer. Here we are allocating enough memory
' (from the default pool) to hold all our 3 custom vertices. We also
' specify the FVF, so the vertex buffer knows what data it contains.
' LengthInBytes= VertexSizeInBytes *3 (For total size of our buffer)
' fvf=D3DFVF_CUSTOMVERTEX (Describes whats in our vertex)
' flags= 0 (default)
' pool=D3DPOOL_DEFAULT (Let d3d decide what kind of memory)
Set g_VB = g_D3DDevice.CreateVertexBuffer(VertexSizeInBytes * 3, _
0, D3DFVF_CUSTOMVERTEX, D3DPOOL_DEFAULT)
If g_VB Is Nothing Then Exit Function
' Now we fill the vertex buffer. To do this in Visual Basic we will use the
' D3DVertexBuffer8SetData helper function. It locks the vertex buffer
' copys data in and then unlocks the surface all with one call
' VBuffer=g_VB The vertex buffer we want to fill
' Offset=0 We want to fill from the start of the buffer
' Size=VertSizeInBytes*3 Copy 3 CUSTOMVERTEX types into the buffer
' flags=0 Send default flags to the lock
' data=Vertices(0) This param is as any
' To use it we send the first element
' in our array
D3DVertexBuffer8SetData g_VB, 0, VertexSizeInBytes * 3, 0, Vertices(0)
InitVB = True
End Function
'-----------------------------------------------------------------------------
' Name: Cleanup()
' Desc: Releases all previously initialized objects
'-----------------------------------------------------------------------------
Sub Cleanup()
Set g_VB = Nothing
Set g_D3DDevice = Nothing
Set g_D3D = Nothing
End Sub
'-----------------------------------------------------------------------------
' Name: Render()
' Desc: Draws the scene
'-----------------------------------------------------------------------------
Sub Render()
Dim v As CUSTOMVERTEX
Dim sizeOfVertex As Long
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
'Draw the triangles in the vertex buffer. This is broken into a few
' steps. We are passing the vertices down a "stream", so first we need
' to specify the source of that stream, which is our vertex buffer. Then
' we need to let D3D know what vertex shader to use. Full, custom vertex
' shaders are an advanced topic, but in most cases the vertex shader is
' just the FVF, so that D3D knows what type of vertices we are dealing
' with. Finally, we call DrawPrimitive() which does the actual rendering
' of our geometry (in this case, just one triangle).
sizeOfVertex = Len(v)
g_D3DDevice.SetStreamSource 0, g_VB, sizeOfVertex
g_D3DDevice.SetVertexShader D3DFVF_CUSTOMVERTEX
g_D3DDevice.DrawPrimitive D3DPT_TRIANGLELIST, 0, 1
' 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

View File

@@ -0,0 +1,34 @@
Type=Exe
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#stdole2.tlb#OLE Automation
Reference=*\G{E1211242-8E94-11D1-8808-00C04FC2C603}#1.0#0#dx8vb.dll#DirectX 8 for Visual Basic Type Library
Form=Tut02_vertices.frm
Startup="Form1"
Command32=""
Name="Project1"
ExeName32="vb_Tut02_Vertices.exe"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="Microsoft"
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1
[MS Transaction Server]
AutoRefresh=1

View File

@@ -0,0 +1,27 @@
//-----------------------------------------------------------------------------
// Name: Vertices Direct3D Tutorial
//
// Copyright (C) 1999-2001 Microsoft Corporation. All rights reserved.
//-----------------------------------------------------------------------------
Description
===========
The Vertices tutorial demonstrates the necessary API to render vertices
using Direct3D.
Path
====
Source: DXSDK\Samples\Multimedia\VBSamples\D3D\Tutorials\Tut02_Vertices
Programming Notes
=================
To render geometry in Direct3D, a vertex buffer must be created and filled
with vertices that described the geometry. Vertices can have many components
including positions, normals, blend weights, colors, and texture
coordinates. This simple tutorial uses vertices with only positions and
colors. The important parts of the tutorial are vertex buffer creation,
locking and filling the vertex buffer, and rendering the vertex buffer.

View File

@@ -0,0 +1,313 @@
VERSION 5.00
Begin VB.Form Form1
BorderStyle = 1 'Fixed Single
Caption = "Matrices"
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
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'-----------------------------------------------------------------------------
' File: Tut03_Matrices.frm
'
'
' Desc: Now that we know how to create a device and render some 2D vertices,
' this tutorial goes the next step and renders 3D geometry. To deal with
' 3D geometry we need to introduce the use of 4x4 matrices to transform
' the geometry with translations, rotations, scaling, and setting up our
' camera.
'
' Geometry is defined in model space. We can move it (translation),
' rotate it (rotation), or stretch it (scaling) using a world transform.
' The geometry is then said to be in world space. Next, we need to
' position the camera, or eye point, somewhere to look at the geometry.
' Another transform, via the view matrix, is used, to position and
' rotate our view. With the geometry then in view space, our last
' transform is the projection transform, which "projects" the 3D scene
' into our 2D viewport.
'
' Note that in this tutorial, we are introducing the use of D3DX, which
' is a set up helper utilities for D3D. In this case, we are using some
' of D3DX's useful matrix initialization functions.
'
' Copyright (C) 1999-2001 Microsoft Corporation. All rights reserved.
'-----------------------------------------------------------------------------
Option Explicit
'-----------------------------------------------------------------------------
' variables
'-----------------------------------------------------------------------------
Dim g_DX As New DirectX8
Dim g_D3D As Direct3D8 'Used to create the D3DDevice
Dim g_D3DDevice As Direct3DDevice8 'Our rendering device
Dim g_VB As Direct3DVertexBuffer8
' A structure for our custom vertex type
' representing a point on the screen
Private Type CUSTOMVERTEX
x As Single 'x in screen space
y As Single 'y in screen space
z As Single 'normalized z
color As Long 'vertex color
End Type
' Our custom FVF, which describes our custom vertex structure
Const D3DFVF_CUSTOMVERTEX = (D3DFVF_XYZ Or D3DFVF_DIFFUSE)
Const 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
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()
Render
End Sub
'-----------------------------------------------------------------------------
' Name: Form_Unload()
'-----------------------------------------------------------------------------
Private Sub Form_Unload(Cancel As Integer)
End
End 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
Dim mode As D3DDISPLAYMODE
g_D3D.GetAdapterDisplayMode D3DADAPTER_DEFAULT, mode
' Fill in the type structure used to create the device
Dim d3dpp As D3DPRESENT_PARAMETERS
d3dpp.Windowed = 1
d3dpp.SwapEffect = D3DSWAPEFFECT_COPY_VSYNC
d3dpp.BackBufferFormat = mode.Format
' 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 off D3D lighting, since we are providing our own vertex colors
g_D3DDevice.SetRenderState D3DRS_LIGHTING, 0
InitD3D = True
End 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
D3DXMatrixRotationY matWorld, 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, matProj
End Sub
'-----------------------------------------------------------------------------
' Name: InitGeometry()
' Desc: Creates a vertex buffer and fills it with our vertices.
'-----------------------------------------------------------------------------
Function InitGeometry() As Boolean
' Initialize three vertices for rendering a triangle
Dim Vertices(2) As CUSTOMVERTEX
Dim VertexSizeInBytes As Long
VertexSizeInBytes = Len(Vertices(0))
With Vertices(0): .x = -1: .y = -1: .z = 0: .color = &HFFFF0000: End With
With Vertices(1): .x = 1: .y = -1: .z = 0: .color = &HFF00FF00: End With
With Vertices(2): .x = 0: .y = 1: .z = 0: .color = &HFF00FFFF: End With
' Create the vertex buffer.
Set g_VB = g_D3DDevice.CreateVertexBuffer(VertexSizeInBytes * 3, _
0, D3DFVF_CUSTOMVERTEX, D3DPOOL_DEFAULT)
If g_VB Is Nothing Then Exit Function
' fill the vertex buffer from our array
D3DVertexBuffer8SetData g_VB, 0, VertexSizeInBytes * 3, 0, Vertices(0)
InitGeometry = True
End Function
'-----------------------------------------------------------------------------
' Name: Cleanup()
' Desc: Releases all previously initialized objects
'-----------------------------------------------------------------------------
Sub Cleanup()
Set g_VB = Nothing
Set g_D3DDevice = Nothing
Set g_D3D = Nothing
End Sub
'-----------------------------------------------------------------------------
' Name: Render()
' Desc: Draws the scene
'-----------------------------------------------------------------------------
Sub Render()
Dim v As CUSTOMVERTEX
Dim sizeOfVertex As Long
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
g_D3DDevice.Clear 0, ByVal 0, D3DCLEAR_TARGET, &HFF&, 1#, 0
' Begin the scene
g_D3DDevice.BeginScene
' Setup the world, view, and projection matrices
SetupMatrices
'Draw the triangles in the vertex buffer
sizeOfVertex = Len(v)
g_D3DDevice.SetStreamSource 0, g_VB, sizeOfVertex
g_D3DDevice.SetVertexShader D3DFVF_CUSTOMVERTEX
g_D3DDevice.DrawPrimitive D3DPT_TRIANGLELIST, 0, 1
' 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 = z
End Function

View File

@@ -0,0 +1,34 @@
Type=Exe
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#stdole2.tlb#OLE Automation
Reference=*\G{E1211242-8E94-11D1-8808-00C04FC2C603}#1.0#0#dx8vb.dll#DirectX 8 for Visual Basic Type Library
Form=Tut03_matrices.frm
Startup="Form1"
Command32=""
Name="Project1"
ExeName32="vb_Tut03_Matrices.exe"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="Microsoft"
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1
[MS Transaction Server]
AutoRefresh=1

View File

@@ -0,0 +1,29 @@
//-----------------------------------------------------------------------------
// Name: Matrices Direct3D Tutorial
//
// Copyright (C) 1999-2001 Microsoft Corporation. All rights reserved.
//-----------------------------------------------------------------------------
Description
===========
The Matrices tutorial shows how to use 4x4 matrices to transform vertices
in Direct3D.
Path
====
Source: DXSDK\Samples\Multimedia\VBSamples\D3D\Tutorials\Tut03_Matrices
Programming Notes
=================
To render vertices in 3D, certain mathematical transformations must be
performed on the vertices. This includes the world transform (which
translates, rotates, and scales the geometry), the view transform (which
orients the camera, or view) and the projection transform (which projects
the 3D scene into 2D viewport). Transforms are represented mathematically
as 4x4 matrices. This tutorial introdcues the use of the D3DX helper
library, which contains (amongst other things) functions to build and
manipulate our 4x4 tranform matrices.

View File

@@ -0,0 +1,373 @@
VERSION 5.00
Begin VB.Form Form1
BorderStyle = 1 'Fixed Single
Caption = "Lights"
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
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'-----------------------------------------------------------------------------
' File: Tut04_lights.frm
'
'
' Desc: Rendering 3D geometry is much more interesting when dynamic lighting
' is added to the scene. To use lighting in D3D, you must create one or
' lights, setup a material, and make sure your geometry contains surface
' normals. Lights may have a position, a color, and be of a certain type
' such as directional (light comes from one direction), point (light
' comes from a specific x,y,z coordinate and radiates in all directions)
' or spotlight. Materials describe the surface of your geometry,
' specifically, how it gets lit (diffuse color, ambient color, etc.).
' Surface normals are part of a vertex, and are needed for the D3D's
' internal lighting calculations.
'
' Copyright (C) 1999-2001 Microsoft Corporation. All rights reserved.
'-----------------------------------------------------------------------------
Option Explicit
'-----------------------------------------------------------------------------
' variables
'-----------------------------------------------------------------------------
Dim g_DX As New DirectX8
Dim g_D3D As Direct3D8 'Used to create the D3DDevice
Dim g_D3DDevice As Direct3DDevice8 'Our rendering device
Dim g_VB As Direct3DVertexBuffer8
' A structure for our custom vertex type
Private Type CUSTOMVERTEX
postion As D3DVECTOR '3d position for vertex
normal As D3DVECTOR 'surface normal for vertex
End Type
' Our custom FVF, which describes our custom vertex structure
Const D3DFVF_CUSTOMVERTEX = (D3DFVF_XYZ Or D3DFVF_NORMAL)
Const 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
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()
Render
End Sub
'-----------------------------------------------------------------------------
' Name: Form_Unload()
'-----------------------------------------------------------------------------
Private Sub Form_Unload(Cancel As Integer)
End
End 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
' Note lighting is on by default
InitD3D = True
End 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 1 1 1 axis.
Dim matWorld As D3DMATRIX
D3DXMatrixRotationAxis matWorld, vec3(1, 1, 1), 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, matProj
End 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: Creates a vertex buffer and fills it with our vertices.
'-----------------------------------------------------------------------------
Function InitGeometry() As Boolean
Dim i As Long
' Initialize three vertices for rendering a triangle
Dim Vertices(99) As CUSTOMVERTEX
Dim VertexSizeInBytes As Long
Dim theta As Single
VertexSizeInBytes = Len(Vertices(0))
' We are algorithmically generating a cylinder
' here, including the normals, which are used for lighting.
' normals are vectors that are of length 1 and point in a direction
' perpendicular to the plane of the triangle the normal belongs to
' In later tutorials we will use d3dx to generate them
For i = 0 To 49
theta = (2 * g_pi * i) / (50 - 1)
Vertices(2 * i + 0).postion = vec3(Sin(theta), -1, Cos(theta))
Vertices(2 * i + 0).normal = vec3(Sin(theta), 0, Cos(theta))
Vertices(2 * i + 1).postion = vec3(Sin(theta), 1, Cos(theta))
Vertices(2 * i + 1).normal = vec3(Sin(theta), 0, Cos(theta))
Next
' Create the vertex buffer.
Set g_VB = g_D3DDevice.CreateVertexBuffer(VertexSizeInBytes * 50 * 2, _
0, D3DFVF_CUSTOMVERTEX, D3DPOOL_DEFAULT)
If g_VB Is Nothing Then Exit Function
' fill the vertex buffer from our array
D3DVertexBuffer8SetData g_VB, 0, VertexSizeInBytes * 100, 0, Vertices(0)
InitGeometry = True
End Function
'-----------------------------------------------------------------------------
' Name: Cleanup()
' Desc: Releases all previously initialized objects
'-----------------------------------------------------------------------------
Sub Cleanup()
Set g_VB = Nothing
Set g_D3DDevice = Nothing
Set g_D3D = Nothing
End Sub
'-----------------------------------------------------------------------------
' Name: Render()
' Desc: Draws the scene
'-----------------------------------------------------------------------------
Sub Render()
Dim v As CUSTOMVERTEX
Dim sizeOfVertex 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
' Begin the scene
g_D3DDevice.BeginScene
' Setup the lights and materials
SetupLights
' Setup the world, view, and projection matrices
SetupMatrices
' Draw the triangles in the vertex buffer
' Note we are now using a triangle strip of vertices
' instead of a triangle list
sizeOfVertex = Len(v)
g_D3DDevice.SetStreamSource 0, g_VB, sizeOfVertex
g_D3DDevice.SetVertexShader D3DFVF_CUSTOMVERTEX
g_D3DDevice.DrawPrimitive D3DPT_TRIANGLESTRIP, 0, (4 * 25) - 2
' 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 = z
End Function

View File

@@ -0,0 +1,34 @@
Type=Exe
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#stdole2.tlb#OLE Automation
Reference=*\G{E1211242-8E94-11D1-8808-00C04FC2C603}#1.0#0#dx8vb.dll#DirectX 8 for Visual Basic Type Library
Form=Tut04_lights.frm
Startup="Form1"
Command32=""
Name="Project1"
ExeName32="vb_Tut04_lights.exe"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="Microsoft"
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1
[MS Transaction Server]
AutoRefresh=1

View File

@@ -0,0 +1,28 @@
//-----------------------------------------------------------------------------
// Name: Lights Direct3D Tutorial
//
// Copyright (C) 1999-2001 Microsoft Corporation. All rights reserved.
//-----------------------------------------------------------------------------
Description
===========
The Lights tutorial shows how to use dynamic lighting in Direct3D.
Path
====
Source: DXSDK\Samples\Multimedia\VBSamples\D3D\Tutorials\Tut04_Lights
Programming Notes
=================
Dynamic lighting makes 3D objects look more realistic. Lights come in a few
flavors, notably point lights and directional lights. Geometry gets lit by
every light in the scene, so adding lights increases rendering time. Point
lights have a poistion and are computationally more expensive than directional
lights, which only have a direction (as if the light source is infinitely far
away). Internal Direct3D lighting calculations require surface normals, so note
that normals are added to the vertices. Also, material properties can be set,
which describe how the surface interacts with the light (i.e. it's color).

View File

@@ -0,0 +1,442 @@
VERSION 5.00
Begin VB.Form Form1
BorderStyle = 1 'Fixed Single
Caption = "Textures"
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
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'-----------------------------------------------------------------------------
' File: Tut05_textures.frm
'
' Desc: Better than just lights and materials, 3D objects look much more
' convincing when texture-mapped. Textures can be thought of as a sort
' of wallpaper, that is shrinkwrapped to fit a texture. Textures are
' typically loaded from image files, and D3DX provides a utility to
' function to do this for us. Like a vertex buffer, textures have
' Lock() and Unlock() functions to access (read or write) the image
' data. Textures have a width, height, miplevel, and pixel format. The
' miplevel is for "mipmapped" textures, an advanced performance-
' enhancing feature which uses lower resolutions of the texture for
' objects in the distance where detail is less noticeable. The pixel
' format determines how the colors are stored in a texel. The most
' common formats are the 16-bit R5G6B5 format (5 bits of red, 6-bits of
' green and 5 bits of blue) and the 32-bit A8R8G8B8 format (8 bits each
' of alpha, red, green, and blue).
'
' Textures are associated with geometry through texture coordinates.
' Each vertex has one or more sets of texture coordinates, which are
' named tu and tv and range from 0.0 to 1.0. Texture coordinates can be
' supplied by the geometry, or can be automatically generated using
' Direct3D texture coordinate generation (which is an advanced feature).
'
' Copyright (C) 1999-2001 Microsoft Corporation. All rights reserved.
'-----------------------------------------------------------------------------
Option Explicit
'-----------------------------------------------------------------------------
' variables
'-----------------------------------------------------------------------------
Dim g_DX As New DirectX8
Dim g_D3DX As New D3DX8
Dim g_D3D As Direct3D8 ' Used to create the D3DDevice
Dim g_D3DDevice As Direct3DDevice8 ' Our rendering device
Dim g_VB As Direct3DVertexBuffer8 ' Holds our vertex data
Dim g_Texture As Direct3DTexture8 ' Our texture
' A structure for our custom vertex type
Private Type CUSTOMVERTEX
postion As D3DVECTOR '3d position for vertex
color As Long 'color of the vertex
tu As Single 'texture map coordinate
tv As Single 'texture map coordinate
End Type
' Our custom FVF, which describes our custom vertex structure
Const D3DFVF_CUSTOMVERTEX = (D3DFVF_XYZ Or D3DFVF_DIFFUSE Or D3DFVF_TEX1)
Const 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()
Render
End Sub
'-----------------------------------------------------------------------------
' Name: Form_Unload()
'-----------------------------------------------------------------------------
Private Sub Form_Unload(Cancel As Integer)
Cleanup
End
End 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 off lighting we are going to use colored vertices
g_D3DDevice.SetRenderState D3DRS_LIGHTING, 0
InitD3D = True
End 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 1 1 1 axis.
Dim matWorld As D3DMATRIX
D3DXMatrixRotationAxis matWorld, vec3(1, 1, 1), 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, matProj
End 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: Creates a vertex buffer and fills it with our vertices.
'-----------------------------------------------------------------------------
Function InitGeometry() As Boolean
Dim i As Long
'Use D3DX to create a texture from a file based image
Set g_Texture = g_D3DX.CreateTextureFromFile(g_D3DDevice, App.Path + "\banana.bmp")
If g_Texture Is Nothing Then Exit Function
' Initialize three vertices for rendering a triangle
Dim Vertices(99) As CUSTOMVERTEX
Dim VertexSizeInBytes As Long
Dim theta As Single
VertexSizeInBytes = Len(Vertices(0))
' We are algorithmically generating a cylinder
' here, including the normals, which are used for lighting.
' normals are vectors that are of length 1 and point in a direction
' perpendicular to the plane of the triangle the normal belongs to
' In later tutorials we will use d3dx to generate them
For i = 0 To 49
theta = (2 * g_pi * i) / (50 - 1)
Vertices(2 * i + 0).postion = vec3(Sin(theta), -1, Cos(theta))
Vertices(2 * i + 0).color = &HFFFFFFFF 'white
Vertices(2 * i + 0).tu = i / (50 - 1)
Vertices(2 * i + 0).tv = 1
Vertices(2 * i + 1).postion = vec3(Sin(theta), 1, Cos(theta))
Vertices(2 * i + 1).color = &HFF808080 'grey
Vertices(2 * i + 1).tu = i / (50 - 1)
Vertices(2 * i + 1).tv = 0
Next
' Create the vertex buffer.
Set g_VB = g_D3DDevice.CreateVertexBuffer(VertexSizeInBytes * 50 * 2, _
0, D3DFVF_CUSTOMVERTEX, D3DPOOL_DEFAULT)
If g_VB Is Nothing Then Exit Function
' fill the vertex buffer from our array
D3DVertexBuffer8SetData g_VB, 0, VertexSizeInBytes * 100, 0, Vertices(0)
InitGeometry = True
End Function
'-----------------------------------------------------------------------------
' Name: Cleanup()
' Desc: Releases all previously initialized objects
'-----------------------------------------------------------------------------
Sub Cleanup()
Set g_Texture = Nothing
Set g_VB = Nothing
Set g_D3DDevice = Nothing
Set g_D3D = Nothing
End Sub
'-----------------------------------------------------------------------------
' Name: Render()
' Desc: Draws the scene
'-----------------------------------------------------------------------------
Sub Render()
Dim v As CUSTOMVERTEX
Dim sizeOfVertex 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
' Begin the scene
g_D3DDevice.BeginScene
' Setup our texture. Using textures introduces the texture stage states,
' which govern how textures get blended together (in the case of multiple
' textures) and lighting information. In this case, we are modulating
' (blending) our texture with the diffuse color of the vertices.
g_D3DDevice.SetTexture 0, g_Texture
g_D3DDevice.SetTextureStageState 0, D3DTSS_COLOROP, D3DTOP_MODULATE
g_D3DDevice.SetTextureStageState 0, D3DTSS_COLORARG1, D3DTA_TEXTURE
g_D3DDevice.SetTextureStageState 0, D3DTSS_COLORARG2, D3DTA_DIFFUSE
g_D3DDevice.SetTextureStageState 0, D3DTSS_ALPHAOP, D3DTOP_DISABLE
'Uncomment to learn about texture coordinate matrices
'AnimateTextureCoordinates
' Setup the world, view, and projection matrices
SetupMatrices
' Draw the triangles in the vertex buffer
' Note we are now using a triangle strip of vertices
' instead of a triangle list
sizeOfVertex = Len(v)
g_D3DDevice.SetStreamSource 0, g_VB, sizeOfVertex
g_D3DDevice.SetVertexShader D3DFVF_CUSTOMVERTEX
g_D3DDevice.DrawPrimitive D3DPT_TRIANGLESTRIP, 0, (4 * 25) - 2
' 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: AnimateTextureCoordinates()
' Desc: Advanced technique for generating texture coordinates
'-----------------------------------------------------------------------------
Sub AnimateTextureCoordinates()
' Note: to use D3D texture coordinate generation, use the stage state
' D3DTSS_TEXCOORDINDEX, as shown below. In this example, we are using
' the position of the vertex in camera space to generate texture
' coordinates. The tex coord index (TCI) parameters are passed into a
' texture transform, which is a 4x4 matrix which transforms the x,y,z
' TCI coordinates into tu, tv texture coordinates.
' In this example, the texture matrix is setup to
' transform the texture from (-1,+1) position coordinates to (0,1)
' texture coordinate space:
' tu = 0.25*x + 0.5
' tv = -0.25*y + 0.5
Dim mat As D3DMATRIX
mat.m11 = 0.25: mat.m12 = 0#: mat.m13 = 0#: mat.m14 = 0#
mat.m21 = 0#: mat.m22 = -0.25: mat.m23 = 0#: mat.m24 = 0#
mat.m31 = 0#: mat.m32 = 0#: mat.m33 = 1#: mat.m34 = 0#
mat.m41 = 0.5: mat.m42 = 0.5: mat.m43 = 0#: mat.m44 = 1#
g_D3DDevice.SetTransform D3DTS_TEXTURE0, mat
g_D3DDevice.SetTextureStageState 0, D3DTSS_TEXTURETRANSFORMFLAGS, D3DTTFF_COUNT2
g_D3DDevice.SetTextureStageState 0, D3DTSS_TEXCOORDINDEX, D3DTSS_TCI_CAMERASPACEPOSITION
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 = z
End Function

View File

@@ -0,0 +1,34 @@
Type=Exe
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#stdole2.tlb#OLE Automation
Reference=*\G{E1211242-8E94-11D1-8808-00C04FC2C603}#1.0#0#dx8vb.dll#DirectX 8 for Visual Basic Type Library
Form=Tut05_textures.frm
Startup="Form1"
Command32=""
Name="Project1"
ExeName32="vb_Tut05_Textures.exe"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="Microsoft"
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1
[MS Transaction Server]
AutoRefresh=1

Binary file not shown.

After

Width:  |  Height:  |  Size: 192 KiB

View File

@@ -0,0 +1,28 @@
//-----------------------------------------------------------------------------
// Name: Textures Direct3D Tutorial
//
// Copyright (C) 1999-2001 Microsoft Corporation. All rights reserved.
//-----------------------------------------------------------------------------
Description
===========
The Textures tutorial shows how to use texture mapping in Direct3D.
Path
====
Source: DXSDK\Samples\Multimedia\VBSamples\D3D\Tutorials\Tut05_Textures
Programming Notes
=================
Texture-mapping is like shrink-wrapping a wall paper to a 3D object. A classic
example is applying an image of wood to an otherwise plain cube, to give the
appearance as if the block is actually made of wood. Textures (in their
simplest form) are 2D images, usually loaded from an image file. This tutorial
shows how to use D3DX to create a texture from a file-based image and apply it
to a geometry. Textures require the vertices to have texture coordinates, and
make use of certain RenderStates and TextureStageStates and show in the source
code.

View File

@@ -0,0 +1,384 @@
VERSION 5.00
Begin 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
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute 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 DirectX8
Dim g_D3DX As New D3DX8
Dim g_D3D As Direct3D8 ' Used to create the D3DDevice
Dim g_D3DDevice As Direct3DDevice8 ' Our rendering device
Dim g_Mesh As D3DXMesh ' Our Mesh
Dim g_MeshMaterials() As D3DMATERIAL8 ' Mesh Material data
Dim g_MeshTextures() As Direct3DTexture8 ' Mesh Textures
Dim g_NumMaterials As Long
Const 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()
Render
End Sub
'-----------------------------------------------------------------------------
' Name: Form_Unload()
'-----------------------------------------------------------------------------
Private Sub Form_Unload(Cancel As Integer)
Cleanup
End
End 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 = True
End 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, matProj
End 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 = True
End 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 = Nothing
End 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 = z
End Function

View File

@@ -0,0 +1,34 @@
Type=Exe
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#stdole2.tlb#OLE Automation
Reference=*\G{E1211242-8E94-11D1-8808-00C04FC2C603}#1.0#0#dx8vb.dll#DirectX 8 for Visual Basic Type Library
Form=Tut06_meshes.frm
Startup="Form1"
Command32=""
Name="Project1"
ExeName32="vb_Tut06_Meshes.exe"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="Microsoft"
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1
[MS Transaction Server]
AutoRefresh=1

View File

@@ -0,0 +1,26 @@
//-----------------------------------------------------------------------------
// Name: Meshes Direct3D Tutorial
//
// Copyright (C) 1999-2001 Microsoft Corporation. All rights reserved.
//-----------------------------------------------------------------------------
Description
===========
The Textures tutorial shows how to load and render file-based geometry
meshes in Direct3D.
Path
====
Source: DXSDK\Samples\Multimedia\VBSamples\D3D\Tutorials\Tut06_Meshes
Programming Notes
=================
Complicated geometry is usally modelled using 3D modelling software and
saved in a file, such as Microsoft's .x file format. Using meshes can be
somewhat involved, but fortunately D3DX contains functions to help out. This
tutorial shows how use the D3DX functions to load and render file-based
meshes. Note that we still have to handle materials and textures manually.

Binary file not shown.

After

Width:  |  Height:  |  Size: 65 KiB

File diff suppressed because it is too large Load Diff

View File

@@ -0,0 +1,41 @@
Type=Exe
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\WINNT\System32\stdole2.tlb#OLE Automation
Reference=*\G{E1211242-8E94-11D1-8808-00C04FC2C603}#1.0#0#C:\WINNT\system32\dx8vb.dll#DirectX 8 for Visual Basic Type Library
Form=vertexblend.frm
Module=D3DUtil; ..\..\common\D3DUtil.bas
Class=CD3DMesh; ..\..\common\D3DMesh.cls
Class=CD3DFrame; ..\..\common\D3DFrame.cls
Class=CD3DAnimation; ..\..\common\D3DAnimation.cls
Module=MediaDir; ..\..\Common\media.bas
Form=..\..\common\SelectDevice.frm
Module=D3DInit; ..\..\common\D3DInit.bas
Startup="Form1"
ExeName32="vb_VertexBlend.exe"
Command32=""
Name="Project1"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="Microsoft"
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1
[MS Transaction Server]
AutoRefresh=1

View File

@@ -0,0 +1,53 @@
//-----------------------------------------------------------------------------
// Name: VertexBlend Direct3D Sample
//
// Copyright (C) 1999-2001 Microsoft Corporation. All rights reserved.
//-----------------------------------------------------------------------------
Description
===========
The VertexBlend sample demonstrates a technique called vertex blending (also
known as surface skinning). It displays a file-based object which is made to
bend is various spots.
Surface skinning is an impressive technique used for effects like smooth
joints and bulging muscles in character animations.
Note that not all cards support all features for vertex blending. For more
information on vertex blending, refer to the DirectX SDK documentation.
Path
====
Source: DXSDK\Samples\Multimedia\VBSamples\Direct3D\VertexBlend
Executable: DXSDK\Samples\Multimedia\VBSamples\Direct3D\Bin
User's Guide
============
The following keys are implemented.
<F2> Prompts user to select a new rendering device or display mode
<Alt+Enter> Toggles between fullscreen and windowed modes
<Esc> Exits the app.
Programming Notes
=================
Vertex blending requires each vertex to have an associated blend weight.
Multiple world transforms are set up using SetTransformState() and the
blend weights determine how much contribution each world matrix has when
positioning each vertex.
In this sample, a mesh is loaded using the common helper code. What is
important is how a custom vertex and a custom FVF is declared and used
to build the mesh (see the SetFVF() call for the mesh object). Without
using the mesh helper code, the technique is the same: just create a
vertex buffer full of vertices that have a blend weight, and use the
appropriate FVF.
This sample makes use of common DirectX code (consisting of helper functions,
etc.) that is shared with other samples on the DirectX SDK. All common
classes and modules can be found in the following directory:
DXSDK\Samples\Multimedia\VBSamples\Common

View File

@@ -0,0 +1,418 @@
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
End
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) 1999-2001 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
If Render Then
' Present the image to the screen
D3DUtil_PresentAll g_focushwnd
End If
' 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.
'-----------------------------------------------------------------------------
Function Render() As Boolean
Dim hr As Long
Render = False
'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 Function
Render = True
' 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 Function
'-----------------------------------------------------------------------------
' 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

View File

@@ -0,0 +1,43 @@
//-----------------------------------------------------------------------------
// Name: VertexShader Direct3D Sample
//
// Copyright (C) 1999-2001 Microsoft Corporation. All rights reserved.
//-----------------------------------------------------------------------------
Description
===========
This sample shows some of the effects that can be achieved using vertex
shaders. Vertex shaders use a set of instructions, executed by the 3D
device on a per-vertex basis, that can affect the properties of the
vertex (positions, normal, color, tex coords, etc.) in interesting ways.
Note that not all cards may support all the various features vertex shaders.
For more information on vertex shaders, refer to the DirectX SDK
documentation.
Path
====
Source: DXSDK\Samples\Multimedia\VBSamples\Direct3D\VertexShader
Executable: DXSDK\Samples\Multimedia\VBSamples\Direct3D\Bin
User's Guide
============
The following keys are implemented.
<F2> Prompts user to select a new rendering device or display mode
<Alt+Enter> Toggles between fullscreen and windowed modes
<Esc> Exits the app.
Programming Notes
=================
Programming vertex shaders is not a trivial task. Please read any vertex
shader-specific documentation accompanying the DirectX SDK.
This sample makes use of common DirectX code (consisting of helper functions,
etc.) that is shared with other samples on the DirectX SDK. All common
classes and modules can be found in the following directory:
DXSDK\Samples\Multimedia\VBSamples\Common

View File

@@ -0,0 +1,554 @@
VERSION 5.00
Begin VB.Form Form1
Caption = "Vertex Blend"
ClientHeight = 4485
ClientLeft = 60
ClientTop = 345
ClientWidth = 5640
Icon = "vertexshader.frx":0000
LinkTopic = "Form1"
ScaleHeight = 299
ScaleMode = 3 'Pixel
ScaleWidth = 376
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
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' Copyright (C) 1999-2001 Microsoft Corporation. All Rights Reserved.
'
' File: VertexShader.frm
' Content: Example code showing how to use vertex shaders in D3D.
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
' Scene
Dim m_VB As Direct3DVertexBuffer8
Dim m_IB As Direct3DIndexBuffer8
Dim m_NumVertices As Long
Dim m_NumIndices As Long
Dim m_Shader As Long
Dim m_Size As Long
' Transforms
Dim m_matPosition As D3DMATRIX
Dim m_matView As D3DMATRIX
Dim m_matProj As D3DMATRIX
'Navigation
Dim m_bKey(256) As Boolean
Dim m_fSpeed As Single
Dim m_fAngularSpeed As Single
Dim m_vVelocity As D3DVECTOR
Dim m_vAngularVelocity As D3DVECTOR
'Shader
Dim m_Decl(3) As Long
Dim m_ShaderArray() As Long
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()
Me.Show
DoEvents
'setup defaults
Init
' 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, Me)
If Not (m_bInit) Then End
' Create new D3D vertexbuffer objects and vertex shader
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
If Render Then
' Present the image to the screen
D3DUtil_PresentAll g_focushwnd
End If
' Allow for events to get processed
DoEvents
Loop
End Sub
'-----------------------------------------------------------------------------
' Name: Form_Unload()
' Desc:
'-----------------------------------------------------------------------------
Private Sub Form_Unload(Cancel As Integer)
DeleteDeviceObjects
End
End Sub
'-----------------------------------------------------------------------------
' Name: Init()
' Desc: Sets attributes for the app.
'-----------------------------------------------------------------------------
Sub Init()
Me.Caption = "VertexShader"
Set m_IB = Nothing
Set m_VB = Nothing
m_Size = 32
m_NumIndices = (m_Size - 1) * (m_Size - 1) * 6
m_NumVertices = m_Size * m_Size
m_Shader = 0
m_fSpeed = 5
m_fAngularSpeed = 1
m_vVelocity = vec3(0, 0, 0)
m_vAngularVelocity = vec3(0, 0, 0)
' Setup the view matrix
Dim veye As D3DVECTOR, vat As D3DVECTOR, vUp As D3DVECTOR
veye = vec3(2, 3, 3)
vat = vec3(0, 0, 0)
vUp = vec3(0, 1, 0)
D3DXMatrixLookAtRH m_matView, veye, vat, vUp
' Set the position matrix
Dim det As Single
D3DXMatrixInverse m_matPosition, det, m_matView
End Sub
'-----------------------------------------------------------------------------
' Name: FrameMove()
' Desc: Called once per frame, the call is the entry point for animating
' the scene.
'-----------------------------------------------------------------------------
Sub FrameMove()
Dim fSecsPerFrame As Single
Dim fTime As Single
Dim det As Single
fSecsPerFrame = DXUtil_Timer(TIMER_GETELLAPSEDTIME)
fTime = DXUtil_Timer(TIMER_GETAPPTIME)
' Process keyboard input
Dim vT As D3DVECTOR, vR As D3DVECTOR
vT = vec3(0, 0, 0)
vR = vec3(0, 0, 0)
If (m_bKey(vbKeyA) Or m_bKey(vbKeyNumpad1) Or m_bKey(vbKeyLeft)) Then vT.x = vT.x - 1 ' Slide Left
If (m_bKey(vbKeyD) Or m_bKey(vbKeyNumpad3) Or m_bKey(vbKeyRight)) Then vT.x = vT.x + 1 ' Slide Right
If (m_bKey(vbKeyDown)) Then vT.y = vT.y - 1 ' Slide Down
If (m_bKey(vbKeyUp)) Then vT.y = vT.y + 1 ' Slide Up
If (m_bKey(vbKeyW)) Then vT.z = vT.z - 2 ' Move Forward
If (m_bKey(vbKeyS)) Then vT.z = vT.z + 2 ' Move Backward
If (m_bKey(vbKeyNumpad8)) Then vR.x = vR.x - 1 ' Pitch Down
If (m_bKey(vbKeyNumpad2)) Then vR.x = vR.x + 1 ' Pitch Up
If (m_bKey(vbKeyE) Or m_bKey(vbKeyNumpad6)) Then vR.y = vR.y - 1 ' Turn Right
If (m_bKey(vbKeyQ) Or m_bKey(vbKeyNumpad4)) Then vR.y = vR.y + 1 ' Turn Left
If (m_bKey(vbKeyNumpad9)) Then vR.z = vR.z - 2 ' Roll CW
If (m_bKey(vbKeyNumpad7)) Then vR.z = vR.z + 2 ' Roll CCW
m_vVelocity.x = m_vVelocity.x * 0.9 + vT.x * 0.1
m_vVelocity.y = m_vVelocity.y * 0.9 + vT.y * 0.1
m_vVelocity.z = m_vVelocity.z * 0.9 + vT.z * 0.1
m_vAngularVelocity.x = m_vAngularVelocity.x * 0.9 + vR.x * 0.1
m_vAngularVelocity.y = m_vAngularVelocity.x * 0.9 + vR.y * 0.1
m_vAngularVelocity.z = m_vAngularVelocity.x * 0.9 + vR.z * 0.1
' Update position and view matricies
Dim matT As D3DMATRIX, matR As D3DMATRIX, qR As D3DQUATERNION
D3DXVec3Scale vT, m_vVelocity, fSecsPerFrame * m_fSpeed
D3DXVec3Scale vR, m_vAngularVelocity, fSecsPerFrame * m_fAngularSpeed
D3DXMatrixTranslation matT, vT.x, vT.y, vT.z
D3DXMatrixMultiply m_matPosition, matT, m_matPosition
D3DXQuaternionRotationYawPitchRoll qR, vR.y, vR.x, vR.z
D3DXMatrixRotationQuaternion matR, qR
D3DXMatrixMultiply m_matPosition, matR, m_matPosition
D3DXMatrixInverse m_matView, det, m_matPosition
g_dev.SetTransform D3DTS_VIEW, m_matView
' Set up the vertex shader constants
Dim mat As D3DMATRIX
Dim vA As D3DVECTOR4, vD As D3DVECTOR4
Dim vSin As D3DVECTOR4, vCos As D3DVECTOR4
D3DXMatrixMultiply mat, m_matView, m_matProj
D3DXMatrixTranspose mat, mat
vA = vec4(Sin(fTime) * 15, 0, 0.5, 1)
vD = vec4(g_pi, 1 / (2 * g_pi), 2 * g_pi, 0.05)
' Taylor series coefficients for sin and cos
vSin = vec4(1, -1 / 6, 1 / 120, -1 / 5040)
vCos = vec4(1, -1 / 2, 1 / 24, -1 / 720)
g_dev.SetVertexShaderConstant 0, mat, 4
g_dev.SetVertexShaderConstant 4, vA, 1
g_dev.SetVertexShaderConstant 7, vD, 1
g_dev.SetVertexShaderConstant 10, vSin, 1
g_dev.SetVertexShaderConstant 11, vCos, 1
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.
'-----------------------------------------------------------------------------
Function Render() As Boolean
Dim v2 As D3DVECTOR2
Dim hr As Long
Render = False
'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 Function
Render = True
'Clear the scene
D3DUtil_ClearAll &HFF&
With g_dev
' Begin the scene
.BeginScene
.SetVertexShader m_Shader
.SetStreamSource 0, m_VB, Len(v2)
.SetIndices m_IB, 0
.DrawIndexedPrimitive D3DPT_TRIANGLELIST, 0, m_NumVertices, _
0, m_NumIndices / 3
' End the scene.
.EndScene
End With
End Function
'-----------------------------------------------------------------------------
' Name: RestoreDeviceObjects()
' Desc: Initialize scene objects.
'-----------------------------------------------------------------------------
Sub InitDeviceObjects()
Dim Indices() As Integer 'Integer are 4 bytes wide in VB
Dim Vertices() As D3DVECTOR2
Dim v As D3DVECTOR2, x As Integer, y As Integer, i As Integer
' Fill in our index array with triangles indices to make a grid
ReDim Indices(m_NumIndices)
For y = 1 To m_Size - 1
For x = 1 To m_Size - 1
Indices(i) = (y - 1) * m_Size + (x - 1): i = i + 1
Indices(i) = (y - 0) * m_Size + (x - 1): i = i + 1
Indices(i) = (y - 1) * m_Size + (x - 0): i = i + 1
Indices(i) = (y - 1) * m_Size + (x - 0): i = i + 1
Indices(i) = (y - 0) * m_Size + (x - 1): i = i + 1
Indices(i) = (y - 0) * m_Size + (x - 0): i = i + 1
Next
Next
' Create index buffer and copy the VB array into it
Set m_IB = g_dev.CreateIndexBuffer(m_NumIndices * 2, 0, D3DFMT_INDEX16, D3DPOOL_MANAGED)
D3DIndexBuffer8SetData m_IB, 0, m_NumIndices * 2, 0, Indices(0)
i = 0
'Fill our vertex array with the coordinates of our grid
ReDim Vertices(m_NumVertices)
For y = 0 To m_Size - 1
For x = 0 To m_Size - 1
Vertices(i) = vec2(((CSng(x) / CSng(m_Size - 1)) - 0.5) * g_pi, _
((CSng(y) / CSng(m_Size - 1)) - 0.5) * g_pi)
i = i + 1
Next
Next
' Create a vertex buffer and copy our vertex array into it
Set m_VB = g_dev.CreateVertexBuffer(m_NumVertices * Len(v), 0, 0, D3DPOOL_MANAGED)
D3DVertexBuffer8SetData m_VB, 0, m_NumVertices * Len(v), 0, Vertices(0)
' Create vertex shader
Dim strVertexShaderPath As String
Dim VShaderCode As D3DXBuffer
m_Decl(0) = D3DVSD_STREAM(0)
m_Decl(1) = D3DVSD_REG(D3DVSDE_POSITION, D3DVSDT_FLOAT2)
m_Decl(2) = D3DVSD_END()
' Find the vertex shader file
strVertexShaderPath = FindMediaDir("ripple.vsh") + "ripple.vsh"
'Assemble the vertex shader from the file
Set VShaderCode = g_d3dx.AssembleShaderFromFile(strVertexShaderPath, 0, "", Nothing)
'Move VShader code into an array
ReDim m_ShaderArray(VShaderCode.GetBufferSize() / 4)
g_d3dx.BufferGetData VShaderCode, 0, 1, VShaderCode.GetBufferSize(), m_ShaderArray(0)
Set VShaderCode = Nothing
End Sub
'-----------------------------------------------------------------------------
' Name: RestoreDeviceObjects()
' Desc: Initialize scene objects.
'-----------------------------------------------------------------------------
Sub RestoreDeviceObjects()
Dim bufferdesc As D3DSURFACE_DESC
g_dev.GetBackBuffer(0, D3DBACKBUFFER_TYPE_MONO).GetDesc bufferdesc
' Set up right handed projection matrix
Dim fAspectRatio As Single
fAspectRatio = bufferdesc.width / bufferdesc.height
D3DXMatrixPerspectiveFovRH m_matProj, 60 * g_pi / 180, fAspectRatio, 0.1, 100
g_dev.SetTransform D3DTS_PROJECTION, m_matProj
' Setup render states
g_dev.SetRenderState D3DRS_LIGHTING, 0 'FALSE
g_dev.SetRenderState D3DRS_CULLMODE, D3DCULL_NONE
' Create the vertex shader
' NOTE returns value in m_Shader
g_dev.CreateVertexShader m_Decl(0), m_ShaderArray(0), m_Shader, 0
End Sub
'-----------------------------------------------------------------------------
' Name: InvalidateDeviceObjects()
' Desc:
'-----------------------------------------------------------------------------
Sub InvalidateDeviceObjects()
On Local Error Resume Next
g_dev.DeleteVertexShader m_Shader
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()
Set m_IB = Nothing
Set m_VB = Nothing
InvalidateDeviceObjects
m_bInit = False
End Sub
'-----------------------------------------------------------------------------
' Name: FinalCleanup()
' Desc: Called before the app exits, this function gives the app the chance
' to cleanup after itself.
'-----------------------------------------------------------------------------
Sub FinalCleanup()
End Sub
'-----------------------------------------------------------------------------
' Name: ConfirmDevice()
' Desc: Called during device intialization, this code checks the device
' for some minimum set of capabilities
'-----------------------------------------------------------------------------
Function VerifyDevice(Behavior As Long, format As CONST_D3DFORMAT) As Boolean
If (Behavior <> D3DCREATE_SOFTWARE_VERTEXPROCESSING) Then
If (g_d3dCaps.VertexShaderVersion < D3DVS_VERSION(1, 0)) Then Exit Function
End If
VerifyDevice = True
End Function
'-----------------------------------------------------------------------------
' Name: Form_KeyDown()
' Desc: Process key messages for exit and change device
'-----------------------------------------------------------------------------
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Dim hr As Long
m_bKey(KeyCode) = True
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
hr = D3DUtil_ResetFullscreen
Else
hr = D3DUtil_ResetWindowed
End If
If hr = D3DERR_DEVICELOST Then
DeleteDeviceObjects
m_bInit = D3DUtil_Init(Me.hwnd, True, 0, 0, D3DDEVTYPE_HAL, Me)
If Not (m_bInit) Then End
InitDeviceObjects
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
RestoreDeviceObjects
End Sub
'-----------------------------------------------------------------------------
' Name: Picture1_KeyUp
' Desc:
'-----------------------------------------------------------------------------
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
m_bKey(KeyCode) = False
End Sub

View File

@@ -0,0 +1,42 @@
Type=Exe
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#stdole2.tlb#OLE Automation
Reference=*\G{E1211242-8E94-11D1-8808-00C04FC2C603}#1.0#0#dx8vb.dll#DirectX 8 for Visual Basic Type Library
Form=vertexshader.frm
Form=..\..\common\SelectDevice.frm
Module=D3DInit; ..\..\common\D3DInit.bas
Module=D3DUtil; ..\..\common\D3DUtil.bas
Class=CD3DMesh; ..\..\common\D3DMesh.cls
Class=CD3DFrame; ..\..\common\D3DFrame.cls
Class=CD3DAnimation; ..\..\common\D3DAnimation.cls
Module=MediaDir; ..\..\Common\media.bas
Module=D3DShaders; ..\..\common\D3DShader.bas
Startup="Form1"
ExeName32="vb_VertexShader.exe"
Command32=""
Name="Project1"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="Microsoft"
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1
[MS Transaction Server]
AutoRefresh=1