home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / OldSrc / CH14 / SRC / TEMPORAL.FRM (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1996-05-02  |  6.7 KB  |  235 lines

  1. VERSION 4.00
  2. Begin VB.Form TemporalForm 
  3.    Appearance      =   0  'Flat
  4.    BackColor       =   &H00C0C0C0&
  5.    Caption         =   "Temporal"
  6.    ClientHeight    =   5910
  7.    ClientLeft      =   1410
  8.    ClientTop       =   780
  9.    ClientWidth     =   6975
  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          =   6600
  21.    KeyPreview      =   -1  'True
  22.    Left            =   1350
  23.    LinkTopic       =   "Form1"
  24.    ScaleHeight     =   5910
  25.    ScaleWidth      =   6975
  26.    Top             =   150
  27.    Width           =   7095
  28.    Begin VB.CommandButton CmdDisplay 
  29.       Caption         =   "Display Images"
  30.       Enabled         =   0   'False
  31.       Height          =   495
  32.       Left            =   3960
  33.       TabIndex        =   2
  34.       Top             =   5400
  35.       Width           =   1455
  36.    End
  37.    Begin VB.CommandButton CmdCreate 
  38.       Caption         =   "Create Images"
  39.       Default         =   -1  'True
  40.       Height          =   495
  41.       Left            =   1560
  42.       TabIndex        =   1
  43.       Top             =   5400
  44.       Width           =   1455
  45.    End
  46.    Begin VB.PictureBox Pict 
  47.       AutoRedraw      =   -1  'True
  48.       Height          =   5295
  49.       Left            =   0
  50.       ScaleHeight     =   349
  51.       ScaleMode       =   3  'Pixel
  52.       ScaleWidth      =   461
  53.       TabIndex        =   0
  54.       Top             =   0
  55.       Width           =   6975
  56.    End
  57.    Begin VB.Image SurfaceImage 
  58.       Height          =   495
  59.       Index           =   1
  60.       Left            =   0
  61.       Top             =   5400
  62.       Visible         =   0   'False
  63.       Width           =   495
  64.    End
  65.    Begin VB.Label ImageNum 
  66.       BorderStyle     =   1  'Fixed Single
  67.       Height          =   255
  68.       Left            =   6600
  69.       TabIndex        =   4
  70.       Top             =   5400
  71.       Width           =   375
  72.    End
  73.    Begin VB.Label Label1 
  74.       Caption         =   "Image"
  75.       Height          =   255
  76.       Left            =   6000
  77.       TabIndex        =   3
  78.       Top             =   5400
  79.       Width           =   615
  80.    End
  81.    Begin VB.Menu mnuFile 
  82.       Caption         =   "&File"
  83.       Begin VB.Menu mnuFileExit 
  84.          Caption         =   "E&xit"
  85.       End
  86.    End
  87. Attribute VB_Name = "TemporalForm"
  88. Attribute VB_Creatable = False
  89. Attribute VB_Exposed = False
  90. Option Explicit
  91. ' Location of viewing eye.
  92. Const EyeR = 10#
  93. Const EyeTheta = PI * 0.2
  94. Const EyePhi = PI * 0.1
  95. ' Location of focus point.
  96. Const FocusX = 0#
  97. Const FocusY = 0#
  98. Const FocusZ = 0#
  99. Dim Projector(1 To 4, 1 To 4) As Single
  100. Dim ThePicture As ObjPicture
  101. Dim TheGrid As ObjGrid3D
  102. Dim Running As Integer
  103. ' *******************************************************
  104. ' Draw the surface.
  105. ' *******************************************************
  106. Private Sub DrawData(pic As Object)
  107. Dim x As Single
  108. Dim y As Single
  109. Dim z As Single
  110. Dim S(1 To 4, 1 To 4) As Single
  111. Dim t(1 To 4, 1 To 4) As Single
  112. Dim ST(1 To 4, 1 To 4) As Single
  113. Dim PST(1 To 4, 1 To 4) As Single
  114.     ' Prevent overflow errors when drawing lines
  115.     ' too far out of bounds.
  116.     On Error Resume Next
  117.     ' Scale and translate so it looks OK in pixels.
  118.     m3Scale S, 35, -35, 1
  119.     m3Translate t, 230, 175, 0
  120.     m3MatMultiplyFull ST, S, t
  121.     m3MatMultiplyFull PST, Projector, ST
  122.     ' Transform the points.
  123.     ThePicture.ApplyFull PST
  124.     ' Display the data.
  125.     pic.Cls
  126.     ThePicture.Draw pic, EyeR
  127.     pic.Refresh
  128. End Sub
  129. Private Sub CmdDisplay_Click()
  130.     If Running Then
  131.         CmdDisplay.Caption = "Stopped"
  132.         CmdDisplay.Enabled = False
  133.         Running = False
  134.     Else
  135.         Running = True
  136.         CmdDisplay.Caption = "Stop"
  137.         ShowFrames
  138.         CmdDisplay.Caption = "Display Images"
  139.         CmdDisplay.Enabled = True
  140.     End If
  141. End Sub
  142. Private Sub Form_Load()
  143. Dim i As Integer
  144.     ' Initialize the projection transformation.
  145.     m3PProject Projector, m3Perspective, EyeR, EyePhi, EyeTheta, FocusX, FocusY, FocusZ, 0, 1, 0
  146.     ' Load empty image controls for later.
  147.     For i = 2 To 20
  148.         Load SurfaceImage(i)
  149.     Next i
  150. End Sub
  151. ' ************************************************
  152. ' Create the surface.
  153. ' ************************************************
  154. Sub CmdCreate_click()
  155. Const PI_10 = PI / 10
  156. Const xmin = -5
  157. Const Zmin = -5
  158. Const dx = 0.3
  159. Const dz = 0.3
  160. Const NumX = -2 * xmin / dx
  161. Const NumZ = -2 * Zmin / dz
  162. Const Amp = 0.25
  163. Dim num As Integer
  164. Dim offset As Single
  165. Dim i As Integer
  166. Dim j As Integer
  167. Dim x As Single
  168. Dim y As Single
  169. Dim z As Single
  170. Dim D As Single
  171.     MousePointer = vbHourglass
  172.     Refresh
  173.     For num = 1 To 20
  174.         ImageNum.Caption = Format$(num)
  175.         ImageNum.Refresh
  176.         
  177.         Set ThePicture = New ObjPicture
  178.         Set TheGrid = New ObjGrid3D
  179.         TheGrid.SetBounds xmin, dx, NumX, Zmin, dz, NumZ
  180.         TheGrid.ShowHidden = False
  181.         ThePicture.objects.Add TheGrid
  182.         offset = num * PI_10
  183.         x = xmin
  184.         For i = 1 To NumX
  185.             z = Zmin
  186.             For j = 1 To NumZ
  187.                 D = Sqr(x * x + z * z)
  188.                 y = Amp * Cos(3 * D - offset)
  189.                 
  190.                 TheGrid.SetValue x, y, z
  191.                 z = z + dz
  192.             Next j
  193.             x = x + dx
  194.         Next i
  195.         ' Display the data.
  196.         DrawData Pict
  197.         
  198.         ' Save the bitmap for later.
  199.         SurfaceImage(num).Picture = Pict.Image
  200.         DoEvents
  201.     Next num
  202.     CmdCreate.Enabled = False
  203.     CmdDisplay.Enabled = True
  204.     CmdDisplay.Default = True
  205.     MousePointer = vbDefault
  206.     Beep
  207. End Sub
  208. ' ************************************************
  209. ' In case the user closes the form while we're in
  210. ' the middle of something.
  211. ' ************************************************
  212. Private Sub Form_Unload(Cancel As Integer)
  213.     End
  214. End Sub
  215. ' ************************************************
  216. ' Present the images.
  217. ' ************************************************
  218. Private Sub ShowFrames()
  219. Const ms_per_frame = 50
  220. Static num As Integer
  221. Dim next_time As Long
  222.     Do While Running
  223.         num = num + 1
  224.         If num > 20 Then num = 1
  225.         next_time = GetTickCount() + ms_per_frame
  226.         Pict.Picture = SurfaceImage(num).Picture
  227.         ImageNum.Caption = Format$(num)
  228.         DoEvents
  229.         WaitTill next_time
  230.     Loop
  231. End Sub
  232. Private Sub mnuFileExit_Click()
  233.     Unload Me
  234. End Sub
  235.