VB中应用光线跟踪渲染2

zh1110

VB中应用光线跟踪渲染2

                             ——zh1110，原程序由Almar Joling提供

同上次相比增加了相互反射及阴影的功能，及有了三角型，圆柱等基本形体，当然原程序是由Almar Joling从C++修改来的
参考网站：
http://www.2tothex.com/
http://www.quadrantwars.com
http://www.Planet-Source-Code.com/vb/scripts/ShowCode.asp?txtCodeId=33289&lngWId=1

zh1110

窗口：
钩选框
Enable Shadows允许阴影

Enable Reflections允许反射

Enable Sphere显示球体

Enable Vertices显示三角型

Enable Plane显示地面

Enable Cylinder显示圆柱

划块
FOV
视线距离（产生缩方）


先说阴影，它的实现很简单，从灯光发射一条光线到地面上一点，检测光线是否会与物体相交（三角型，圆柱等）。如果相交，那么光线被挡住，地面上此点就会产生阴影自然比其他地方暗许多。
地面上那些点需要检查哪？与屏幕上的点相交的检测即可（射线方向表—GenerateRayDirectionTable）。

代码如下
'// 尽可能完善功能. 增加功能: shadowed
'// 阴影
Public Function IsShadowed(currPrimitiveNum As Long, rayToLight As Ray, distanceToLight As Single, Primitives() As Primitive, numPrimitives As Long)
    Dim myTraceResult As TraceResult
    Dim I As Long
    myTraceResult.Hit = False
   
    '// 检查每一个基本物体
    For I = 0 To numPrimitives
        If I <> currPrimitiveNum Then  '// 自身不会产生阴影
            
            Select Case Primitives(I).Type  '// Primitives代表各种物体（三角型，圆柱等）
                Case SPHERE_TYPE:
                    myTraceResult = IntersectSphere(Primitives(I).Sphere, rayToLight)  '//球体
               
                Case PLANE_TYPE:
                    myTraceResult = IntersectPlane(Primitives(I).Plane, rayToLight)  '//地面
               
                Case CYLINDER_TYPE:
                    myTraceResult = IntersectCylinder(Primitives(I).Cilinder, rayToLight)  '//圆柱
               
                Case TRIANGLE_TYPE:
                    myTraceResult = IntersectTriangle(Primitives(I).Triangle, rayToLight)  '//三角型
            End Select
            
            If (myTraceResult.Hit = True And (myTraceResult.Distance < distanceToLight)) Then  '//如果遮挡物在照射物的后面当然也不能产生阴影
                    IsShadowed = True
                    Exit Function
            End If
        End If
    Next I

    IsShadowed = False  '//光线没有被遮挡

End Function


下面的问题是如何判断光线是否与物体相交，并计算出相交距离：

  '//地面
Public Function IntersectPlane(Plane As udtPlane, myRay As Ray) As TraceResult
    Dim myTraceResult As TraceResult
    Dim t As Single
    On Error Resume Next
        t = -(Plane.vecNormal.x * myRay.Origin.x + Plane.vecNormal.y * myRay.Origin.y + Plane.vecNormal.z * myRay.Origin.z + Plane.sngDisplacement) _
    / (Plane.vecNormal.x * myRay.Direction.x + Plane.vecNormal.y * myRay.Direction.y + Plane.vecNormal.z * myRay.Direction.z)
          '//这是由公式推导出的，t为光线到交点距离，Plane.vecNormal为平面法向距离，Plane.sngDisplacement为平面到圆点距离
        If t < 0 Then
        myTraceResult.Hit = False
        IntersectPlane = myTraceResult
        Exit Function
    End If
    myTraceResult.Hit = True
    myTraceResult.Distance = t
    IntersectPlane = myTraceResult
End Function

  '//球体
Public Function IntersectSphere(Sphere As udtSphere, myRay As Ray) As TraceResult
    Dim myTraceResult As TraceResult
    Dim rayToSphereCenter As Vector3D
    Dim lengthRTSC2 As Single, closestApproach As Single, halfCord2 As Single
   
    rayToSphereCenter = VectorSub(Sphere.vecCenter, myRay.Origin)
    lengthRTSC2 = VectorDot(rayToSphereCenter, rayToSphereCenter)   ' // lengthRTSC2 = 光线起点到球体中心距离
      
    closestApproach = VectorDot(rayToSphereCenter, myRay.Direction)
    If closestApproach < 0 Then '// 交点在后面
        myTraceResult.Hit = False
        IntersectSphere = myTraceResult
        Exit Function
    End If
       halfCord2 = (Sphere.sngRadius * Sphere.sngRadius) - lengthRTSC2 + (closestApproach * closestApproach)  
    If halfCord2 < 0 Then '// the ray misses the sphere
        myTraceResult.Hit = False
        IntersectSphere = myTraceResult
        Exit Function
    End If
   myTraceResult.Hit = True
    myTraceResult.Distance = closestApproach - Sqr(halfCord2)
    IntersectSphere = myTraceResult
End Function

  '//三角型，圆柱略
...

zh1110

c代码

杜飞

已阅
看不懂

马甲005

很有用的东西，支持