home *** CD-ROM | disk | FTP | other *** search
- VERSION 4.00
- Begin VB.Form TemporalForm
- Appearance = 0 'Flat
- BackColor = &H00C0C0C0&
- Caption = "Temporal"
- ClientHeight = 5910
- ClientLeft = 1410
- ClientTop = 780
- ClientWidth = 6975
- 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 = 6600
- KeyPreview = -1 'True
- Left = 1350
- LinkTopic = "Form1"
- ScaleHeight = 5910
- ScaleWidth = 6975
- Top = 150
- Width = 7095
- Begin VB.CommandButton CmdDisplay
- Caption = "Display Images"
- Enabled = 0 'False
- Height = 495
- Left = 3960
- TabIndex = 2
- Top = 5400
- Width = 1455
- End
- Begin VB.CommandButton CmdCreate
- Caption = "Create Images"
- Default = -1 'True
- Height = 495
- Left = 1560
- TabIndex = 1
- Top = 5400
- Width = 1455
- End
- Begin VB.PictureBox Pict
- AutoRedraw = -1 'True
- Height = 5295
- Left = 0
- ScaleHeight = 349
- ScaleMode = 3 'Pixel
- ScaleWidth = 461
- TabIndex = 0
- Top = 0
- Width = 6975
- End
- Begin VB.Image SurfaceImage
- Height = 495
- Index = 1
- Left = 0
- Top = 5400
- Visible = 0 'False
- Width = 495
- End
- Begin VB.Label ImageNum
- BorderStyle = 1 'Fixed Single
- Height = 255
- Left = 6600
- TabIndex = 4
- Top = 5400
- Width = 375
- End
- Begin VB.Label Label1
- Caption = "Image"
- Height = 255
- Left = 6000
- TabIndex = 3
- Top = 5400
- Width = 615
- End
- Begin VB.Menu mnuFile
- Caption = "&File"
- Begin VB.Menu mnuFileExit
- Caption = "E&xit"
- End
- End
- Attribute VB_Name = "TemporalForm"
- Attribute VB_Creatable = False
- Attribute VB_Exposed = False
- Option Explicit
- ' Location of viewing eye.
- Const EyeR = 10#
- Const EyeTheta = PI * 0.2
- Const EyePhi = PI * 0.1
- ' Location of focus point.
- Const FocusX = 0#
- Const FocusY = 0#
- Const FocusZ = 0#
- Dim Projector(1 To 4, 1 To 4) As Single
- Dim ThePicture As ObjPicture
- Dim TheGrid As ObjGrid3D
- Dim Running As Integer
- ' *******************************************************
- ' Draw the surface.
- ' *******************************************************
- Private Sub DrawData(pic As Object)
- Dim x As Single
- Dim y As Single
- Dim z As Single
- Dim S(1 To 4, 1 To 4) As Single
- Dim t(1 To 4, 1 To 4) As Single
- Dim ST(1 To 4, 1 To 4) As Single
- Dim PST(1 To 4, 1 To 4) As Single
- ' Prevent overflow errors when drawing lines
- ' too far out of bounds.
- On Error Resume Next
- ' Scale and translate so it looks OK in pixels.
- m3Scale S, 35, -35, 1
- m3Translate t, 230, 175, 0
- m3MatMultiplyFull ST, S, t
- m3MatMultiplyFull PST, Projector, ST
- ' Transform the points.
- ThePicture.ApplyFull PST
- ' Display the data.
- pic.Cls
- ThePicture.Draw pic, EyeR
- pic.Refresh
- End Sub
- Private Sub CmdDisplay_Click()
- If Running Then
- CmdDisplay.Caption = "Stopped"
- CmdDisplay.Enabled = False
- Running = False
- Else
- Running = True
- CmdDisplay.Caption = "Stop"
- ShowFrames
- CmdDisplay.Caption = "Display Images"
- CmdDisplay.Enabled = True
- End If
- End Sub
- Private Sub Form_Load()
- Dim i As Integer
- ' Initialize the projection transformation.
- m3PProject Projector, m3Perspective, EyeR, EyePhi, EyeTheta, FocusX, FocusY, FocusZ, 0, 1, 0
- ' Load empty image controls for later.
- For i = 2 To 20
- Load SurfaceImage(i)
- Next i
- End Sub
- ' ************************************************
- ' Create the surface.
- ' ************************************************
- Sub CmdCreate_click()
- Const PI_10 = PI / 10
- Const xmin = -5
- Const Zmin = -5
- Const dx = 0.3
- Const dz = 0.3
- Const NumX = -2 * xmin / dx
- Const NumZ = -2 * Zmin / dz
- Const Amp = 0.25
- Dim num As Integer
- Dim offset As Single
- Dim i As Integer
- Dim j As Integer
- Dim x As Single
- Dim y As Single
- Dim z As Single
- Dim D As Single
- MousePointer = vbHourglass
- Refresh
- For num = 1 To 20
- ImageNum.Caption = Format$(num)
- ImageNum.Refresh
-
- Set ThePicture = New ObjPicture
- Set TheGrid = New ObjGrid3D
- TheGrid.SetBounds xmin, dx, NumX, Zmin, dz, NumZ
- TheGrid.ShowHidden = False
- ThePicture.objects.Add TheGrid
- offset = num * PI_10
- x = xmin
- For i = 1 To NumX
- z = Zmin
- For j = 1 To NumZ
- D = Sqr(x * x + z * z)
- y = Amp * Cos(3 * D - offset)
-
- TheGrid.SetValue x, y, z
- z = z + dz
- Next j
- x = x + dx
- Next i
- ' Display the data.
- DrawData Pict
-
- ' Save the bitmap for later.
- SurfaceImage(num).Picture = Pict.Image
- DoEvents
- Next num
- CmdCreate.Enabled = False
- CmdDisplay.Enabled = True
- CmdDisplay.Default = True
- MousePointer = vbDefault
- Beep
- End Sub
- ' ************************************************
- ' In case the user closes the form while we're in
- ' the middle of something.
- ' ************************************************
- Private Sub Form_Unload(Cancel As Integer)
- End
- End Sub
- ' ************************************************
- ' Present the images.
- ' ************************************************
- Private Sub ShowFrames()
- Const ms_per_frame = 50
- Static num As Integer
- Dim next_time As Long
- Do While Running
- num = num + 1
- If num > 20 Then num = 1
- next_time = GetTickCount() + ms_per_frame
- Pict.Picture = SurfaceImage(num).Picture
- ImageNum.Caption = Format$(num)
- DoEvents
- WaitTill next_time
- Loop
- End Sub
- Private Sub mnuFileExit_Click()
- Unload Me
- End Sub
-