Visual Basic Graphics Programming (2nd Edition)/Visual Basic Graphics Programming 2nd Edition.iso/OldSrc/CH10/SRC/OBJROTAT.CLS

Text File | 1996-05-04 | 6.9 KB | 248 lines

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "ObjRotated"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit

Private NumCurvePts As Integer
Private CurvePoints() As Point3D

Private pline As ObjPolyline    ' The display polyline.

' ************************************************
' Add a point to the curve.
' ************************************************
Public Sub AddCurvePoint(x As Single, y As Single, z As Single)
    NumCurvePts = NumCurvePts + 1
    ReDim Preserve CurvePoints(1 To NumCurvePts)
    CurvePoints(NumCurvePts).coord(1) = x
    CurvePoints(NumCurvePts).coord(2) = y
    CurvePoints(NumCurvePts).coord(3) = z
    CurvePoints(NumCurvePts).coord(4) = 1
End Sub

' ************************************************
' Create the display polyline by rotating around
' the Y axis.
' ************************************************
Public Sub Rotate()
Dim i As Integer
Dim r As Single
Dim theta As Single
Dim dtheta As Single
Dim t As Single
Dim x As Single
Dim z As Single
Dim x1 As Single
Dim y1 As Single
Dim z1 As Single
Dim x2 As Single
Dim y2 As Single
Dim z2 As Single

    Set pline = New ObjPolyline

    ' Create the translated images of the curve.
    dtheta = PI / 8
    For theta = 0 To 2 * PI - dtheta + 0.01 Step dtheta
        x = CurvePoints(1).coord(1)
        z = CurvePoints(1).coord(3)
        r = Sqr(x * x + z * z)
        t = Arctan2(x, z)
        x1 = r * Cos(t + theta)
        y1 = CurvePoints(1).coord(2)
        z1 = r * Sin(t + theta)
        For i = 2 To NumCurvePts
            x = CurvePoints(i).coord(1)
            z = CurvePoints(i).coord(3)
            r = Sqr(x * x + z * z)
            t = Arctan2(x, z)
            x2 = r * Cos(t + theta)
            y2 = CurvePoints(i).coord(2)
            z2 = r * Sin(t + theta)

            pline.AddSegment x1, y1, z1, x2, y2, z2
            x1 = x2
            y1 = y2
            z1 = z2
        Next i
    Next theta

    ' Create the circles of rotation.
    For i = 1 To NumCurvePts
        x = CurvePoints(i).coord(1)
        z = CurvePoints(i).coord(3)
        r = Sqr(x * x + z * z)
        t = Arctan2(x, z)
        x1 = r * Cos(t)
        y1 = CurvePoints(i).coord(2)
        z1 = r * Sin(t)
        For theta = dtheta To 2 * PI - dtheta + 0.01 Step dtheta
            x2 = r * Cos(t + theta)
            z2 = r * Sin(t + theta)
            pline.AddSegment x1, y1, z1, x2, y1, z2
            x1 = x2
            z1 = z2
        Next theta
        x2 = r * Cos(t)
        z2 = r * Sin(t)
        pline.AddSegment x1, y1, z1, x2, y1, z2
    Next i
End Sub

' ***********************************************
' Return a string indicating the object type.
' ***********************************************
Property Get ObjectType() As String
    ObjectType = "ROTATED"
End Property



' ***********************************************
' Fix the data coordinates at their transformed
' values.
' ***********************************************
Public Sub FixPoints()
Dim i As Integer
Dim j As Integer

    ' Fix the curve points.
    For i = 1 To NumCurvePts
        For j = 1 To 3
            CurvePoints(i).coord(j) = CurvePoints(i).trans(j)
        Next j
    Next i

    ' Fix the display polyline if it exists.
    If Not pline Is Nothing Then pline.FixPoints
End Sub

' ************************************************
' Apply a transformation matrix which may not
' contain 0, 0, 0, 1 in the last column to the
' object.
' ************************************************
Public Sub ApplyFull(M() As Single)
Dim i As Integer

    ' Transform the curve.
    For i = 1 To NumCurvePts
        m3ApplyFull CurvePoints(i).coord, M, _
                    CurvePoints(i).trans
    Next i

    ' Transform the display polyline if it exists.
    If Not pline Is Nothing Then pline.ApplyFull M
End Sub

' ************************************************
' Apply a transformation matrix to the object.
' ************************************************
Public Sub Apply(M() As Single)
Dim i As Integer

    ' Transform the curve.
    For i = 1 To NumCurvePts
        m3Apply CurvePoints(i).coord, M, _
                CurvePoints(i).trans
    Next i

    ' Transform the display polyline if it exists.
    If Not pline Is Nothing Then pline.Apply M
End Sub


' ************************************************
' Apply a nonlinear transformation.
' ************************************************
Public Sub Distort(D As Object)
Dim i As Integer

    ' Distort the curve.
    For i = 1 To NumCurvePts
        D.Distort CurvePoints(i).coord(1), _
                  CurvePoints(i).coord(2), _
                  CurvePoints(i).coord(3)
    Next i

    ' Distort the display polyline if it exists.
    If Not pline Is Nothing Then pline.Distort D
End Sub


' ************************************************
' Write the surface's display polyline object to a
' file using Write. The data can later be loaded
' into an ObjPolyline object but not an
' ObjRotated object.
' ************************************************
Public Sub FileWritePolyline(filenum As Integer)
    If Not pline Is Nothing Then pline.FileWrite filenum
End Sub


' ************************************************
' Write an extruded surface to a file using Write.
' Begin with "ROTATED" to identify this object.
' ************************************************
Public Sub FileWrite(filenum As Integer)
Dim i As Integer

    ' Write basic information.
    Write #filenum, "ROTATED", NumCurvePts

    ' Write the curve points.
    For i = 1 To NumCurvePts
        Write #filenum, _
            CurvePoints(i).coord(1), _
            CurvePoints(i).coord(2), _
            CurvePoints(i).coord(3)
    Next i
End Sub




' ************************************************
' Draw the extrusion on a Form, Printer, or
' PictureBox.
' ************************************************
Public Sub Draw(canvas As Object, Optional r As Variant)
    If Not pline Is Nothing Then _
        pline.Draw canvas, r
End Sub


' ************************************************
' Read a grid from a file using Input.
' Assume the "ROTATED" label has already been
' read.
' ************************************************
Public Sub FileInput(filenum As Integer)
Dim i As Integer

    ' Get the basic information.
    Input #filenum, NumCurvePts

    ' Allocate the curve array.
    ReDim CurvePoints(1 To NumCurvePts)

    ' Read the curve points.
    For i = 1 To NumCurvePts
        Input #filenum, _
            CurvePoints(i).coord(1), _
            CurvePoints(i).coord(2), _
            CurvePoints(i).coord(3)
        CurvePoints(i).coord(4) = 1
    Next i

    ' Create the display polyline.
    Rotate
End Sub