home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / OldSrc / CH7 / SRC / SCALE_AT.FRM (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1995-11-07  |  4.0 KB  |  141 lines
  1. VERSION 4.00
  2. Begin VB.Form ScaleAtForm 
  3.    Caption         =   "ScaleAt"
  4.    ClientHeight    =   4425
  5.    ClientLeft      =   2325
  6.    ClientTop       =   780
  7.    ClientWidth     =   4215
  8.    Height          =   5115
  9.    Left            =   2265
  10.    LinkTopic       =   "Form1"
  11.    ScaleHeight     =   4425
  12.    ScaleWidth      =   4215
  13.    Top             =   150
  14.    Width           =   4335
  15.    Begin VB.OptionButton SizeOption 
  16.       Caption         =   "Normal"
  17.       Height          =   255
  18.       Index           =   1
  19.       Left            =   1680
  20.       TabIndex        =   3
  21.       Top             =   4080
  22.       Value           =   -1  'True
  23.       Width           =   855
  24.    End
  25.    Begin VB.OptionButton SizeOption 
  26.       Caption         =   "Little"
  27.       Height          =   255
  28.       Index           =   2
  29.       Left            =   3000
  30.       TabIndex        =   2
  31.       Top             =   4080
  32.       Width           =   855
  33.    End
  34.    Begin VB.OptionButton SizeOption 
  35.       Caption         =   "Big"
  36.       Height          =   255
  37.       Index           =   0
  38.       Left            =   360
  39.       TabIndex        =   1
  40.       Top             =   4080
  41.       Width           =   855
  42.    End
  43.    Begin VB.PictureBox Pict 
  44.       Height          =   3975
  45.       Left            =   0
  46.       ScaleHeight     =   -7
  47.       ScaleLeft       =   -1
  48.       ScaleMode       =   0  'User
  49.       ScaleTop        =   6
  50.       ScaleWidth      =   7
  51.       TabIndex        =   0
  52.       Top             =   0
  53.       Width           =   4215
  54.    End
  55.    Begin VB.Menu mnuFile 
  56.       Caption         =   "&File"
  57.       Begin VB.Menu mnuFileExit 
  58.          Caption         =   "E&xit"
  59.       End
  60.    End
  61. Attribute VB_Name = "ScaleAtForm"
  62. Attribute VB_Creatable = False
  63. Attribute VB_Exposed = False
  64. Option Explicit
  65. Dim NumSegments As Integer
  66. Dim Segments() As Segment
  67. Dim CurrentT(1 To 3, 1 To 3) As Single
  68. Sub CreateData()
  69.     ' Create the axes.
  70.     MakeSegment 0, 0, 5, 0
  71.     MakeSegment 0, 0, 0, 5
  72.     ' Create an object to manipulate.
  73.     MakeSegment 1, 1, 2, 1
  74.     MakeSegment 2, 1, 2, 2
  75.     MakeSegment 2, 2, 1, 2
  76.     MakeSegment 1, 2, 1, 1
  77.     MakeSegment 1, 1, 2, 2
  78.     MakeSegment 2, 1, 1, 2
  79. End Sub
  80. Sub DrawSegments(pic As Object)
  81. Dim i As Integer
  82. Dim x1 As Single
  83. Dim y1 As Single
  84. Dim x2 As Single
  85. Dim y2 As Single
  86.     pic.Cls
  87.     TransformPicture CurrentT
  88.     For i = 1 To NumSegments
  89.         x1 = Segments(i).fr_tr(1)
  90.         y1 = Segments(i).fr_tr(2)
  91.         x2 = Segments(i).to_tr(1)
  92.         y2 = Segments(i).to_tr(2)
  93.         pic.Line (x1, y1)-(x2, y2)
  94.     Next i
  95. End Sub
  96. Private Sub Form_Load()
  97.     m2Identity CurrentT
  98.     CreateData
  99. End Sub
  100. Sub MakeSegment(x1 As Single, y1 As Single, x2 As Single, y2 As Single)
  101.     NumSegments = NumSegments + 1
  102.     ReDim Preserve Segments(1 To NumSegments)
  103.     Segments(NumSegments).fr_pt(1) = x1
  104.     Segments(NumSegments).fr_pt(2) = y1
  105.     Segments(NumSegments).fr_pt(3) = 1
  106.     Segments(NumSegments).to_pt(1) = x2
  107.     Segments(NumSegments).to_pt(2) = y2
  108.     Segments(NumSegments).to_pt(3) = 1
  109. End Sub
  110. ' ***********************************************
  111. ' Transform all segments except the axes.
  112. ' ***********************************************
  113. Sub TransformPicture(M() As Single)
  114. Dim i As Integer
  115.     For i = 1 To 2
  116.         m2PointCopy Segments(i).fr_tr, Segments(i).fr_pt
  117.         m2PointCopy Segments(i).to_tr, Segments(i).to_pt
  118.     Next i
  119.     For i = 3 To NumSegments
  120.         m2Apply Segments(i).fr_pt, M, Segments(i).fr_tr
  121.         m2Apply Segments(i).to_pt, M, Segments(i).to_tr
  122.     Next i
  123. End Sub
  124. Private Sub mnuFileExit_Click()
  125.     Unload Me
  126. End Sub
  127. Private Sub Pict_Paint()
  128.     DrawSegments Pict
  129. End Sub
  130. Private Sub SizeOption_Click(Index As Integer)
  131.     Select Case Index
  132.         Case 0  ' Big.
  133.             m2ScaleAt CurrentT, 2, 2, 1.5, 1.5
  134.         Case 1  ' Normal.
  135.             m2Identity CurrentT
  136.         Case 2  ' Little.
  137.             m2ScaleAt CurrentT, 0.5, 0.5, 1.5, 1.5
  138.     End Select
  139.     Pict.Refresh
  140. End Sub
  141.