home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / OldSrc / CH7 / SRC / ROT_AT.FRM (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1995-11-07  |  3.3 KB  |  117 lines
  1. VERSION 4.00
  2. Begin VB.Form RotateAroundForm 
  3.    Caption         =   "Rotate Around"
  4.    ClientHeight    =   4005
  5.    ClientLeft      =   2325
  6.    ClientTop       =   780
  7.    ClientWidth     =   4215
  8.    Height          =   4695
  9.    KeyPreview      =   -1  'True
  10.    Left            =   2265
  11.    LinkTopic       =   "Form1"
  12.    ScaleHeight     =   4005
  13.    ScaleWidth      =   4215
  14.    Top             =   150
  15.    Width           =   4335
  16.    Begin VB.PictureBox Pict 
  17.       Height          =   3975
  18.       Left            =   0
  19.       ScaleHeight     =   -7
  20.       ScaleLeft       =   -1
  21.       ScaleMode       =   0  'User
  22.       ScaleTop        =   6
  23.       ScaleWidth      =   7
  24.       TabIndex        =   0
  25.       Top             =   0
  26.       Width           =   4215
  27.    End
  28.    Begin VB.Menu mnuFile 
  29.       Caption         =   "&File"
  30.       Begin VB.Menu mnuFileExit 
  31.          Caption         =   "E&xit"
  32.       End
  33.    End
  34. Attribute VB_Name = "RotateAroundForm"
  35. Attribute VB_Creatable = False
  36. Attribute VB_Exposed = False
  37. Option Explicit
  38. Const PI = 3.14159265
  39. Dim NumSegments As Integer
  40. Dim Segments() As Segment
  41. Dim Theta As Single
  42. Sub CreateData()
  43.     ' Create the axes.
  44.     MakeSegment 0, 0, 5, 0
  45.     MakeSegment 0, 0, 0, 5
  46.     ' Create an object to manipulate.
  47.     MakeSegment 1, 1, 3, 1
  48.     MakeSegment 3, 1, 3, 3
  49.     MakeSegment 3, 3, 1, 3
  50.     MakeSegment 1, 3, 1, 1
  51.     MakeSegment 1, 1, 3, 3
  52.     MakeSegment 3, 1, 1, 3
  53. End Sub
  54. Sub DrawSegments(pic As Object)
  55. Dim T(1 To 3, 1 To 3) As Single
  56. Dim i As Integer
  57. Dim x1 As Single
  58. Dim y1 As Single
  59. Dim x2 As Single
  60. Dim y2 As Single
  61.     pic.Cls
  62.     ' Transform the picture.
  63.     m2RotateAround T, Theta, 2, 2
  64.     TransformPicture T
  65.     For i = 1 To NumSegments
  66.         x1 = Segments(i).fr_tr(1)
  67.         y1 = Segments(i).fr_tr(2)
  68.         x2 = Segments(i).to_tr(1)
  69.         y2 = Segments(i).to_tr(2)
  70.         pic.Line (x1, y1)-(x2, y2)
  71.     Next i
  72. End Sub
  73. Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  74. Const Dtheta = PI / 16
  75.     Select Case KeyCode
  76.         Case vbKeyLeft  ' Rotate left.
  77.             Theta = Theta + Dtheta
  78.         Case vbKeyRight  ' Rotate right.
  79.             Theta = Theta - Dtheta
  80.     End Select
  81.     Pict.Refresh
  82. End Sub
  83. Private Sub Form_Load()
  84.     Theta = 0
  85.     CreateData
  86. End Sub
  87. Sub MakeSegment(x1 As Single, y1 As Single, x2 As Single, y2 As Single)
  88.     NumSegments = NumSegments + 1
  89.     ReDim Preserve Segments(1 To NumSegments)
  90.     Segments(NumSegments).fr_pt(1) = x1
  91.     Segments(NumSegments).fr_pt(2) = y1
  92.     Segments(NumSegments).fr_pt(3) = 1
  93.     Segments(NumSegments).to_pt(1) = x2
  94.     Segments(NumSegments).to_pt(2) = y2
  95.     Segments(NumSegments).to_pt(3) = 1
  96. End Sub
  97. ' ***********************************************
  98. ' Transform all segments except the axes.
  99. ' ***********************************************
  100. Sub TransformPicture(M() As Single)
  101. Dim i As Integer
  102.     For i = 1 To 2
  103.         m2PointCopy Segments(i).fr_tr, Segments(i).fr_pt
  104.         m2PointCopy Segments(i).to_tr, Segments(i).to_pt
  105.     Next i
  106.     For i = 3 To NumSegments
  107.         m2Apply Segments(i).fr_pt, M, Segments(i).fr_tr
  108.         m2Apply Segments(i).to_pt, M, Segments(i).to_tr
  109.     Next i
  110. End Sub
  111. Private Sub mnuFileExit_Click()
  112.     Unload Me
  113. End Sub
  114. Private Sub Pict_Paint()
  115.     DrawSegments Pict
  116. End Sub
  117.