home *** CD-ROM | disk | FTP | other *** search
/ Microsoft DirectX SDK 7.0 / Dx7.bin / DXF / samples / multimedia / vbsamples / d3dim / src / fireworks / fireworksmath.bas < prev    next >
Encoding:
BASIC Source File  |  1999-07-29  |  21.2 KB  |  822 lines

  1. Attribute VB_Name = "MATH"
  2. Option Explicit
  3. '=================================
  4. 'Helper Library for Direct3DIM Applications
  5. '=================================
  6. '
  7. ' Note some functions have 2 implementations
  8. ' Ones that start with Ret tend to be slower
  9. ' than the ones that fill structures by reference
  10. ' both versions are provided because the former
  11. ' is more readable
  12. '
  13. ' Also note that many of these function are also
  14. ' found on the DirectX root object of the DXVB
  15. ' typelibrary.
  16. '
  17. '=================================
  18. 'Constants for IMCanvas texturing
  19. '=================================
  20.  
  21. Global Const D3DTEXTR_TRANSPARENTBLACK = 1
  22. Global Const D3DTEXTR_TRANSPARENTWHITE = 2
  23.  
  24. '=================================
  25. ' FVF VERTEX  helpers
  26. ' used for mutli textured polygons
  27. '=================================
  28. Global Const D3DFVF_TEXTUREFORMAT2 = 0
  29. Global Const D3DFVF_TEXTUREFORMAT1 = 3
  30. Global Const D3DFVF_TEXTUREFORMAT3 = 1
  31. Global Const D3DFVF_TEXTUREFORMAT4 = 2
  32.  
  33. '=================================
  34. ' MatrixMult
  35. '=================================
  36. ' concatentates matrices together.
  37. ' not A x B is not equal to B x A
  38. '
  39. Sub MatrixMult(result As D3DMATRIX, a As D3DMATRIX, b As D3DMATRIX)
  40.   Dim ret As D3DMATRIX
  41.   Dim tmp As Double
  42.   Dim i As Integer
  43.   Dim j As Integer
  44.   Dim k As Integer
  45.   
  46.   Call ZeroMatrix(ret)
  47.   ret.rc11 = b.rc11 * a.rc11 + b.rc21 * a.rc12 + b.rc31 * a.rc13 + b.rc41 * a.rc14
  48.   ret.rc12 = b.rc12 * a.rc11 + b.rc22 * a.rc12 + b.rc32 * a.rc13 + b.rc42 * a.rc14
  49.   ret.rc13 = b.rc13 * a.rc11 + b.rc23 * a.rc12 + b.rc33 * a.rc13 + b.rc43 * a.rc14
  50.   ret.rc14 = b.rc14 * a.rc11 + b.rc24 * a.rc12 + b.rc34 * a.rc13 + b.rc44 * a.rc14
  51.   ret.rc21 = b.rc11 * a.rc21 + b.rc21 * a.rc22 + b.rc31 * a.rc23 + b.rc41 * a.rc24
  52.   ret.rc22 = b.rc12 * a.rc21 + b.rc22 * a.rc22 + b.rc32 * a.rc23 + b.rc42 * a.rc24
  53.   ret.rc23 = b.rc13 * a.rc21 + b.rc23 * a.rc22 + b.rc33 * a.rc23 + b.rc43 * a.rc24
  54.   ret.rc24 = b.rc14 * a.rc21 + b.rc24 * a.rc22 + b.rc34 * a.rc23 + b.rc44 * a.rc24
  55.   ret.rc31 = b.rc11 * a.rc31 + b.rc21 * a.rc32 + b.rc31 * a.rc33 + b.rc41 * a.rc34
  56.   ret.rc32 = b.rc12 * a.rc31 + b.rc22 * a.rc32 + b.rc32 * a.rc33 + b.rc42 * a.rc34
  57.   ret.rc33 = b.rc13 * a.rc31 + b.rc23 * a.rc32 + b.rc33 * a.rc33 + b.rc43 * a.rc34
  58.   ret.rc34 = b.rc14 * a.rc31 + b.rc24 * a.rc32 + b.rc34 * a.rc33 + b.rc44 * a.rc34
  59.   ret.rc41 = b.rc11 * a.rc41 + b.rc21 * a.rc42 + b.rc31 * a.rc43 + b.rc41 * a.rc44
  60.   ret.rc42 = b.rc12 * a.rc41 + b.rc22 * a.rc42 + b.rc32 * a.rc43 + b.rc42 * a.rc44
  61.   ret.rc43 = b.rc13 * a.rc41 + b.rc23 * a.rc42 + b.rc33 * a.rc43 + b.rc43 * a.rc44
  62.   ret.rc44 = b.rc14 * a.rc41 + b.rc24 * a.rc42 + b.rc34 * a.rc43 + b.rc44 * a.rc44
  63.   result = ret
  64. End Sub
  65.  
  66. Function RetMatrixMult(a As D3DMATRIX, b As D3DMATRIX) As D3DMATRIX
  67.   Dim ret As D3DMATRIX
  68.   ret.rc11 = b.rc11 * a.rc11 + b.rc21 * a.rc12 + b.rc31 * a.rc13 + b.rc41 * a.rc14
  69.   ret.rc12 = b.rc12 * a.rc11 + b.rc22 * a.rc12 + b.rc32 * a.rc13 + b.rc42 * a.rc14
  70.   ret.rc13 = b.rc13 * a.rc11 + b.rc23 * a.rc12 + b.rc33 * a.rc13 + b.rc43 * a.rc14
  71.   ret.rc14 = b.rc14 * a.rc11 + b.rc24 * a.rc12 + b.rc34 * a.rc13 + b.rc44 * a.rc14
  72.   ret.rc21 = b.rc11 * a.rc21 + b.rc21 * a.rc22 + b.rc31 * a.rc23 + b.rc41 * a.rc24
  73.   ret.rc22 = b.rc12 * a.rc21 + b.rc22 * a.rc22 + b.rc32 * a.rc23 + b.rc42 * a.rc24
  74.   ret.rc23 = b.rc13 * a.rc21 + b.rc23 * a.rc22 + b.rc33 * a.rc23 + b.rc43 * a.rc24
  75.   ret.rc24 = b.rc14 * a.rc21 + b.rc24 * a.rc22 + b.rc34 * a.rc23 + b.rc44 * a.rc24
  76.   ret.rc31 = b.rc11 * a.rc31 + b.rc21 * a.rc32 + b.rc31 * a.rc33 + b.rc41 * a.rc34
  77.   ret.rc32 = b.rc12 * a.rc31 + b.rc22 * a.rc32 + b.rc32 * a.rc33 + b.rc42 * a.rc34
  78.   ret.rc33 = b.rc13 * a.rc31 + b.rc23 * a.rc32 + b.rc33 * a.rc33 + b.rc43 * a.rc34
  79.   ret.rc34 = b.rc14 * a.rc31 + b.rc24 * a.rc32 + b.rc34 * a.rc33 + b.rc44 * a.rc34
  80.   ret.rc41 = b.rc11 * a.rc41 + b.rc21 * a.rc42 + b.rc31 * a.rc43 + b.rc41 * a.rc44
  81.   ret.rc42 = b.rc12 * a.rc41 + b.rc22 * a.rc42 + b.rc32 * a.rc43 + b.rc42 * a.rc44
  82.   ret.rc43 = b.rc13 * a.rc41 + b.rc23 * a.rc42 + b.rc33 * a.rc43 + b.rc43 * a.rc44
  83.   ret.rc44 = b.rc14 * a.rc41 + b.rc24 * a.rc42 + b.rc34 * a.rc43 + b.rc44 * a.rc44
  84.   RetMatrixMult = ret
  85. End Function
  86.  
  87. '=================================
  88. ' TranslateMatrix
  89. '=================================
  90. ' used to position an object
  91.  
  92. Sub TranslateMatrix(m As D3DMATRIX, v As D3DVECTOR)
  93.   Call IdentityMatrix(m)
  94.   m.rc41 = v.x
  95.   m.rc42 = v.y
  96.   m.rc43 = v.z
  97. End Sub
  98.  
  99. Function RetTranslateMatrix(v As D3DVECTOR) As D3DMATRIX
  100.   Dim m As D3DMATRIX
  101.   Call IdentityMatrix(m)
  102.   m.rc41 = v.x
  103.   m.rc42 = v.y
  104.   m.rc43 = v.z
  105.   RetTranslateMatrix = m
  106. End Function
  107.  
  108.  
  109. '=================================
  110. ' RotateXMatrix
  111. '=================================
  112. ' rotate an object about x axis rad radians
  113.  
  114. Sub RotateXMatrix(ret As D3DMATRIX, rads As Single)
  115.   Dim cosine As Single
  116.   Dim sine As Single
  117.   cosine = Cos(rads)
  118.   sine = Sin(rads)
  119.   Call IdentityMatrix(ret)
  120.   ret.rc22 = cosine
  121.   ret.rc33 = cosine
  122.   ret.rc23 = -sine
  123.   ret.rc32 = sine
  124. End Sub
  125.  
  126. Function RetRotateXMatrix(rads As Single) As D3DMATRIX
  127.   Dim cosine As Single
  128.   Dim sine As Single
  129.   Dim ret As D3DMATRIX
  130.   cosine = Cos(rads)
  131.   sine = Sin(rads)
  132.   Call IdentityMatrix(ret)
  133.   ret.rc22 = cosine
  134.   ret.rc33 = cosine
  135.   ret.rc23 = -sine
  136.   ret.rc32 = sine
  137.   RetRotateXMatrix = ret
  138. End Function
  139.  
  140. '=================================
  141. ' RotateYMatrix
  142. '=================================
  143. ' rotate an object about y axis rad radians
  144.  
  145. Sub RotateYMatrix(ret As D3DMATRIX, rads As Single)
  146.   Dim cosine As Single
  147.   Dim sine As Single
  148.   cosine = Cos(rads)
  149.   sine = Sin(rads)
  150.   Call IdentityMatrix(ret)
  151.   ret.rc11 = cosine
  152.   ret.rc33 = cosine
  153.   ret.rc13 = sine
  154.   ret.rc31 = -sine
  155. End Sub
  156.  
  157. Function RetRotateYMatrix(rads As Single) As D3DMATRIX
  158.   Dim cosine As Single
  159.   Dim sine As Single
  160.   Dim ret As D3DMATRIX
  161.   cosine = Cos(rads)
  162.   sine = Sin(rads)
  163.   Call IdentityMatrix(ret)
  164.   ret.rc11 = cosine
  165.   ret.rc33 = cosine
  166.   ret.rc13 = sine
  167.   ret.rc31 = -sine
  168.   RetRotateYMatrix = ret
  169. End Function
  170.  
  171. '=================================
  172. ' RotateZMatrix
  173. '=================================
  174. ' rotate an object about z axis rad radians
  175.  
  176. Sub RotateZMatrix(ret As D3DMATRIX, rads As Single)
  177.   Dim cosine As Single
  178.   Dim sine As Single
  179.   cosine = Cos(rads)
  180.   sine = Sin(rads)
  181.   Call IdentityMatrix(ret)
  182.   ret.rc11 = cosine
  183.   ret.rc22 = cosine
  184.   ret.rc12 = -sine
  185.   ret.rc21 = sine
  186. End Sub
  187.  
  188. Function RetRotateZMatrix(rads As Single) As D3DMATRIX
  189.   Dim ret As D3DMATRIX
  190.   Dim cosine As Single
  191.   Dim sine As Single
  192.   cosine = Cos(rads)
  193.   sine = Sin(rads)
  194.   Call IdentityMatrix(ret)
  195.   ret.rc11 = cosine
  196.   ret.rc22 = cosine
  197.   ret.rc12 = -sine
  198.   ret.rc21 = sine
  199.   RetRotateZMatrix = ret
  200. End Function
  201.  
  202. '=================================
  203. ' ViewMatrix
  204. '=================================
  205. ' setup the placement of the camera
  206. ' from the location of the camera
  207. ' at is where its looking toward
  208. ' up (usually 0 1 0) is the orientation
  209. ' roll is the sideways tilt of the camera
  210.  
  211.  
  212. Sub ViewMatrix(view As D3DMATRIX, from As D3DVECTOR, at As D3DVECTOR, world_up As D3DVECTOR, roll As Single)
  213.   
  214.   Dim up As D3DVECTOR
  215.   Dim right As D3DVECTOR
  216.   Dim view_Dir As D3DVECTOR
  217.   
  218.   Call IdentityMatrix(view)
  219.   Call VectorSubtract(view_Dir, at, from)
  220.   Call VectorNormalize(view_Dir)
  221.   
  222.   'think lefthanded coords
  223.   Call VectorCrossProduct(right, world_up, view_Dir)
  224.   Call VectorCrossProduct(up, view_Dir, right)
  225.   
  226.   Call VectorNormalize(right)
  227.   Call VectorNormalize(up)
  228.   
  229.   view.rc11 = right.x
  230.   view.rc21 = right.y
  231.   view.rc31 = right.z
  232.   view.rc12 = up.x   'AK? should this be negative?
  233.   view.rc22 = up.y
  234.   view.rc32 = up.z
  235.   view.rc13 = view_Dir.x
  236.   view.rc23 = view_Dir.y
  237.   view.rc33 = view_Dir.z
  238.   
  239.   view.rc41 = -VectorDotProduct(right, from)
  240.   view.rc42 = -VectorDotProduct(up, from)
  241.   view.rc43 = -VectorDotProduct(view_Dir, from)
  242.  
  243.   ' Set roll
  244.   If (roll <> 0#) Then
  245.       Dim rotZMat As D3DMATRIX
  246.       Call RotateZMatrix(rotZMat, -roll)
  247.       Call MatrixMult(view, rotZMat, view)
  248.   End If
  249.   
  250.   
  251. End Sub
  252.  
  253. Function RetViewMatrix(from As D3DVECTOR, at As D3DVECTOR, world_up As D3DVECTOR, roll As Single) As D3DMATRIX
  254.     Dim ret As D3DMATRIX
  255.     ViewMatrix ret, from, at, world_up, roll
  256.   
  257. End Function
  258.  
  259. '=================================
  260. ' ProjectionMatrix
  261. '=================================
  262. ' near_plane (must be greter than zero)
  263. ' and far_plane define a view frustrum
  264. ' the near_plane define how close the camera
  265. ' can see in front of you and the far_plane
  266. ' detrermines how far away the camera can see.
  267. ' fov is in radians and determines the
  268. ' cone angle of the frusrum..
  269. ' (narrow  to wide angle)
  270.  
  271. Sub ProjectionMatrix(ret As D3DMATRIX, _
  272.               near_plane As Single, _
  273.                 far_plane As Single, _
  274.                 fov As Single)
  275.  
  276.               
  277.   Dim c As Single
  278.   Dim s As Single
  279.   Dim Q As Single
  280.   
  281.   
  282.   c = Cos(fov * 0.5)
  283.   s = Sin(fov * 0.5)
  284.   Q = s / (1# - near_plane / far_plane)
  285.  
  286.   Call ZeroMatrix(ret)
  287.   ret.rc11 = c
  288.   ret.rc22 = c
  289.   ret.rc33 = Q
  290.   ret.rc43 = -Q * near_plane
  291.   ret.rc34 = s
  292.   
  293. End Sub
  294.  
  295. Function RetProjectionMatrix( _
  296.         near_plane As Single, _
  297.         far_plane As Single, _
  298.         fov As Single) As D3DMATRIX
  299.     Dim ret As D3DMATRIX
  300.     ProjectionMatrix ret, near_plane, far_plane, fov
  301.     RetProjectionMatrix = ret
  302. End Function
  303.  
  304. '=================================
  305. ' CopyMatrix
  306. '=================================
  307. Sub CopyMatrix(dest As D3DMATRIX, src As D3DMATRIX)
  308.   
  309.   dest.rc11 = src.rc11
  310.   dest.rc12 = src.rc12
  311.   dest.rc13 = src.rc13
  312.   dest.rc14 = src.rc14
  313.   dest.rc21 = src.rc21
  314.   dest.rc22 = src.rc22
  315.   dest.rc23 = src.rc23
  316.   dest.rc24 = src.rc24
  317.   dest.rc31 = src.rc31
  318.   dest.rc32 = src.rc32
  319.   dest.rc33 = src.rc33
  320.   dest.rc34 = src.rc34
  321.   dest.rc41 = src.rc41
  322.   dest.rc42 = src.rc42
  323.   dest.rc43 = src.rc43
  324.   dest.rc44 = src.rc44
  325.   
  326. End Sub
  327.  
  328. Function RetCopyMatrix(src As D3DMATRIX) As D3DMATRIX
  329.     Dim ret As D3DMATRIX
  330.     CopyMatrix ret, src
  331.     RetCopyMatrix = ret
  332. End Function
  333.  
  334. '=================================
  335. ' IdentityMatrix
  336. '=================================
  337. Sub IdentityMatrix(dest As D3DMATRIX)
  338.   
  339.   dest.rc11 = 1
  340.   dest.rc12 = 0
  341.   dest.rc13 = 0
  342.   dest.rc14 = 0
  343.   dest.rc21 = 0
  344.   dest.rc22 = 1
  345.   dest.rc23 = 0
  346.   dest.rc24 = 0
  347.   dest.rc31 = 0
  348.   dest.rc32 = 0
  349.   dest.rc33 = 1
  350.   dest.rc34 = 0
  351.   dest.rc41 = 0
  352.   dest.rc42 = 0
  353.   dest.rc43 = 0
  354.   dest.rc44 = 1
  355.   
  356. End Sub
  357.  
  358. Function RetIdentityMatrix() As D3DMATRIX
  359.     Dim ret As D3DMATRIX
  360.     IdentityMatrix ret
  361. End Function
  362.  
  363. '=================================
  364. ' ZeroMatrix
  365. '=================================
  366.  
  367. Sub ZeroMatrix(dest As D3DMATRIX)
  368.   
  369.   dest.rc11 = 0
  370.   dest.rc12 = 0
  371.   dest.rc13 = 0
  372.   dest.rc14 = 0
  373.   dest.rc21 = 0
  374.   dest.rc22 = 0
  375.   dest.rc23 = 0
  376.   dest.rc24 = 0
  377.   dest.rc31 = 0
  378.   dest.rc32 = 0
  379.   dest.rc33 = 0
  380.   dest.rc34 = 0
  381.   dest.rc41 = 0
  382.   dest.rc42 = 0
  383.   dest.rc43 = 0
  384.   dest.rc44 = 0
  385.   
  386. End Sub
  387.  
  388. Function RetZeroMatrix() As D3DMATRIX
  389.     Dim ret As D3DMATRIX
  390.     ZeroMatrix ret
  391.     RetZeroMatrix = ret
  392. End Function
  393.  
  394.  
  395. '=================================
  396. ' VectorNegate
  397. '=================================
  398. Sub VectorNegate(v As D3DVECTOR)
  399.   v.x = -v.x
  400.   v.y = -v.y
  401.   v.z = -v.z
  402. End Sub
  403.  
  404. Function VNegate(v As D3DVECTOR) As D3DVECTOR
  405.     Dim ret As D3DVECTOR
  406.     ret.x = -v.x
  407.     ret.y = -v.y
  408.     ret.z = -v.z
  409.     VNegate = ret
  410. End Function
  411.  
  412. '=================================
  413. ' VectorSubtract
  414. '=================================
  415. Sub VectorSubtract(dest As D3DVECTOR, a As D3DVECTOR, b As D3DVECTOR)
  416.   dest.x = a.x - b.x
  417.   dest.y = a.y - b.y
  418.   dest.z = a.z - b.z
  419. End Sub
  420.  
  421. Function VSub(a As D3DVECTOR, b As D3DVECTOR) As D3DVECTOR
  422.   Dim dest As D3DVECTOR
  423.   dest.x = a.x - b.x
  424.   dest.y = a.y - b.y
  425.   dest.z = a.z - b.z
  426.   VSub = dest
  427. End Function
  428.  
  429. '=================================
  430. ' VectorAdd
  431. '=================================
  432. Sub VectorAdd(dest As D3DVECTOR, a As D3DVECTOR, b As D3DVECTOR)
  433.   dest.x = a.x + b.x
  434.   dest.y = a.y + b.y
  435.   dest.z = a.z + b.z
  436. End Sub
  437.  
  438. Function VAdd(a As D3DVECTOR, b As D3DVECTOR) As D3DVECTOR
  439.   Dim dest As D3DVECTOR
  440.   dest.x = a.x + b.x
  441.   dest.y = a.y + b.y
  442.   dest.z = a.z + b.z
  443.   VAdd = dest
  444. End Function
  445.  
  446. '=================================
  447. ' VectorCrossProduct
  448. '=================================
  449. ' can be used to compute normals.
  450. '
  451. Sub VectorCrossProduct(dest As D3DVECTOR, a As D3DVECTOR, b As D3DVECTOR)
  452.    dest.x = a.y * b.z - a.z * b.y
  453.    dest.y = a.z * b.x - a.x * b.z
  454.    dest.z = a.x * b.y - a.y * b.x
  455. End Sub
  456.   
  457. Function VCross(a As D3DVECTOR, b As D3DVECTOR) As D3DVECTOR
  458.    Dim dest As D3DVECTOR
  459.    dest.x = a.y * b.z - a.z * b.y
  460.    dest.y = a.z * b.x - a.x * b.z
  461.    dest.z = a.x * b.y - a.y * b.x
  462.    VCross = dest
  463. End Function
  464.   
  465. '=================================
  466. ' VectorNormalize
  467. '=================================
  468. ' creates a vector of length 1 in the same direction
  469. '
  470. Sub VectorNormalize(dest As D3DVECTOR)
  471.   On Local Error Resume Next
  472.   Dim l As Double
  473.   l = dest.x * dest.x + dest.y * dest.y + dest.z * dest.z
  474.   l = Sqr(l)
  475.   If l = 0 Then
  476.     dest.x = 0
  477.     dest.y = 0
  478.     dest.z = 0
  479.     Exit Sub
  480.   End If
  481.   dest.x = dest.x / l
  482.   dest.y = dest.y / l
  483.   dest.z = dest.z / l
  484. End Sub
  485.   
  486. Function VNormalize(dest As D3DVECTOR) As D3DVECTOR
  487.  
  488.   Dim ret As D3DVECTOR
  489.   
  490.   Dim l As Double
  491.   l = dest.x * dest.x + dest.y * dest.y + dest.z * dest.z
  492.   l = Sqr(l)
  493.   If l = 0 Then
  494.     ret.x = 0
  495.     ret.y = 0
  496.     ret.z = 0
  497.   Else
  498.     ret.x = dest.x / l
  499.     ret.y = dest.y / l
  500.     ret.z = dest.z / l
  501.   End If
  502.   VNormalize = ret
  503. End Function
  504.   
  505. '=================================
  506. ' VectorDotProduct
  507. '=================================
  508. Function VectorDotProduct(a As D3DVECTOR, b As D3DVECTOR) As Single
  509.   VectorDotProduct = a.x * b.x + a.y * b.y + a.z * b.z
  510. End Function
  511.  
  512. Function VDot(a As D3DVECTOR, b As D3DVECTOR) As Single
  513.   VDot = a.x * b.x + a.y * b.y + a.z * b.z
  514. End Function
  515.  
  516. '=================================
  517. ' VectorAddAndScale
  518. '=================================
  519. Sub VectorAddAndScale(dest As D3DVECTOR, s1 As Single, v1 As D3DVECTOR, s2 As Single, v2 As D3DVECTOR)
  520.   dest.x = s1 * v1.x + s2 * v2.x
  521.   dest.y = s1 * v1.y + s2 * v2.y
  522.   dest.z = s1 * v1.z + s2 * v2.z
  523. End Sub
  524.  
  525. '=================================
  526. ' VectorCopy
  527. '=================================
  528. Sub VectorCopy(dest As D3DVECTOR, src As D3DVECTOR)
  529.   dest.x = src.x
  530.   dest.y = src.y
  531.   dest.z = src.z
  532. End Sub
  533.  
  534. Function VCopy(src As D3DVECTOR) As D3DVECTOR
  535.   Dim dest As D3DVECTOR
  536.   dest.x = src.x
  537.   dest.y = src.y
  538.   dest.z = src.z
  539.   VCopy = dest
  540. End Function
  541.  
  542. '=================================
  543. ' VectorScale
  544. '=================================
  545. ' scale a vector by a scalar
  546. Sub VectorScale(dest As D3DVECTOR, src As D3DVECTOR, s As Single)
  547.   dest.x = src.x * s
  548.   dest.y = src.y * s
  549.   dest.z = src.z * s
  550. End Sub
  551.  
  552. Function VScale(src As D3DVECTOR, s As Single) As D3DVECTOR
  553.   Dim dest As D3DVECTOR
  554.   dest.x = src.x * s
  555.   dest.y = src.y * s
  556.   dest.z = src.z * s
  557.   VScale = dest
  558. End Function
  559.  
  560. '=================================
  561. ' MakeVector
  562. '=================================
  563. Sub MakeVector(v As D3DVECTOR, x As Single, y As Single, z As Single)
  564.     v.x = x
  565.     v.y = z
  566.     v.z = y
  567. End Sub
  568.  
  569. Function RVector(x As Single, y As Single, z As Single) As D3DVECTOR
  570.     Dim v As D3DVECTOR
  571.     v.x = x
  572.     v.y = y
  573.     v.z = z
  574.     RVector = v
  575. End Function
  576.  
  577. '=================================
  578. ' MakeVertex
  579. '=================================
  580. Sub MakeVertex(ret As D3DVERTEX, Vect As D3DVECTOR, vNorm As D3DVECTOR, tu As Single, tv As Single)
  581.     
  582.     With ret
  583.         .nx = vNorm.x
  584.         .ny = vNorm.y
  585.         .nz = vNorm.z
  586.         .tu = tu
  587.         .tv = tv
  588.         .x = Vect.x
  589.         .y = Vect.y
  590.         .z = Vect.z
  591.     End With
  592.  
  593. End Sub
  594.  
  595. Function RVertex(Vect As D3DVECTOR, vNorm As D3DVECTOR, tu As Single, tv As Single) As D3DVERTEX
  596.     Dim ret As D3DVERTEX
  597.     With ret
  598.         .nx = vNorm.x
  599.         .ny = vNorm.y
  600.         .nz = vNorm.z
  601.         .tu = tu
  602.         .tv = tv
  603.         .x = Vect.x
  604.         .y = Vect.y
  605.         .z = Vect.z
  606.     End With
  607.     RVertex = ret
  608. End Function
  609.  
  610.  
  611. '=================================
  612. ' MakeLVertex
  613. '=================================
  614. Sub MakeLVertex(ret As D3DLVERTEX, x As Single, y As Single, z As Single, color As Long, specular As Single, tu As Single, tv As Single)
  615.     
  616.     With ret
  617.         .specular = specular
  618.         .tu = tu
  619.         .tv = tv
  620.         .x = x
  621.         .y = y
  622.         .z = z
  623.         .color = color
  624.     End With
  625.     
  626. End Sub
  627.  
  628. Function RLVertex(x As Single, y As Single, z As Single, color As Long, specular As Single, tu As Single, tv As Single) As D3DLVERTEX
  629.     Dim ret As D3DLVERTEX
  630.     With ret
  631.         .specular = specular
  632.         .tu = tu
  633.         .tv = tv
  634.         .x = x
  635.         .y = y
  636.         .z = z
  637.         .color = color
  638.     End With
  639.     RLVertex = ret
  640. End Function
  641.  
  642. '=================================
  643. ' MakeTLVertex
  644. '=================================
  645. Function MakeTLVertex(vert As D3DTLVERTEX, sx As Single, sy As Single, sz As Single, w As Single, c As Long, s As Single, u As Single, v As Single) As D3DTLVERTEX
  646.     
  647.     vert.sx = sx
  648.     vert.sy = sy
  649.     vert.sz = sz
  650.     vert.rhw = w
  651.     vert.color = c
  652.     vert.specular = s
  653.     vert.tu = u
  654.     vert.tv = v
  655.     
  656. End Function
  657.  
  658. Function RTLVertex(sx As Single, sy As Single, sz As Single, w As Single, c As Long, s As Single, u As Single, v As Single) As D3DTLVERTEX
  659.     Dim vert As D3DTLVERTEX
  660.     vert.sx = sx
  661.     vert.sy = sy
  662.     vert.sz = sz
  663.     vert.rhw = w
  664.     vert.color = c
  665.     vert.specular = s
  666.     vert.tu = u
  667.     vert.tv = v
  668.     RTLVertex = vert
  669. End Function
  670.  
  671.  
  672.  
  673. '=================================
  674. ' MakeRect
  675. '=================================
  676. Function MakeRect(ret As RECT, X1 As Single, Y1 As Single, X2 As Single, Y2 As Single)
  677.     With ret
  678.         .Left = X1
  679.         .Top = Y1
  680.         .right = X2
  681.         .Bottom = Y2
  682.     End With
  683. End Function
  684.  
  685. Function RRect(X1 As Single, Y1 As Single, X2 As Single, Y2 As Single) As RECT
  686.     Dim RetRect As RECT
  687.     With RetRect
  688.         .Left = X1
  689.         .Top = Y1
  690.         .right = X2
  691.         .Bottom = Y2
  692.     End With
  693.     RRect = RetRect
  694. End Function
  695.  
  696. '=================================
  697. ' ResetFloat
  698. ' easy way of reseting the floating
  699. ' point cpu flags so vb doesnt complian
  700. ' of Overflow error.
  701. ' Issues are always driver specific
  702. '=================================
  703. Sub ResetFloat()
  704.   On Local Error GoTo out
  705.   Dim s As Single
  706.   Dim v As Single
  707.   s = 1#
  708.   s = s / v
  709.  
  710. out:
  711.   s = 0
  712.  
  713. End Sub
  714.  
  715. '=================================
  716. ' PrintVector
  717. ' aids in debuging
  718. '=================================
  719.  
  720. Sub PrintVector(v As D3DVECTOR)
  721.   Debug.Print v.x, v.y, v.z
  722. End Sub
  723.  
  724. '=================================
  725. ' FVF VERTEX  helpers
  726. ' used for mutli textured polygons
  727. '=================================
  728.  
  729. 'Helper function for
  730. Private Function RaisePower(ByVal lPower As Long) As Long
  731.   Dim lCount As Long, lRaised As Long
  732.   lRaised = 1
  733.   For lCount = 1 To lPower
  734.       lRaised = lRaised * 2
  735.   Next
  736.   RaisePower = lRaised
  737. End Function
  738. Private Function ShiftLeft(ByVal lInitNum As Long, ByVal lBitsLeft As Long) As Long
  739.  
  740.   'Shift Left is computed as floor( this * (2**BitsLeft))
  741.   Dim lPower As Long
  742.   lPower = RaisePower(lBitsLeft)
  743.   ShiftLeft = CLng(lInitNum * lPower)
  744. End Function
  745.  
  746. Private Function D3DFVF_TEXTCOORDSIZE1(ByVal CoordIndex As Long) As Long
  747.   D3DFVF_TEXTCOORDSIZE1 = ShiftLeft(D3DFVF_TEXTUREFORMAT1, (CoordIndex * 2 + 16))
  748. End Function
  749.  
  750. Private Function D3DFVF_TEXTCOORDSIZE2(ByVal CoordIndex As Long) As Long
  751.   D3DFVF_TEXTCOORDSIZE2 = D3DFVF_TEXTUREFORMAT2
  752. End Function
  753.  
  754. Private Function D3DFVF_TEXTCOORDSIZE3(ByVal CoordIndex As Long) As Long
  755.   D3DFVF_TEXTCOORDSIZE3 = ShiftLeft(D3DFVF_TEXTUREFORMAT3, (CoordIndex * 2 + 16))
  756. End Function
  757.  
  758. Private Function D3DFVF_TEXTCOORDSIZE4(ByVal CoordIndex As Long) As Long
  759.   D3DFVF_TEXTCOORDSIZE4 = ShiftLeft(D3DFVF_TEXTUREFORMAT4, (CoordIndex * 2 + 16))
  760. End Function
  761.  
  762.  
  763.  
  764. '=================================
  765. '  FlagsToBitDepth
  766. '=================================
  767. '  Purpose:    Gets Bit Depth from DDPF Flags
  768. Function FlagsToBitDepth(dwFlags As Long) As Long
  769.  
  770.   If (dwFlags & DDBD_1) Then
  771.       FlagsToBitDepth = 1
  772.   ElseIf (dwFlags And DDBD_2) Then
  773.       FlagsToBitDepth = 2
  774.   ElseIf (dwFlags And DDBD_4) Then
  775.       FlagsToBitDepth = 4
  776.   ElseIf (dwFlags And DDBD_8) Then
  777.       FlagsToBitDepth = 8
  778.   ElseIf (dwFlags And DDBD_16) Then
  779.       FlagsToBitDepth = 16
  780.   ElseIf (dwFlags And DDBD_24) Then
  781.       FlagsToBitDepth = 24
  782.   ElseIf (dwFlags And DDBD_32) Then
  783.       FlagsToBitDepth = 32
  784.   Else
  785.       FlagsToBitDepth = 0
  786.   End If
  787. End Function
  788.  
  789.  
  790.  
  791.  
  792. '=================================
  793. '  BitDepthToFlags
  794. '=================================
  795. '  Converts BPP to corresponding DDPF flag
  796. '
  797. Function BitDepthToFlags(dwBPP As Long) As Long
  798.  
  799.   Select Case dwBPP
  800.   Case 1:
  801.       BitDepthToFlags = DDBD_1
  802.   Case 2:
  803.       BitDepthToFlags = DDBD_2
  804.   Case 4:
  805.       BitDepthToFlags = DDBD_4
  806.   Case 8:
  807.       BitDepthToFlags = DDBD_8
  808.   Case 16:
  809.       BitDepthToFlags = DDBD_16
  810.   Case 24:
  811.       BitDepthToFlags = DDBD_24
  812.   Case 32:
  813.       BitDepthToFlags = DDBD_32
  814.   Case Else
  815.       BitDepthToFlags = 0
  816.   End Select
  817.   
  818. End Function
  819.  
  820.  
  821.  
  822.