home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / Post-Proce2075897172007.psc / clsMesh.cls < prev    next >
Text File  |  2007-07-16  |  6KB  |  204 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "clsMesh"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14.  
  15. Option Explicit
  16. Option Base 0
  17.  
  18.  
  19. Private Type structVertex
  20.   pos As D3DVECTOR
  21.   tex As D3DVECTOR2
  22. End Type
  23.  
  24. Private arrStream() As structVertex
  25. Private vBuffer As Direct3DVertexBuffer8
  26.  
  27. Private Const vShader As Long = D3DFVF_XYZ Or D3DFVF_TEX1
  28. Private Const vBytes As Long = 20
  29.  
  30.  
  31. Private Type structFace
  32.   iPos(0 To 2) As Long
  33.   iTex(0 To 2) As Long
  34. End Type
  35.  
  36.  
  37. Public iVertex As Long
  38. Private arrVertex() As D3DVECTOR
  39.  
  40. Public iTexture As Long
  41. Private arrTexture() As D3DVECTOR2
  42.  
  43. Public iFace As Long
  44. Private arrFace() As structFace
  45.  
  46.  
  47. Public Function objLoad(fName As String) As Boolean
  48.  
  49.   On Error Resume Next
  50.   objLoad = False
  51.  
  52.   If Len(Dir(fName)) > 0 Then
  53.   
  54.     Static fIndex As Long
  55.     fIndex = FreeFile
  56.     Open fName For Input As #fIndex
  57.     If Not Err.Number = 0 Then
  58.       Err.Clear
  59.     Else
  60.     
  61.       memClear
  62.       Static strData As String
  63.       Do While Not EOF(fIndex)
  64.         Line Input #fIndex, strData
  65.       
  66.         Select Case UCase(Left(strData, 2))
  67.           
  68.           Case "V" & Chr(32)
  69.             If iVertex = 0 Then
  70.               ReDim arrVertex(0) As D3DVECTOR
  71.             Else
  72.               ReDim Preserve arrVertex(iVertex) As D3DVECTOR
  73.             End If
  74.             strData = Right(strData, Len(strData) - 2)
  75.             Static posSpace1 As Long
  76.             Static posSpace2 As Long
  77.             posSpace1 = InStr(1, strData, Chr(32), vbBinaryCompare)
  78.             posSpace2 = InStr(posSpace1 + 1, strData, Chr(32), vbBinaryCompare)
  79.             With arrVertex(iVertex)
  80.               .X = Val(Left(strData, posSpace1 - 1))
  81.               .Y = Val(Mid(strData, posSpace1 + 1, posSpace2 - posSpace1 - 1))
  82.               .z = Val(Right(strData, Len(strData) - posSpace2))
  83.             End With
  84.             iVertex = iVertex + 1
  85.           
  86.           Case "VT"
  87.             If iTexture = 0 Then
  88.               ReDim arrTexture(0) As D3DVECTOR2
  89.             Else
  90.               ReDim Preserve arrTexture(iTexture) As D3DVECTOR2
  91.             End If
  92.             strData = Right(strData, Len(strData) - 3)
  93.             Static texSpace As Long
  94.             texSpace = InStr(1, strData, Chr(32), vbBinaryCompare)
  95.             With arrTexture(iTexture)
  96.               .X = Val(Left(strData, texSpace - 1))
  97.               .Y = Val(Right(strData, Len(strData) - texSpace))
  98.             End With
  99.             iTexture = iTexture + 1
  100.           
  101.           Case "F" & Chr(32)
  102.             If iFace = 0 Then
  103.               ReDim arrFace(0) As structFace
  104.             Else
  105.               ReDim Preserve arrFace(iFace) As structFace
  106.             End If
  107.             strData = Right(strData, Len(strData) - 2)
  108.             Static triSpace1 As Long
  109.             Static triSpace2 As Long
  110.             Static fDat As String
  111.             Static fSpace As Long
  112.             triSpace1 = InStr(1, strData, Chr(32), vbBinaryCompare)
  113.             triSpace2 = InStr(triSpace1 + 1, strData, Chr(32), vbBinaryCompare)
  114.             With arrFace(iFace)
  115.               fDat = Left(strData, triSpace1 - 1)
  116.               fSpace = InStr(1, fDat, "/", vbBinaryCompare)
  117.               .iPos(0) = Val(Left(fDat, fSpace - 1)) - 1
  118.               .iTex(0) = Val(Right(fDat, Len(fDat) - fSpace)) - 1
  119.               fDat = Mid(strData, triSpace1 + 1, triSpace2 - triSpace1 - 1)
  120.               fSpace = InStr(1, fDat, "/", vbBinaryCompare)
  121.               .iPos(1) = Val(Left(fDat, fSpace - 1)) - 1
  122.               .iTex(1) = Val(Right(fDat, Len(fDat) - fSpace)) - 1
  123.               fDat = Right(strData, Len(strData) - triSpace2)
  124.               fSpace = InStr(1, fDat, "/", vbBinaryCompare)
  125.               .iPos(2) = Val(Left(fDat, fSpace - 1)) - 1
  126.               .iTex(2) = Val(Right(fDat, Len(fDat) - fSpace)) - 1
  127.             End With
  128.             iFace = iFace + 1
  129.           
  130.         End Select
  131.         
  132.       Loop
  133.       Close #fIndex
  134.       
  135.       ReDim arrStream(iFace * 3 - 1) As structVertex
  136.       Static nFace As Long
  137.       Static nVertex As Long
  138.       Static nPoint As Long
  139.       nVertex = 0
  140.       For nFace = 0 To iFace - 1 Step 1
  141.         For nPoint = 0 To 2 Step 1
  142.           With arrStream(nVertex + nPoint)
  143.             .pos = arrVertex(arrFace(nFace).iPos(nPoint))
  144.             .tex = arrTexture(arrFace(nFace).iTex(nPoint))
  145.             .tex.Y = 1 - .tex.Y
  146.           End With
  147.         Next nPoint
  148.         nVertex = nVertex + 3
  149.       Next nFace
  150.  
  151.       Set vBuffer = objD3DDev.CreateVertexBuffer(vBytes * iFace * 3, 0, vShader, D3DPOOL_DEFAULT)
  152.       D3DVertexBuffer8SetData vBuffer, 0, vBytes * iFace * 3, 0, arrStream(0)
  153.       If Not Err.Number = 0 Then
  154.         Err.Clear
  155.       Else
  156.         objLoad = True
  157.       End If
  158.     
  159.     End If
  160.   
  161.   End If
  162.  
  163. End Function
  164.  
  165.  
  166. Public Function objRender() As Boolean
  167.  
  168.   On Error Resume Next
  169.  
  170.   With objD3DDev
  171.     If iFace > 0 Then
  172.       .SetVertexShader vShader
  173.       .SetStreamSource 0, vBuffer, vBytes
  174.       .DrawPrimitive D3DPT_TRIANGLELIST, 0, iFace
  175.     End If
  176.   End With
  177.   
  178.   If Not Err.Number = 0 Then
  179.     Err.Clear
  180.     objRender = False
  181.   Else
  182.     objRender = True
  183.   End If
  184.   
  185. End Function
  186.  
  187.  
  188. Public Function memClear() As Boolean
  189.  
  190.   iVertex = 0
  191.   Erase arrVertex()
  192.   iTexture = 0
  193.   Erase arrTexture()
  194.   iFace = 0
  195.   Erase arrFace()
  196.   
  197.   Erase arrStream()
  198.   Set vBuffer = Nothing
  199.   
  200.   memClear = True
  201.   
  202. End Function
  203.  
  204.