Visual Basic Graphics Programming (2nd Edition)/Visual Basic Graphics Programming 2nd Edition.iso/OldSrc/CH14/SRC/PERSP.FRM

Visual Basic Form | 1996-05-02 | 12.7 KB | 427 lines

VERSION 4.00
Begin VB.Form PerspectiveForm
   Appearance      =   0  'Flat
   BackColor       =   &H00C0C0C0&
   Caption         =   "Perspective"
   ClientHeight    =   5310
   ClientLeft      =   1380
   ClientTop       =   1035
   ClientWidth     =   6870
   BeginProperty Font
      name            =   "MS Sans Serif"
      charset         =   1
      weight          =   700
      size            =   8.25
      underline       =   0   'False
      italic          =   0   'False
      strikethrough   =   0   'False
   EndProperty
   ForeColor       =   &H80000008&
   Height          =   6000
   KeyPreview      =   -1  'True
   Left            =   1320
   LinkTopic       =   "Form1"
   ScaleHeight     =   5310
   ScaleWidth      =   6870
   Top             =   405
   Width           =   6990
   Begin VB.TextBox DText
      Height          =   285
      Left            =   6000
      TabIndex        =   22
      Text            =   "3"
      Top             =   2640
      Width           =   735
   End
   Begin VB.Frame Frame1
      Caption         =   "Post-Rotations"
      Height          =   1335
      Index           =   1
      Left            =   5400
      TabIndex        =   14
      Top             =   3120
      Width           =   1455
      Begin VB.TextBox ZW2Text
         Height          =   285
         Left            =   600
         MaxLength       =   6
         TabIndex        =   17
         Text            =   "0.0"
         Top             =   960
         Width           =   735
      End
      Begin VB.TextBox YW2Text
         Height          =   285
         Left            =   600
         MaxLength       =   6
         TabIndex        =   16
         Text            =   "0.1"
         Top             =   600
         Width           =   735
      End
      Begin VB.TextBox XW2Text
         Height          =   285
         Left            =   600
         MaxLength       =   6
         TabIndex        =   15
         Text            =   "0.2"
         Top             =   240
         Width           =   735
      End
      Begin VB.Label Label1
         Caption         =   "Z"
         Height          =   255
         Index           =   11
         Left            =   240
         TabIndex        =   20
         Top             =   960
         Width           =   255
      End
      Begin VB.Label Label1
         Caption         =   "Y"
         Height          =   255
         Index           =   10
         Left            =   240
         TabIndex        =   19
         Top             =   600
         Width           =   255
      End
      Begin VB.Label Label1
         Caption         =   "X"
         Height          =   255
         Index           =   9
         Left            =   240
         TabIndex        =   18
         Top             =   240
         Width           =   255
      End
   End
   Begin VB.Frame Frame1
      Caption         =   "Pre-Rotations"
      Height          =   2415
      Index           =   0
      Left            =   5400
      TabIndex        =   1
      Top             =   0
      Width           =   1455
      Begin VB.TextBox XYText
         Height          =   285
         Left            =   600
         MaxLength       =   6
         TabIndex        =   10
         Text            =   "0.0"
         Top             =   1320
         Width           =   735
      End
      Begin VB.TextBox XZText
         Height          =   285
         Left            =   600
         MaxLength       =   6
         TabIndex        =   9
         Text            =   "0.0"
         Top             =   1680
         Width           =   735
      End
      Begin VB.TextBox YZText
         Height          =   285
         Left            =   600
         MaxLength       =   6
         TabIndex        =   8
         Text            =   "0.0"
         Top             =   2040
         Width           =   735
      End
      Begin VB.TextBox XWText
         Height          =   285
         Left            =   600
         MaxLength       =   6
         TabIndex        =   4
         Text            =   "0.0"
         Top             =   240
         Width           =   735
      End
      Begin VB.TextBox YWText
         Height          =   285
         Left            =   600
         MaxLength       =   6
         TabIndex        =   3
         Text            =   "0.0"
         Top             =   600
         Width           =   735
      End
      Begin VB.TextBox ZWText
         Height          =   285
         Left            =   600
         MaxLength       =   6
         TabIndex        =   2
         Text            =   "0.0"
         Top             =   960
         Width           =   735
      End
      Begin VB.Label Label1
         Caption         =   "XY"
         Height          =   255
         Index           =   5
         Left            =   240
         TabIndex        =   13
         Top             =   1320
         Width           =   375
      End
      Begin VB.Label Label1
         Caption         =   "XZ"
         Height          =   255
         Index           =   4
         Left            =   240
         TabIndex        =   12
         Top             =   1680
         Width           =   375
      End
      Begin VB.Label Label1
         Caption         =   "YZ"
         Height          =   255
         Index           =   3
         Left            =   240
         TabIndex        =   11
         Top             =   2040
         Width           =   375
      End
      Begin VB.Label Label1
         Caption         =   "XW"
         Height          =   255
         Index           =   0
         Left            =   240
         TabIndex        =   7
         Top             =   240
         Width           =   375
      End
      Begin VB.Label Label1
         Caption         =   "YW"
         Height          =   255
         Index           =   1
         Left            =   240
         TabIndex        =   6
         Top             =   600
         Width           =   375
      End
      Begin VB.Label Label1
         Caption         =   "ZW"
         Height          =   255
         Index           =   2
         Left            =   240
         TabIndex        =   5
         Top             =   960
         Width           =   375
      End
   End
   Begin VB.PictureBox Pict
      AutoRedraw      =   -1  'True
      Height          =   5295
      Left            =   0
      ScaleHeight     =   349
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   349
      TabIndex        =   0
      Top             =   0
      Width           =   5295
   End
   Begin VB.Label Label1
      Caption         =   "D"
      Height          =   255
      Index           =   12
      Left            =   5640
      TabIndex        =   21
      Top             =   2640
      Width           =   255
   End
   Begin VB.Menu mnuFile
      Caption         =   "&File"
      Begin VB.Menu mnuFileExit
         Caption         =   "E&xit"
      End
   End
Attribute VB_Name = "PerspectiveForm"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
' Location of focus point.
Const FocusX = 0#
Const FocusY = 0#
Const FocusZ = 0#
Dim ThePicture As ObjPicture
' *******************************************************
' Draw the surface.
' *******************************************************
Private Sub DrawData(pic As Object)
Dim xw_rot As Single
Dim yw_rot As Single
Dim zw_rot As Single
Dim xy_rot As Single
Dim xz_rot As Single
Dim yz_rot As Single
Dim xw2_rot As Single
Dim yw2_rot As Single
Dim zw2_rot As Single
Dim XW(1 To 5, 1 To 5) As Single
Dim YW(1 To 5, 1 To 5) As Single
Dim ZW(1 To 5, 1 To 5) As Single
Dim XY(1 To 5, 1 To 5) As Single
Dim XZ(1 To 5, 1 To 5) As Single
Dim YZ(1 To 5, 1 To 5) As Single
Dim XW2(1 To 5, 1 To 5) As Single
Dim YW2(1 To 5, 1 To 5) As Single
Dim ZW2(1 To 5, 1 To 5) As Single
Dim S(1 To 5, 1 To 5) As Single
Dim T(1 To 5, 1 To 5) As Single
Dim P(1 To 5, 1 To 5) As Single
Dim M12(1 To 5, 1 To 5) As Single
Dim M34(1 To 5, 1 To 5) As Single
Dim M1_4(1 To 5, 1 To 5) As Single
Dim M56(1 To 5, 1 To 5) As Single
Dim M78(1 To 5, 1 To 5) As Single
Dim M5_8(1 To 5, 1 To 5) As Single
Dim M1_8(1 To 5, 1 To 5) As Single
Dim M910(1 To 5, 1 To 5) As Single
Dim M1112(1 To 5, 1 To 5) As Single
Dim M9_12(1 To 5, 1 To 5) As Single
Dim M_All(1 To 5, 1 To 5) As Single
Dim D As Single
    If Not IsNumeric(XWText.Text) Then Exit Sub
    If Not IsNumeric(YWText.Text) Then Exit Sub
    If Not IsNumeric(ZWText.Text) Then Exit Sub
    If Not IsNumeric(XYText.Text) Then Exit Sub
    If Not IsNumeric(XZText.Text) Then Exit Sub
    If Not IsNumeric(YZText.Text) Then Exit Sub
    If Not IsNumeric(XW2Text.Text) Then Exit Sub
    If Not IsNumeric(YW2Text.Text) Then Exit Sub
    If Not IsNumeric(ZW2Text.Text) Then Exit Sub
    If Not IsNumeric(DText.Text) Then Exit Sub
    xw_rot = CSng(XWText.Text)
    yw_rot = CSng(YWText.Text)
    zw_rot = CSng(ZWText.Text)
    xy_rot = CSng(XYText.Text)
    xz_rot = CSng(XZText.Text)
    yz_rot = CSng(YZText.Text)
    xw2_rot = CSng(XW2Text.Text)
    yw2_rot = CSng(YW2Text.Text)
    zw2_rot = CSng(ZW2Text.Text)
    D = CSng(DText.Text)
    MousePointer = vbHourglass
    Refresh
    ' Prevent overflow errors when drawing lines
    ' too far out of bounds.
    On Error Resume Next
    ' Calculate the rotation matrices.
    m4XWRotate XW, xw_rot
    m4YWRotate YW, yw_rot
    m4ZWRotate ZW, zw_rot
    m4XYRotate XY, xy_rot
    m4XZRotate XZ, xz_rot
    m4YZRotate YZ, yz_rot
    m4XWRotate XW2, xw2_rot
    m4YWRotate YW2, yw2_rot
    m4ZWRotate ZW2, zw2_rot
    ' Calculate the projection matrix.
    m4PerspectiveW P, D
    ' Scale and translate so it looks OK in pixels.
    m4Scale S, 75, -75, 1, 1
    m4Translate T, Pict.ScaleWidth / 2, Pict.ScaleHeight / 2, 0, 0
    m4MatMultiply M12, XW, YW
    m4MatMultiply M34, ZW, XY
    m4MatMultiply M56, XZ, YZ
    m4MatMultiplyFull M78, P, XW2
    m4MatMultiply M1_4, M12, M34
    m4MatMultiplyFull M5_8, M56, M78
    m4MatMultiplyFull M1_8, M1_4, M5_8
    m4MatMultiply M910, YW2, ZW2
    m4MatMultiply M1112, S, T
    m4MatMultiply M9_12, M910, M1112
    m4MatMultiplyFull M_All, M1_8, M9_12
    ' Transform the points.
    ThePicture.ApplyFull M_All
    ' Display the data.
    pic.Cls
    ThePicture.Draw pic
    pic.Refresh
    MousePointer = vbDefault
End Sub
Private Sub Form_Load()
    ' Create the data.
    CreateData
    ' Project and draw the data.
    Me.Show
    DrawData Pict
End Sub
' ************************************************
' Create the surface.
' ************************************************
Sub CreateData()
Dim pline As ObjPolyline4D
Dim x As Integer
Dim y As Integer
Dim z As Integer
Dim w As Integer
    MousePointer = vbHourglass
    Refresh
    Set ThePicture = New ObjPicture
    Set pline = New ObjPolyline4D
    ThePicture.objects.Add pline
    For x = -1 To 1 Step 2
        For y = -1 To 1 Step 2
            For z = -1 To 1 Step 2
                For w = -1 To 1 Step 2
                    If x = -1 Then _
                        pline.AddSegment _
                            x, y, z, w, _
                            1, y, z, w
                    If y = -1 Then _
                        pline.AddSegment _
                            x, y, z, w, _
                            x, 1, z, w
                    If z = -1 Then _
                        pline.AddSegment _
                            x, y, z, w, _
                            x, y, 1, w
                    If w = -1 Then _
                        pline.AddSegment _
                            x, y, z, w, _
                            x, y, z, 1
                Next w
            Next z
        Next y
    Next x
    MousePointer = vbDefault
End Sub
Private Sub mnuFileExit_Click()
    Unload Me
End Sub
Private Sub DText_Change()
    DrawData Pict
End Sub
Private Sub XW2Text_Change()
    DrawData Pict
End Sub
Private Sub XYText_Change()
    DrawData Pict
End Sub
Private Sub XZText_Change()
    DrawData Pict
End Sub
Private Sub YW2Text_Change()
    DrawData Pict
End Sub
Private Sub YWText_Change()
    DrawData Pict
End Sub
Private Sub YZText_Change()
    DrawData Pict
End Sub
Private Sub ZW2Text_Change()
    DrawData Pict
End Sub
Private Sub ZWText_Change()
    DrawData Pict
End Sub
Private Sub XWText_Change()
    DrawData Pict
End Sub