home *** CD-ROM | disk | FTP | other *** search
- VERSION 1.0 CLASS
- BEGIN
- MultiUse = -1 'True
- END
- Attribute VB_Name = "ObjCylinder"
- Attribute VB_Creatable = False
- Attribute VB_Exposed = False
- Option Explicit
-
- ' Point1 and Point2 are points at each end of the
- ' cylinder's axis.
- Private Point1 As Point3D
- Private Point2 As Point3D
- Private Radius As Single
-
- ' The axis.
- Private Ax As Single
- Private Ay As Single
- Private Az As Single
-
- ' The radii vectors.
- Private V1x As Single
- Private V1y As Single
- Private V1z As Single
- Private V2x As Single
- Private V2y As Single
- Private V2z As Single
-
- Private HitX As Single
- Private HitY As Single
- Private HitZ As Single
- Private HitT As Single
-
- Private Kar As Single
- Private Kag As Single
- Private Kab As Single
-
- Private Kdr As Single
- Private Kdg As Single
- Private Kdb As Single
-
- Private SpecN As Single
- Private Ks As Single
-
- ' ************************************************
- ' Apply a transformation matrix to the plane.
- ' ************************************************
- Public Sub Apply(M() As Single)
- ' Transform the points.
- m3Apply Point1.coord, M, Point1.trans
- m3Apply Point2.coord, M, Point2.trans
- End Sub
-
- ' ************************************************
- ' Return the red, green, and blue components of
- ' the surface at the hit position.
- ' ************************************************
- Public Sub HitColor(Objects As Collection, R As Integer, G As Integer, B As Integer)
- Dim Vx As Single
- Dim Vy As Single
- Dim Vz As Single
- Dim nx As Single
- Dim ny As Single
- Dim nz As Single
- Dim lx As Single
- Dim ly As Single
- Dim lz As Single
- Dim rx As Single
- Dim ry As Single
- Dim rz As Single
- Dim n_len As Single
- Dim l_len As Single
- Dim v_len As Single
- Dim r_len As Single
- Dim NdotL As Single
- Dim RdotV As Single
- Dim r_dif As Single
- Dim g_dif As Single
- Dim b_dif As Single
- Dim r_amb As Single
- Dim g_amb As Single
- Dim b_amb As Single
- Dim spec As Single
- Dim i As Integer
- Dim dist As Single
- Dim shadowed As Boolean
-
- ' Find the unit vector pointing toward the light.
- lx = LightSource.trans(1) - HitX
- ly = LightSource.trans(2) - HitY
- lz = LightSource.trans(3) - HitZ
- l_len = Sqr(lx * lx + ly * ly + lz * lz)
- lx = lx / l_len
- ly = ly / l_len
- lz = lz / l_len
- ' We will use l_len later as the distance from
- ' the light to the surface.
-
- ' Find the surface unit normal.
- Vx = Point2.trans(1) - Point1.trans(1)
- Vy = Point2.trans(2) - Point1.trans(2)
- Vz = Point2.trans(3) - Point1.trans(3)
- nx = HitX - (Point1.trans(1) + HitT * Vx)
- ny = HitY - (Point1.trans(2) + HitT * Vy)
- nz = HitZ - (Point1.trans(3) + HitT * Vz)
- n_len = Sqr(nx * nx + ny * ny + nz * nz)
- nx = nx / n_len
- ny = ny / n_len
- nz = nz / n_len
-
- ' Find the vector V from the surface to the
- ' viewpoint.
- Vx = EyeX - HitX
- Vy = EyeY - HitY
- Vz = EyeZ - HitZ
- v_len = Sqr(Vx * Vx + Vy * Vy + Vz * Vz)
- Vx = Vx / v_len
- Vy = Vy / v_len
- Vz = Vz / v_len
-
- ' See if the light shines directly on the surface.
- For i = 1 To Objects.Count
- dist = Objects.Item(i).RayDistance( _
- LightSource.trans(1), _
- LightSource.trans(2), _
- LightSource.trans(3), _
- -lx, -ly, -lz)
- If dist < l_len - 0.1 Then Exit For
- Next i
- shadowed = (i <= Objects.Count)
-
- ' Calculate the part due to diffuse reflection.
- If shadowed Then
- ' The light does not hit the surface.
- r_dif = 0
- g_dif = 0
- b_dif = 0
- spec = 0
- Else
- ' Treat backface planes as normal planes.
- NdotL = Abs(nx * lx + ny * ly + nz * lz)
-
- r_dif = Kdr * NdotL
- g_dif = Kdg * NdotL
- b_dif = Kdb * NdotL
-
- ' Find vector R in the mirror direction.
- rx = 2 * nx * NdotL - lx
- ry = 2 * ny * NdotL - ly
- rz = 2 * nz * NdotL - lz
-
- ' Calculate the part due to specular reflection.
- RdotV = rx * Vx + ry * Vy + rz * Vz
- If RdotV < 0 Then
- spec = 0
- Else
- spec = Ks * RdotV ^ SpecN
- End If
- End If
-
- ' Calculate the part due to ambient light.
- r_amb = LightIar * Kar
- g_amb = LightIag * Kag
- b_amb = LightIab * Kab
-
- ' See how intense to make the color.
- R = r_amb + _
- LightIir / (l_len + LightKdist) * _
- (r_dif + spec)
- G = g_amb + _
- LightIig / (l_len + LightKdist) * _
- (g_dif + spec)
- B = b_amb + _
- LightIib / (l_len + LightKdist) * _
- (b_dif + spec)
- End Sub
-
- ' ************************************************
- ' Compute the distance from point (x3, y3, z3)
- ' along vector <wx, wy, wz> to the cylinder.
- '
- ' Save the point of intersection in
- ' (HitX, HitY, HitZ) for later use.
- ' ************************************************
- Public Function RayDistance(x3 As Single, y3 As Single, z3 As Single, Wx As Single, Wy As Single, Wz As Single) As Single
- Dim x1 As Single
- Dim y1 As Single
- Dim z1 As Single
- Dim Vx As Single
- Dim Vy As Single
- Dim Vz As Single
- Dim Vlen2 As Single
- Dim WdotV As Single
- Dim A As Single
- Dim B As Single
- Dim Cx As Single
- Dim Cy As Single
- Dim Cz As Single
- Dim dx As Single
- Dim dy As Single
- Dim dz As Single
- Dim A1 As Single
- Dim B1 As Single
- Dim C1 As Single
- Dim B24AC As Single
- Dim u1 As Single
- Dim u2 As Single
-
- ' Find the axis vector.
- Vx = Point2.trans(1) - Point1.trans(1)
- Vy = Point2.trans(2) - Point1.trans(2)
- Vz = Point2.trans(3) - Point1.trans(3)
-
- ' Find A and B for t = A * u + B.
- Vlen2 = Vx * Vx + Vy * Vy + Vz * Vz
- WdotV = Wx * Vx + Wy * Vy + Wz * Vz
- A = WdotV / Vlen2
-
- x1 = Point1.trans(1)
- y1 = Point1.trans(2)
- z1 = Point1.trans(3)
- B = (Vx * (x3 - x1) + _
- Vy * (y3 - y1) + _
- Vz * (z3 - z1)) / Vlen2
-
- ' Solve for u.
- Cx = Wx - Vx * A
- Cy = Wy - Vy * A
- Cz = Wz - Vz * A
- dx = x3 - x1 - Vx * B
- dy = y3 - y1 - Vy * B
- dz = z3 - z1 - Vz * B
- A1 = Cx * Cx + Cy * Cy + Cz * Cz
- B1 = 2 * (Cx * dx + Cy * dy + Cz * dz)
- C1 = dx * dx + dy * dy + dz * dz - Radius * Radius
- ' Solve the quadratic A1*u^2 + B1*u + C1 = 0.
- B24AC = B1 * B1 - 4 * A1 * C1
- If B24AC < 0 Then
- RayDistance = INFINITY
- Exit Function
- ElseIf B24AC = 0 Then
- u1 = -B1 / 2 / A1
- Else
- B24AC = Sqr(B24AC)
- u1 = (-B1 + B24AC) / 2 / A1
- u2 = (-B1 - B24AC) / 2 / A1
- ' Use only positive t values.
- If u1 < 0 Then u1 = u2
- If u2 < 0 Then u2 = u1
- ' Use the smaller t value.
- If u1 > u2 Then u1 = u2
- End If
-
- ' If there is no positive u value, there's no
- ' intersection in this direction.
- If u1 < 0 Then
- RayDistance = INFINITY
- Exit Function
- End If
-
- ' See where on the cylinder this is.
- HitT = u1 * A + B
- ' If this is not between Point1 and Point2,
- ' ignore it.
- If HitT < 0 Or HitT > 1 Then
- RayDistance = INFINITY
- Exit Function
- End If
-
- ' Compute the actual hit location.
- HitX = x3 + u1 * Wx
- HitY = y3 + u1 * Wy
- HitZ = z3 + u1 * Wz
-
- ' Compute the distance from (x3, y3, z3).
- A1 = x3 - HitX
- B1 = y3 - HitY
- C1 = z3 - HitZ
- RayDistance = Sqr(A1 * A1 + B1 * B1 + C1 * C1)
- End Function
-
- ' ************************************************
- ' Initialize the data.
- ' ************************************************
- Public Sub Initialize(R As Single, p1x As Single, p1y As Single, p1z As Single, p2x As Single, p2y As Single, p2z As Single)
- Radius = R
- Point1.coord(1) = p1x
- Point1.coord(2) = p1y
- Point1.coord(3) = p1z
- Point1.coord(4) = 1
- Point2.coord(1) = p2x
- Point2.coord(2) = p2y
- Point2.coord(3) = p2z
- Point2.coord(4) = 1
- End Sub
-
-
- ' ************************************************
- ' Set N and Ks for specular reflection.
- ' ************************************************
- Sub SetSpec(n As Single, s As Single)
- SpecN = n
- Ks = s
- End Sub
-
- ' ************************************************
- ' Return the latest Hit location.
- ' ************************************************
- Public Sub HitLocation(x As Single, y As Single, z As Single)
- x = HitX
- y = HitY
- z = HitZ
- End Sub
-
- ' ************************************************
- ' Set constants for diffuse reflection.
- ' ************************************************
- Sub SetKd(R As Single, G As Single, B As Single)
- Kdr = R
- Kdg = G
- Kdb = B
- End Sub
-
- ' ************************************************
- ' Set constants for ambient light.
- ' ************************************************
- Sub SetKa(R As Single, G As Single, B As Single)
- Kar = R
- Kag = G
- Kab = B
- End Sub
-
-
-
-