Visual Basic Graphics Programming (2nd Edition)/Visual Basic Graphics Programming 2nd Edition.iso/OldSrc/CH14/SRC/OBJPLN4D.CLS

Text File | 1996-05-04 | 6.0 KB | 213 lines

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

' Point4D and Segment4D are defined in module M4OPS.BAS as:
'    Type Point4D
'        coord(1 To 5) As Single
'        trans(1 To 5) As Single
'    End Type
'
'    Type Segment4D
'        pt1 As Integer
'        pt2 As Integer
'    End Type

Private NumPoints As Integer ' Number of points.
Private Points() As Point4D  ' Data points.

Private NumSegs As Integer   ' Number of segments.
Private Segs() As Segment4D  ' The segments.


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

' ************************************************
' Add one or more line segments to the polyline.
' ************************************************
Public Sub AddSegment(ParamArray coord() As Variant)
Dim num_segs As Integer
Dim i As Integer
Dim last As Integer
Dim pt As Integer

    num_segs = (UBound(coord) + 1) \ 4 - 1
    ReDim Preserve Segs(1 To NumSegs + num_segs)

    last = AddPoint((coord(0)), (coord(1)), (coord(2)), (coord(3)))
    pt = 0
    For i = 1 To num_segs
        Segs(NumSegs + i).pt1 = last
        pt = pt + 4
        last = AddPoint((coord(pt)), (coord(pt + 1)), (coord(pt + 2)), (coord(pt + 3)))
        Segs(NumSegs + i).pt2 = last
    Next i

    NumSegs = NumSegs + num_segs
End Sub

' ************************************************
' Add a point to the polyline or reuse a point.
' Return the point's index.
' ************************************************
Private Function AddPoint(x As Single, y As Single, z As Single, w As Single) As Integer
Dim i As Integer

    ' See if the point is already here.
    For i = 1 To NumPoints
        If x = Points(i).coord(1) And _
           y = Points(i).coord(2) And _
           z = Points(i).coord(3) And _
           w = Points(i).coord(4) Then _
                Exit For
    Next i
    AddPoint = i

    ' If so, we're done.
    If i <= NumPoints Then Exit Function

    ' Otherwise create the new point.
    NumPoints = NumPoints + 1
    ReDim Preserve Points(1 To NumPoints)
    Points(i).coord(1) = x
    Points(i).coord(2) = y
    Points(i).coord(3) = z
    Points(i).coord(4) = w
    Points(i).coord(5) = 1#
End Function


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

    For i = 1 To NumPoints
        For j = 1 To 4
            Points(i).coord(j) = Points(i).trans(j)
        Next j
    Next i
End Sub

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

    For i = 1 To NumPoints
        m4ApplyFull Points(i).coord, M, Points(i).trans
    Next i
End Sub

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

    For i = 1 To NumPoints
        m4Apply Points(i).coord, M, Points(i).trans
    Next i
End Sub


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

    For i = 1 To NumPoints
        D.Distort4d Points(i).coord(1), Points(i).coord(2), Points(i).coord(3)
    Next i
End Sub

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

    Write #filenum, "POLYLINE4D", NumPoints, NumSegs

    ' Write the points.
    For i = 1 To NumPoints
        Write #filenum, Points(i).coord(1), Points(i).coord(2), Points(i).coord(3), Points(i).coord(4)
    Next i

    ' Write the segments.
    For i = 1 To NumSegs
        Write #filenum, Segs(i).pt1, Segs(i).pt2
    Next i
End Sub

' ************************************************
' Draw the transformed points on a Form, Printer,
' or PictureBox.
' ************************************************
Public Sub Draw(canvas As Object, Optional r As Variant)
Dim seg As Integer
Dim pt1 As Integer
Dim pt2 As Integer
Dim dist As Single

    On Error Resume Next
    If IsMissing(r) Then r = INFINITY
    dist = r
    For seg = 1 To NumSegs
        pt1 = Segs(seg).pt1
        pt2 = Segs(seg).pt2
        ' Don't draw if either point is farther
        ' from the focus point than the center of
        ' projection (which is distance dist away).
        If Points(pt1).trans(4) < r And Points(pt2).trans(4) < r Then _
            canvas.Line _
                (Points(pt1).trans(1), Points(pt1).trans(2))- _
                (Points(pt2).trans(1), Points(pt2).trans(2))
    Next seg
End Sub

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

    Input #filenum, NumPoints, NumSegs

    ' Allocate and read the points.
    ReDim Points(1 To NumPoints)
    For i = 1 To NumPoints
        Input #filenum, Points(i).coord(1), Points(i).coord(2), Points(i).coord(3), Points(i).coord(4)
        Points(i).coord(5) = 1
    Next i

    ' Allocate and read the segments.
    ReDim Segs(1 To NumSegs)
    For i = 1 To NumSegs
        Input #filenum, Segs(i).pt1, Segs(i).pt2
    Next i
End Sub