Visual Basic Graphics Programming (2nd Edition)/Visual Basic Graphics Programming 2nd Edition.iso/OldSrc/CH13/SRC/OBJCYLR.CLS

Text File | 1996-04-11 | 10.3 KB | 394 lines

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

Private Krr As Single
Private Krg As Single
Private Krb 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(depth As Integer, 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 NdotV 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 r_ref As Single
Dim g_ref As Single
Dim b_ref As Single
Dim r1 As Integer
Dim g1 As Integer
Dim b1 As Integer
Dim mx As Single
Dim my As Single
Dim mz As Single
Dim i As Integer
Dim dist As Single
Dim shadowed As Boolean
Dim rlng As Long
Dim glng As Long
Dim blng As Long

    ' *******************************
    ' * Compute local contributions *
    ' *******************************

    ' 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

    ' **********************************
    ' * Compute reflected contribution *
    ' **********************************
    ' Find vector M in the direction of reflection.
    NdotV = nx * Vx + ny * Vy + nz * Vz
    mx = 2 * nx * NdotV - Vx
    my = 2 * ny * NdotV - Vy
    mz = 2 * nz * NdotV - Vz

    If depth > 1 Then
        TraceRay depth - 1, HitX, HitY, HitZ, mx, my, mz, r1, g1, b1
        r_ref = Krr * r1
        g_ref = Krg * g1
        b_ref = Krb * b1
    Else
        r_ref = 0
        g_ref = 0
        b_ref = 0
    End If

    ' See how intense to make the color.
    ' Some of the reflections may be close to
    ' the light source so these values can get big.
    rlng = r_amb + _
        LightIir / (l_len + LightKdist) * _
            (r_dif + spec) + _
        r_ref
    glng = g_amb + _
        LightIig / (l_len + LightKdist) * _
            (g_dif + spec) + _
        g_ref
    blng = b_amb + _
        LightIib / (l_len + LightKdist) * _
            (b_dif + spec) + _
        b_ref
    If rlng > 255 Then rlng = 255
    If glng > 255 Then glng = 255
    If blng > 255 Then blng = 255
    R = rlng
    G = glng
    B = blng
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.02 Then u1 = u2
        If u2 < 0.02 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.02 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
' ************************************************
' Set constants for reflected light.
' ************************************************
Sub SetKr(R As Single, G As Single, B As Single)
    Krr = R
    Krg = G
    Krb = B
End Sub