'////////////////// Shading section //////////////////////////////////
Public Sub DrSetLightVector(ByRef lVector As m3Vector)
Dim L As Single
L = m3VectorLen(lVector)
If L < 0.000001 Then
lightVector.x = 0
lightVector.Y = 0
lightVector.Z = 1
Else
lightVector.x = lVector.x / L
lightVector.Y = lVector.Y / L
lightVector.Z = lVector.Z / L
End If
End Sub
Public Function DrGetLightVector() As m3Vector
DrGetLightVector = lightVector
End Function
Public Sub DrApplyLightVector(ByRef M As m3Matrix)
m3VectorApply lightVector, M
End Sub
'Draw the solid object width Shading on the object
Public Sub Solid3DShadingDraw(ByRef Obj As Object, ByRef S As Solid3D, ByVal Border As Boolean)
Dim i As Integer
Dim j As Integer
Dim f As Single
Dim v As m3Vector
Dim u As m3Vector
Dim n As m3Vector
Dim nVerts As Integer
Dim p1 As Integer
Dim p2 As Integer
Dim P3 As Integer
'********** Shading Factors*******************************
Dim color As Long
Dim ColorTo As Long
Dim BorderColor As Long
Dim R As Byte
Dim G As Byte
Dim B As Byte
Dim maxRGB As Byte
Dim dot As Single
Dim dotMax As Single
'*************************************************************
'********** Shading Init Factors*******************************
color = Obj.FillColor
BorderColor = Obj.ForeColor
'Resolve Fill Color Into RGB Components
R = &HFF& And color
G = (&HFF00& And color) \ &H100&
B = (&HFF0000 And color) \ &H10000
'Compute Maximum Componen Of RGB Components
maxRGB = R
If G > maxRGB Then maxRGB = G
If B > maxRGB Then maxRGB = B
'Compute Maximum Factor Of RGB Components
dotMax = maxRGB / 255
'Ambient Light is some non-directional light in the environment
' (background light).
' Ambient Light Factor is 0.2
dotMax = dotMax + AmbFactor
If dotMax * maxRGB > 255 Then dotMax = 255 / maxRGB
Xorg = Abs(Obj.ScaleLeft)
Yorg = Abs(Obj.ScaleTop)
Select Case Projec
Case Parallel
For i = 1 To S.nVerts
ST(i) = S.Verts(i)
Next i
Case Perspective
For i = 1 To S.nVerts
f = Dist / (Dist - S.Verts(i).Z)
ST(i).x = S.Verts(i).x * f
ST(i).Y = S.Verts(i).Y * f
ST(i).Z = S.Verts(i).Z
Next i
End Select
For i = 1 To S.nFaces
p1 = S.Faces(i).Face(1)
p2 = S.Faces(i).Face(2)
P3 = S.Faces(i).Face(3)
v = m3VectorInit(ST(p1), ST(p2))
u = m3VectorInit(ST(p2), ST(P3))
n = m3VectorCross(v, u)
nVerts = S.Faces(i).nVerts
If n.Z > 0 Then
For j = 1 To nVerts
p1 = S.Faces(i).Face(j)
Poly2D(j).x = Xorg + ST(p1).x
Poly2D(j).Y = Yorg - ST(p1).Y
Next j
m3VectorSetLen 1, n
dot = lightVector.x * n.x + lightVector.Y * n.Y + lightVector.Z * n.Z
If dot > 0.0000001 Then
dot = dot + AmbFactor
Else
dot = AmbFactor
End If
If dot > dotMax Then dot = dotMax
ColorTo = RGB(dot * R, dot * G, dot * B)
Obj.FillColor = ColorTo
If Not Border Then
Obj.ForeColor = ColorTo
End If
Polygon Obj.hdc, Poly2D(1), nVerts
End If
Next i
' Restore Object's Colors
Obj.FillColor = color
Obj.ForeColor = BorderColor
End Sub
'Aplly view of Polygon 3D to 2D
Private Sub ProjectM3Points(ByVal nVerts As Integer, ByRef P() As m3Point)
Dim f As Single
Dim i As Integer
Select Case Projec
Case Parallel
For i = 1 To nVerts
Poly2D(i).x = Xorg + P(i).x
Poly2D(i).Y = Yorg - P(i).Y
Next i
Case Perspective
For i = 1 To nVerts
f = Dist / (Dist - P(i).Z)
Poly2D(i).x = Xorg + f * P(i).x
Poly2D(i).Y = Yorg - f * P(i).Y
Next i
End Select
End Sub
'Draw and fill the polygon width Shading on the object
Public Sub Poly3DShadingFill(ByRef Obj As Object, ByRef P As Poly3D, ByVal Border As Boolean)
Dim i As Integer
Dim p1 As m3Point
Dim p2 As m3Point
Dim P3 As m3Point
Dim n As m3Vector
Dim v As m3Vector
Dim u As m3Vector
Dim f As Single
'********** Shading Factors*******************************
Dim color As Long
Dim ColorTo As Long
Dim BorderColor As Long
Dim R As Byte
Dim G As Byte
Dim B As Byte
Dim maxRGB As Byte
Dim dot As Single
Dim dotMax As Single
'*************************************************************
'********** Shading Init Factors*******************************
color = Obj.FillColor
BorderColor = Obj.ForeColor
'Resolve Fill Color Into RGB Components
R = &HFF& And color
G = (&HFF00& And color) \ &H100&
B = (&HFF0000 And color) \ &H10000
'Compute Maximum Componen Of RGB Components
maxRGB = R
If G > maxRGB Then maxRGB = G
If B > maxRGB Then maxRGB = B
'Compute Maximum Factor Of RGB Components
dotMax = maxRGB / 255
'Ambient Light is some non-directional light in the environment
' (background light).
' Ambient Light Factor is 0.2
dotMax = dotMax + AmbFactor
If dotMax * maxRGB > 255 Then dotMax = 255 / maxRGB
Xorg = Abs(Obj.ScaleLeft)
Yorg = Abs(Obj.ScaleTop)
Select Case Projec
Case Parallel
p1 = P.Verts(1)
p2 = P.Verts(2)
P3 = P.Verts(3)
Case Perspective
f = Dist / (Dist - P.Verts(1).Z)
p1.x = P.Verts(1).x * f
p1.Y = P.Verts(1).Y * f
p1.Z = P.Verts(1).Z
f = Dist / (Dist - P.Verts(2).Z)
p2.x = P.Verts(2).x * f
p2.Y = P.Verts(2).Y * f
p2.Z = P.Verts(2).Z
f = Dist / (Dist - P.Verts(3).Z)
P3.x = P.Verts(3).x * f
P3.Y = P.Verts(3).Y * f
P3.Z = P.Verts(3).Z
End Select
v = m3VectorInit(p1, p2)
u = m3VectorInit(p2, P3)
n = m3VectorCross(v, u)
If n.Z < 0 Then
n.Y = -n.Y
n.x = -n.x
n.Z = -n.Z
End If
m3VectorSetLen 1, n
dot = lightVector.x * n.x + lightVector.Y * n.Y + lightVector.Z * n.Z
dot = dot + AmbFactor
If dot > dotMax Then dot = dotMax
ColorTo = RGB(dot * R, dot * G, dot * B)
Obj.FillColor = ColorTo
If Not Border Then
Obj.ForeColor = ColorTo
End If
ProjectM3Points P.nVerts, P.Verts
Polygon Obj.hdc, Poly2D(1), P.nVerts
' Restore Object's Colors
Obj.FillColor = color
Obj.ForeColor = BorderColor
End Sub