home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / OldSrc / CH9 / SRC / UP.FRM (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1995-11-17  |  12.6 KB  |  422 lines
  1. VERSION 4.00
  2. Begin VB.Form UpForm 
  3.    Appearance      =   0  'Flat
  4.    BackColor       =   &H00C0C0C0&
  5.    Caption         =   "Up"
  6.    ClientHeight    =   5505
  7.    ClientLeft      =   330
  8.    ClientTop       =   1020
  9.    ClientWidth     =   9060
  10.    BeginProperty Font 
  11.       name            =   "MS Sans Serif"
  12.       charset         =   1
  13.       weight          =   700
  14.       size            =   8.25
  15.       underline       =   0   'False
  16.       italic          =   0   'False
  17.       strikethrough   =   0   'False
  18.    EndProperty
  19.    ForeColor       =   &H80000008&
  20.    Height          =   6195
  21.    KeyPreview      =   -1  'True
  22.    Left            =   270
  23.    LinkTopic       =   "Form1"
  24.    ScaleHeight     =   5505
  25.    ScaleWidth      =   9060
  26.    Top             =   390
  27.    Width           =   9180
  28.    Begin VB.PictureBox PPict 
  29.       AutoRedraw      =   -1  'True
  30.       Height          =   2175
  31.       Left            =   6840
  32.       ScaleHeight     =   -10
  33.       ScaleLeft       =   -5
  34.       ScaleMode       =   0  'User
  35.       ScaleTop        =   5
  36.       ScaleWidth      =   10
  37.       TabIndex        =   12
  38.       Top             =   2760
  39.       Width           =   2175
  40.    End
  41.    Begin VB.PictureBox Pict 
  42.       AutoRedraw      =   -1  'True
  43.       Height          =   2175
  44.       Index           =   0
  45.       Left            =   1200
  46.       ScaleHeight     =   -10
  47.       ScaleLeft       =   -5
  48.       ScaleMode       =   0  'User
  49.       ScaleTop        =   5
  50.       ScaleWidth      =   10
  51.       TabIndex        =   5
  52.       Top             =   0
  53.       Width           =   2175
  54.    End
  55.    Begin VB.PictureBox Pict 
  56.       AutoRedraw      =   -1  'True
  57.       Height          =   2175
  58.       Index           =   1
  59.       Left            =   3480
  60.       ScaleHeight     =   -10
  61.       ScaleLeft       =   -5
  62.       ScaleMode       =   0  'User
  63.       ScaleTop        =   5
  64.       ScaleWidth      =   10
  65.       TabIndex        =   4
  66.       Top             =   0
  67.       Width           =   2175
  68.    End
  69.    Begin VB.PictureBox Pict 
  70.       AutoRedraw      =   -1  'True
  71.       Height          =   2175
  72.       Index           =   2
  73.       Left            =   5760
  74.       ScaleHeight     =   -10
  75.       ScaleLeft       =   -5
  76.       ScaleMode       =   0  'User
  77.       ScaleTop        =   5
  78.       ScaleWidth      =   10
  79.       TabIndex        =   3
  80.       Top             =   0
  81.       Width           =   2175
  82.    End
  83.    Begin VB.PictureBox Pict 
  84.       AutoRedraw      =   -1  'True
  85.       Height          =   2175
  86.       Index           =   3
  87.       Left            =   0
  88.       ScaleHeight     =   -10
  89.       ScaleLeft       =   -5
  90.       ScaleMode       =   0  'User
  91.       ScaleTop        =   5
  92.       ScaleWidth      =   10
  93.       TabIndex        =   2
  94.       Top             =   2760
  95.       Width           =   2175
  96.    End
  97.    Begin VB.PictureBox Pict 
  98.       AutoRedraw      =   -1  'True
  99.       Height          =   2175
  100.       Index           =   4
  101.       Left            =   2280
  102.       ScaleHeight     =   -10
  103.       ScaleLeft       =   -5
  104.       ScaleMode       =   0  'User
  105.       ScaleTop        =   5
  106.       ScaleWidth      =   10
  107.       TabIndex        =   1
  108.       Top             =   2760
  109.       Width           =   2175
  110.    End
  111.    Begin VB.PictureBox Pict 
  112.       AutoRedraw      =   -1  'True
  113.       Height          =   2175
  114.       Index           =   5
  115.       Left            =   4560
  116.       ScaleHeight     =   -10
  117.       ScaleLeft       =   -5
  118.       ScaleMode       =   0  'User
  119.       ScaleTop        =   5
  120.       ScaleWidth      =   10
  121.       TabIndex        =   0
  122.       Top             =   2760
  123.       Width           =   2175
  124.    End
  125.    Begin VB.Label Label1 
  126.       Alignment       =   2  'Center
  127.       Caption         =   "Final projection"
  128.       Height          =   255
  129.       Index           =   6
  130.       Left            =   6840
  131.       TabIndex        =   13
  132.       Top             =   5040
  133.       Width           =   2175
  134.       WordWrap        =   -1  'True
  135.    End
  136.    Begin VB.Label Label1 
  137.       Alignment       =   2  'Center
  138.       Caption         =   "Original picture"
  139.       Height          =   255
  140.       Index           =   0
  141.       Left            =   1200
  142.       TabIndex        =   11
  143.       Top             =   2280
  144.       Width           =   2175
  145.       WordWrap        =   -1  'True
  146.    End
  147.    Begin VB.Label Label1 
  148.       Alignment       =   2  'Center
  149.       Caption         =   "Translate focus to origin"
  150.       Height          =   255
  151.       Index           =   1
  152.       Left            =   3480
  153.       TabIndex        =   10
  154.       Top             =   2280
  155.       Width           =   2175
  156.       WordWrap        =   -1  'True
  157.    End
  158.    Begin VB.Label Label1 
  159.       Alignment       =   2  'Center
  160.       Caption         =   "Rotate center of projection into Y-Z plane"
  161.       Height          =   495
  162.       Index           =   2
  163.       Left            =   5760
  164.       TabIndex        =   9
  165.       Top             =   2280
  166.       Width           =   2175
  167.       WordWrap        =   -1  'True
  168.    End
  169.    Begin VB.Label Label1 
  170.       Alignment       =   2  'Center
  171.       Caption         =   "Rotate center of projection into Z axis"
  172.       Height          =   375
  173.       Index           =   3
  174.       Left            =   0
  175.       TabIndex        =   8
  176.       Top             =   5040
  177.       Width           =   2175
  178.       WordWrap        =   -1  'True
  179.    End
  180.    Begin VB.Label Label1 
  181.       Alignment       =   2  'Center
  182.       Caption         =   "Rotate UP into Y-Z plane"
  183.       Height          =   255
  184.       Index           =   4
  185.       Left            =   2280
  186.       TabIndex        =   7
  187.       Top             =   5040
  188.       Width           =   2175
  189.       WordWrap        =   -1  'True
  190.    End
  191.    Begin VB.Label Label1 
  192.       Alignment       =   2  'Center
  193.       Caption         =   "Project onto X-Y plane"
  194.       Height          =   255
  195.       Index           =   5
  196.       Left            =   4560
  197.       TabIndex        =   6
  198.       Top             =   5040
  199.       Width           =   2175
  200.       WordWrap        =   -1  'True
  201.    End
  202.    Begin VB.Menu mnuFile 
  203.       Caption         =   "&File"
  204.       Begin VB.Menu mnuFileExit 
  205.          Caption         =   "E&xit"
  206.       End
  207.    End
  208. Attribute VB_Name = "UpForm"
  209. Attribute VB_Creatable = False
  210. Attribute VB_Exposed = False
  211. Option Explicit
  212. Dim FirstCube As Integer
  213. ' Viewing parameters.
  214. Dim EyeR As Single      ' Center of projection.
  215. Dim EyeTheta As Single
  216. Dim EyePhi As Single
  217. Const FocusX = 0#       ' Focus point.
  218. Const FocusY = 0#
  219. Const FocusZ = 0#
  220. ' Projection parameters.
  221. Dim UpX As Single       ' Up vector.
  222. Dim UpY As Single
  223. Dim UpZ As Single
  224. Dim cx As Single        ' Center of projection.
  225. Dim cy As Single
  226. Dim cz As Single
  227. Dim Fx As Single        ' Focus point.
  228. Dim Fy As Single
  229. Dim Fz As Single
  230. ' Matrices used for the projection.
  231. Dim M(0 To 5) As Transformation
  232. Dim Projector(1 To 4, 1 To 4) As Single
  233. Dim P(1 To 4, 1 To 4) As Single
  234. ' ***********************************************
  235. ' Create transformation matrices for perspective
  236. ' projection with:
  237. '       focus point             (focx, focy, focz)
  238. '       center of projection    (ex, ey, ez)
  239. '       up vector               <ux, uy, uz>
  240. ' ***********************************************
  241. Sub CreateMatrices(focx As Single, focy As Single, focz As Single, ex As Single, ey As Single, ez As Single, ux As Single, uy As Single, uz As Single)
  242. Dim sin1 As Single
  243. Dim cos1 As Single
  244. Dim sin2 As Single
  245. Dim cos2 As Single
  246. Dim sin3 As Single
  247. Dim cos3 As Single
  248. Dim A As Single
  249. Dim B As Single
  250. Dim C As Single
  251. Dim d1 As Single
  252. Dim d2 As Single
  253. Dim d3 As Single
  254. Dim up1(1 To 4) As Single
  255. Dim up2(1 To 4) As Single
  256.     ' Identity transformation.
  257.     m3Identity M(0).M
  258.     ' Translate the focus to the origin.
  259.     m3Translate M(1).M, -focx, -focy, -focz
  260.     A = ex - focx
  261.     B = ey - focy
  262.     C = ez - focz
  263.     d1 = Sqr(A * A + C * C)
  264.     sin1 = -A / d1
  265.     cos1 = C / d1
  266.     d2 = Sqr(A * A + B * B + C * C)
  267.     sin2 = B / d2
  268.     cos2 = d1 / d2
  269.     ' Rotate around the Y axis to place the
  270.     ' center of projection in the Y-Z plane.
  271.     m3Identity M(2).M
  272.     M(2).M(1, 1) = cos1
  273.     M(2).M(1, 3) = -sin1
  274.     M(2).M(3, 1) = sin1
  275.     M(2).M(3, 3) = cos1
  276.     ' Rotate around the X axis to place the
  277.     ' center of projection in the Z axis.
  278.     m3Identity M(3).M
  279.     M(3).M(2, 2) = cos2
  280.     M(3).M(2, 3) = sin2
  281.     M(3).M(3, 2) = -sin2
  282.     M(3).M(3, 3) = cos2
  283.     ' Apply the rotations to the UP vector.
  284.     up1(1) = ux
  285.     up1(2) = uy
  286.     up1(3) = uz
  287.     up1(4) = 1
  288.     m3Apply up1, M(2).M, up2
  289.     m3Apply up2, M(3).M, up1
  290.     ' Rotate around the Z axis to put the UP
  291.     ' vector in the Y-Z plane.
  292.     d3 = Sqr(up1(1) * up1(1) + up1(2) * up1(2))
  293.     sin3 = up1(1) / d3
  294.     cos3 = up1(2) / d3
  295.     m3Identity M(4).M
  296.     M(4).M(1, 1) = cos3
  297.     M(4).M(1, 2) = sin3
  298.     M(4).M(2, 1) = -sin3
  299.     M(4).M(2, 2) = cos3
  300.     ' Project.
  301.     m3PerspectiveXZ M(5).M, d2
  302.     ' Compute the projection all in one shot.
  303.     m3Project P, m3Perspective, ex, ey, ez, focx, focy, focz, ux, uy, uz
  304. End Sub
  305. ' ***********************************************
  306. ' Let the user change the location of the eye.
  307. ' ***********************************************
  308. Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  309. Const Dtheta = PI / 20
  310. Const Dx = 0.25
  311. Dim inc As Single
  312.     If Shift And 1 Then
  313.         inc = Dx
  314.     Else
  315.         inc = -Dx
  316.     End If
  317.     Select Case KeyCode
  318.         Case vbKeyLeft
  319.             EyeTheta = EyeTheta - Dtheta
  320.             
  321.         Case vbKeyRight
  322.             EyeTheta = EyeTheta + Dtheta
  323.         
  324.         Case vbKeyUp
  325.             EyePhi = EyePhi - Dtheta
  326.         
  327.         Case vbKeyDown
  328.             EyePhi = EyePhi + Dtheta
  329.         
  330.         Case Asc("X")
  331.             UpX = UpX + inc
  332.         Case Asc("Y")
  333.             UpY = UpY + inc
  334.         Case Asc("Z")
  335.             UpZ = UpZ + inc
  336.         
  337.         Case Else
  338.             Exit Sub
  339.     End Select
  340.     ' Redraw the pictures.
  341.     DrawTheData
  342. End Sub
  343. Private Sub Form_Load()
  344.     ' Initialize the viewing parameters.
  345.     EyeR = 3
  346.     EyeTheta = PI * 0.35
  347.     EyePhi = PI * 0.1
  348.     ' Initialize projection parameters.
  349.     UpX = -1
  350.     UpY = 1.5
  351.     UpZ = 0
  352.     cx = 2
  353.     cy = 2.5
  354.     cz = 3
  355.     Fx = 1
  356.     Fy = 1
  357.     Fz = 1
  358.     ' Create, project, and draw the data.
  359.     DrawTheData
  360. End Sub
  361. ' ***********************************************
  362. ' Draw all the pictures.
  363. ' ***********************************************
  364. Sub DrawTheData()
  365. Dim i As Integer
  366.     CreateData
  367.     CreateMatrices Fx, Fy, Fz, cx, cy, cz, UpX, UpY, UpZ
  368.     ' Compute the projection matrix.
  369.     m3PProject Projector, m3Parallel, EyeR, EyePhi, EyeTheta, FocusX, FocusY, FocusZ, 0, 1, 0
  370.     For i = 0 To 5
  371.         TransformData M(i).M, FirstCube, NumSegments
  372.         SetPoints FirstCube, NumSegments
  373.         TransformData Projector, 1, NumSegments
  374.         DrawSomeData Pict(i), 1, NumSegments - 2, ForeColor, True
  375.         Pict(i).DrawWidth = 3
  376.         DrawSomeData Pict(i), NumSegments - 1, NumSegments - 1, vbRed, False
  377.         DrawSomeData Pict(i), NumSegments, NumSegments, vbGreen, False
  378.         Pict(i).DrawWidth = DrawWidth
  379.         Pict(i).Refresh
  380.     Next i
  381.     ' For the final view use the transformation
  382.     ' given by m3PerspectiveProjectionUp
  383.     CreateData
  384.     TransformData P, FirstCube, NumSegments
  385.     DrawSomeData PPict, FirstCube, NumSegments - 2, ForeColor, True
  386.     PPict.DrawWidth = 3
  387.     DrawSomeData PPict, NumSegments - 1, NumSegments - 1, vbRed, False
  388.     DrawSomeData PPict, NumSegments, NumSegments, vbGreen, False
  389.     PPict.DrawWidth = DrawWidth
  390.     PPict.Refresh
  391. End Sub
  392. Sub CreateData()
  393.     ' Start with no data.
  394.     NumSegments = 0
  395.     ' Create the axes.
  396.     MakeSegment 0, 0, 0, 4, 0, 0    ' X axis.
  397.     MakeSegment 0, 0, 0, 0, 4, 0    ' Y axis.
  398.     MakeSegment 0, 0, 0, 0, 0, 4    ' Z axis.
  399.         
  400.     FirstCube = NumSegments + 1
  401.     ' Create the object to reflect.
  402.     MakeSegment -1, -1, -1, -1, -1, 3
  403.     MakeSegment -1, -1, 3, -1, 3, 3
  404.     MakeSegment -1, 3, 3, -1, 3, -1
  405.     MakeSegment -1, 3, -1, -1, -1, -1
  406.     MakeSegment 3, -1, -1, 3, -1, 3
  407.     MakeSegment 3, -1, 3, 3, 3, 3
  408.     MakeSegment 3, 3, 3, 3, 3, -1
  409.     MakeSegment 3, 3, -1, 3, -1, -1
  410.     MakeSegment -1, -1, -1, 3, -1, -1
  411.     MakeSegment -1, -1, 3, 3, -1, 3
  412.     MakeSegment -1, 3, 3, 3, 3, 3
  413.     MakeSegment -1, 3, -1, 3, 3, -1
  414.     ' Up vector.
  415.     MakeSegment Fx, Fy, Fz, Fx + UpX, Fy + UpY, Fz + UpZ
  416.     ' Center of projection.
  417.     MakeSegment Fx, Fy, Fz, cx, cy, cz
  418. End Sub
  419. Private Sub mnuFileExit_Click()
  420.     Unload Me
  421. End Sub
  422.