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-Proce2076087182007.psc / mdlFunctions.bas < prev    next >
BASIC Source File  |  2007-07-17  |  2KB  |  62 lines
  1. Attribute VB_Name = "mdlFunctions"
  2.  
  3. Option Explicit
  4.  
  5.  
  6. Public Function mkVec3f(X As Single, Y As Single, Z As Single) As D3DVECTOR
  7.   With mkVec3f
  8.     .X = X
  9.     .Y = Y
  10.     .Z = Z
  11.   End With
  12. End Function
  13.  
  14.  
  15. Public Function shCompile(fName As String) As Long
  16.  
  17.   On Error Resume Next
  18.   shCompile = 0
  19.   
  20.   Static shArray() As Long
  21.   Static shLength As Long
  22.   Static shCode As D3DXBuffer
  23.  
  24.   Set shCode = objD3Dhlp.AssembleShaderFromFile(fName, 0, vbNullString, Nothing)
  25.   shLength = shCode.GetBufferSize() / 4
  26.   
  27.   If Not Err.Number = 0 Then
  28.     Err.Clear
  29.     Set shCode = Nothing
  30.     MsgBox "Could not assemble pixel shader: '" & fName & "'.", vbCritical Or vbOKOnly, "Error"
  31.   Else
  32.   
  33.     ReDim shArray(shLength - 1) As Long
  34.     objD3Dhlp.BufferGetData shCode, 0, 4, shLength, shArray(0)
  35.     
  36.     shCompile = objD3DDev.CreatePixelShader(shArray(0))
  37.     
  38.     If Not Err.Number = 0 Or shCompile = 0 Then
  39.       Err.Clear
  40.       Set shCode = Nothing
  41.       shCompile = 0
  42.       MsgBox "Pixel shader was sucessfully assembled, but failed to create." & vbCrLf & fName, vbCritical Or vbOKOnly, "Error"
  43.     End If
  44.   
  45.   End If
  46.  
  47. End Function
  48.  
  49.  
  50. Public Function txLoad(fName As String) As Direct3DTexture8
  51.  
  52.   On Error Resume Next
  53.  
  54.   Set txLoad = objD3Dhlp.CreateTextureFromFileEx(objD3DDev, fName, -1, -1, 0, 0, D3DFMT_A8R8G8B8, D3DPOOL_DEFAULT, D3DX_FILTER_LINEAR, D3DX_FILTER_LINEAR, 0, ByVal 0, ByVal 0)
  55.   If Not Err.Number = 0 Then
  56.     Err.Clear
  57.     Set txLoad = Nothing
  58.     MsgBox "Failed to load texture map file: '" & fName, vbCritical Or vbOKOnly, "Error"
  59.   End If
  60.  
  61. End Function
  62.