home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / OldSrc / CH12 / SRC / LIGHT4.FRM (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1997-01-08  |  22.6 KB  |  726 lines

  1. VERSION 4.00
  2. Begin VB.Form LightForm 
  3.    Appearance      =   0  'Flat
  4.    Caption         =   "Light4"
  5.    ClientHeight    =   6075
  6.    ClientLeft      =   1335
  7.    ClientTop       =   630
  8.    ClientWidth     =   6030
  9.    BeginProperty Font 
  10.       name            =   "MS Sans Serif"
  11.       charset         =   0
  12.       weight          =   700
  13.       size            =   8.25
  14.       underline       =   0   'False
  15.       italic          =   0   'False
  16.       strikethrough   =   0   'False
  17.    EndProperty
  18.    ForeColor       =   &H80000008&
  19.    Height          =   6765
  20.    KeyPreview      =   -1  'True
  21.    Left            =   1275
  22.    LinkTopic       =   "Form1"
  23.    ScaleHeight     =   6075
  24.    ScaleWidth      =   6030
  25.    Top             =   0
  26.    Width           =   6150
  27.    Begin VB.TextBox NText 
  28.       BeginProperty Font 
  29.          name            =   "MS Sans Serif"
  30.          charset         =   0
  31.          weight          =   700
  32.          size            =   8.25
  33.          underline       =   0   'False
  34.          italic          =   0   'False
  35.          strikethrough   =   0   'False
  36.       EndProperty
  37.       Height          =   285
  38.       Left            =   5160
  39.       TabIndex        =   19
  40.       Text            =   "10"
  41.       Top             =   5400
  42.       Width           =   855
  43.    End
  44.    Begin VB.TextBox KsText 
  45.       BeginProperty Font 
  46.          name            =   "MS Sans Serif"
  47.          charset         =   0
  48.          weight          =   700
  49.          size            =   8.25
  50.          underline       =   0   'False
  51.          italic          =   0   'False
  52.          strikethrough   =   0   'False
  53.       EndProperty
  54.       Height          =   285
  55.       Left            =   5160
  56.       TabIndex        =   16
  57.       Text            =   "0.2"
  58.       Top             =   5760
  59.       Width           =   855
  60.    End
  61.    Begin VB.TextBox KdistText 
  62.       BeginProperty Font 
  63.          name            =   "MS Sans Serif"
  64.          charset         =   0
  65.          weight          =   700
  66.          size            =   8.25
  67.          underline       =   0   'False
  68.          italic          =   0   'False
  69.          strikethrough   =   0   'False
  70.       EndProperty
  71.       Height          =   285
  72.       Left            =   3600
  73.       TabIndex        =   13
  74.       Text            =   "-1100"
  75.       Top             =   5760
  76.       Width           =   855
  77.    End
  78.    Begin VB.TextBox KaText 
  79.       BeginProperty Font 
  80.          name            =   "MS Sans Serif"
  81.          charset         =   0
  82.          weight          =   700
  83.          size            =   8.25
  84.          underline       =   0   'False
  85.          italic          =   0   'False
  86.          strikethrough   =   0   'False
  87.       EndProperty
  88.       Height          =   285
  89.       Left            =   2040
  90.       TabIndex        =   10
  91.       Text            =   "0.30"
  92.       Top             =   5760
  93.       Width           =   855
  94.    End
  95.    Begin VB.TextBox KdText 
  96.       BeginProperty Font 
  97.          name            =   "MS Sans Serif"
  98.          charset         =   0
  99.          weight          =   700
  100.          size            =   8.25
  101.          underline       =   0   'False
  102.          italic          =   0   'False
  103.          strikethrough   =   0   'False
  104.       EndProperty
  105.       Height          =   285
  106.       Left            =   480
  107.       TabIndex        =   8
  108.       Text            =   "0.65"
  109.       Top             =   5760
  110.       Width           =   855
  111.    End
  112.    Begin VB.TextBox PhiText 
  113.       BeginProperty Font 
  114.          name            =   "MS Sans Serif"
  115.          charset         =   0
  116.          weight          =   700
  117.          size            =   8.25
  118.          underline       =   0   'False
  119.          italic          =   0   'False
  120.          strikethrough   =   0   'False
  121.       EndProperty
  122.       Height          =   285
  123.       Left            =   3600
  124.       TabIndex        =   6
  125.       Text            =   "0.1571"
  126.       Top             =   5400
  127.       Width           =   855
  128.    End
  129.    Begin VB.TextBox ThetaText 
  130.       BeginProperty Font 
  131.          name            =   "MS Sans Serif"
  132.          charset         =   0
  133.          weight          =   700
  134.          size            =   8.25
  135.          underline       =   0   'False
  136.          italic          =   0   'False
  137.          strikethrough   =   0   'False
  138.       EndProperty
  139.       Height          =   285
  140.       Left            =   2040
  141.       TabIndex        =   4
  142.       Text            =   "1.8850"
  143.       Top             =   5400
  144.       Width           =   855
  145.    End
  146.    Begin VB.TextBox RText 
  147.       BeginProperty Font 
  148.          name            =   "MS Sans Serif"
  149.          charset         =   0
  150.          weight          =   700
  151.          size            =   8.25
  152.          underline       =   0   'False
  153.          italic          =   0   'False
  154.          strikethrough   =   0   'False
  155.       EndProperty
  156.       Height          =   285
  157.       Left            =   480
  158.       TabIndex        =   2
  159.       Text            =   "20.0000"
  160.       Top             =   5400
  161.       Width           =   855
  162.    End
  163.    Begin VB.PictureBox Pict 
  164.       AutoRedraw      =   -1  'True
  165.       BackColor       =   &H00FFFF80&
  166.       BeginProperty Font 
  167.          name            =   "MS Sans Serif"
  168.          charset         =   0
  169.          weight          =   700
  170.          size            =   8.25
  171.          underline       =   0   'False
  172.          italic          =   0   'False
  173.          strikethrough   =   0   'False
  174.       EndProperty
  175.       Height          =   5295
  176.       Left            =   0
  177.       Picture         =   "Light4.frx":0000
  178.       ScaleHeight     =   -14
  179.       ScaleLeft       =   -7
  180.       ScaleMode       =   0  'User
  181.       ScaleTop        =   7
  182.       ScaleWidth      =   15.926
  183.       TabIndex        =   0
  184.       Top             =   0
  185.       Width           =   6015
  186.    End
  187.    Begin VB.Label Label1 
  188.       Caption         =   "N"
  189.       BeginProperty Font 
  190.          name            =   "MS Sans Serif"
  191.          charset         =   0
  192.          weight          =   700
  193.          size            =   8.25
  194.          underline       =   0   'False
  195.          italic          =   0   'False
  196.          strikethrough   =   0   'False
  197.       EndProperty
  198.       Height          =   255
  199.       Index           =   12
  200.       Left            =   4920
  201.       TabIndex        =   20
  202.       Top             =   5400
  203.       Width           =   135
  204.    End
  205.    Begin VB.Label Label1 
  206.       Caption         =   "k"
  207.       BeginProperty Font 
  208.          name            =   "MS Sans Serif"
  209.          charset         =   0
  210.          weight          =   700
  211.          size            =   8.25
  212.          underline       =   0   'False
  213.          italic          =   0   'False
  214.          strikethrough   =   0   'False
  215.       EndProperty
  216.       Height          =   255
  217.       Index           =   10
  218.       Left            =   4800
  219.       TabIndex        =   18
  220.       Top             =   5760
  221.       Width           =   135
  222.    End
  223.    Begin VB.Label Label1 
  224.       Caption         =   "s"
  225.       BeginProperty Font 
  226.          name            =   "MS Sans Serif"
  227.          charset         =   0
  228.          weight          =   700
  229.          size            =   8.25
  230.          underline       =   0   'False
  231.          italic          =   0   'False
  232.          strikethrough   =   0   'False
  233.       EndProperty
  234.       Height          =   255
  235.       Index           =   9
  236.       Left            =   4920
  237.       TabIndex        =   17
  238.       Top             =   5880
  239.       Width           =   135
  240.    End
  241.    Begin VB.Label Label1 
  242.       Caption         =   "dist"
  243.       BeginProperty Font 
  244.          name            =   "MS Sans Serif"
  245.          charset         =   0
  246.          weight          =   700
  247.          size            =   8.25
  248.          underline       =   0   'False
  249.          italic          =   0   'False
  250.          strikethrough   =   0   'False
  251.       EndProperty
  252.       Height          =   255
  253.       Index           =   8
  254.       Left            =   3240
  255.       TabIndex        =   15
  256.       Top             =   5880
  257.       Width           =   375
  258.    End
  259.    Begin VB.Label Label1 
  260.       Caption         =   "k"
  261.       BeginProperty Font 
  262.          name            =   "MS Sans Serif"
  263.          charset         =   0
  264.          weight          =   700
  265.          size            =   8.25
  266.          underline       =   0   'False
  267.          italic          =   0   'False
  268.          strikethrough   =   0   'False
  269.       EndProperty
  270.       Height          =   255
  271.       Index           =   6
  272.       Left            =   3120
  273.       TabIndex        =   14
  274.       Top             =   5760
  275.       Width           =   135
  276.    End
  277.    Begin VB.Label Label1 
  278.       Caption         =   "k"
  279.       BeginProperty Font 
  280.          name            =   "MS Sans Serif"
  281.          charset         =   0
  282.          weight          =   700
  283.          size            =   8.25
  284.          underline       =   0   'False
  285.          italic          =   0   'False
  286.          strikethrough   =   0   'False
  287.       EndProperty
  288.       Height          =   255
  289.       Index           =   5
  290.       Left            =   1680
  291.       TabIndex        =   12
  292.       Top             =   5760
  293.       Width           =   135
  294.    End
  295.    Begin VB.Label Label1 
  296.       Caption         =   "a"
  297.       BeginProperty Font 
  298.          name            =   "MS Sans Serif"
  299.          charset         =   0
  300.          weight          =   700
  301.          size            =   8.25
  302.          underline       =   0   'False
  303.          italic          =   0   'False
  304.          strikethrough   =   0   'False
  305.       EndProperty
  306.       Height          =   255
  307.       Index           =   4
  308.       Left            =   1800
  309.       TabIndex        =   11
  310.       Top             =   5880
  311.       Width           =   135
  312.    End
  313.    Begin VB.Label Label1 
  314.       Caption         =   "d"
  315.       BeginProperty Font 
  316.          name            =   "MS Sans Serif"
  317.          charset         =   0
  318.          weight          =   700
  319.          size            =   8.25
  320.          underline       =   0   'False
  321.          italic          =   0   'False
  322.          strikethrough   =   0   'False
  323.       EndProperty
  324.       Height          =   255
  325.       Index           =   3
  326.       Left            =   240
  327.       TabIndex        =   9
  328.       Top             =   5880
  329.       Width           =   135
  330.    End
  331.    Begin MSComDlg.CommonDialog LoadDialog 
  332.       Left            =   4560
  333.       Top             =   5160
  334.       _Version        =   65536
  335.       _ExtentX        =   847
  336.       _ExtentY        =   847
  337.       _StockProps     =   0
  338.       CancelError     =   -1  'True
  339.    End
  340.    Begin VB.Label Label1 
  341.       Caption         =   "k"
  342.       BeginProperty Font 
  343.          name            =   "MS Sans Serif"
  344.          charset         =   0
  345.          weight          =   700
  346.          size            =   8.25
  347.          underline       =   0   'False
  348.          italic          =   0   'False
  349.          strikethrough   =   0   'False
  350.       EndProperty
  351.       Height          =   255
  352.       Index           =   7
  353.       Left            =   120
  354.       TabIndex        =   7
  355.       Top             =   5760
  356.       Width           =   135
  357.    End
  358.    Begin VB.Label Label1 
  359.       Caption         =   "Phi"
  360.       BeginProperty Font 
  361.          name            =   "MS Sans Serif"
  362.          charset         =   0
  363.          weight          =   700
  364.          size            =   8.25
  365.          underline       =   0   'False
  366.          italic          =   0   'False
  367.          strikethrough   =   0   'False
  368.       EndProperty
  369.       Height          =   255
  370.       Index           =   2
  371.       Left            =   3240
  372.       TabIndex        =   5
  373.       Top             =   5400
  374.       Width           =   375
  375.    End
  376.    Begin VB.Label Label1 
  377.       Caption         =   "Theta"
  378.       BeginProperty Font 
  379.          name            =   "MS Sans Serif"
  380.          charset         =   0
  381.          weight          =   700
  382.          size            =   8.25
  383.          underline       =   0   'False
  384.          italic          =   0   'False
  385.          strikethrough   =   0   'False
  386.       EndProperty
  387.       Height          =   255
  388.       Index           =   1
  389.       Left            =   1440
  390.       TabIndex        =   3
  391.       Top             =   5400
  392.       Width           =   495
  393.    End
  394.    Begin VB.Label Label1 
  395.       Caption         =   "R"
  396.       BeginProperty Font 
  397.          name            =   "MS Sans Serif"
  398.          charset         =   0
  399.          weight          =   700
  400.          size            =   8.25
  401.          underline       =   0   'False
  402.          italic          =   0   'False
  403.          strikethrough   =   0   'False
  404.       EndProperty
  405.       Height          =   255
  406.       Index           =   0
  407.       Left            =   240
  408.       TabIndex        =   1
  409.       Top             =   5400
  410.       Width           =   255
  411.    End
  412.    Begin VB.Menu mnuFile 
  413.       Caption         =   "&File"
  414.       Begin VB.Menu mnuFileLoad 
  415.          Caption         =   "&Load..."
  416.          Shortcut        =   ^L
  417.       End
  418.       Begin VB.Menu mnuFileSep 
  419.          Caption         =   "-"
  420.       End
  421.       Begin VB.Menu mnuFileExit 
  422.          Caption         =   "E&xit"
  423.       End
  424.    End
  425. Attribute VB_Name = "LightForm"
  426. Attribute VB_Creatable = False
  427. Attribute VB_Exposed = False
  428. Option Explicit
  429. Dim SysPalSize As Integer
  430. Dim NumStaticColors As Integer
  431. Dim StaticColor1 As Integer
  432. Dim StaticColor2 As Integer
  433. Dim syspal(0 To 255) As PALETTEENTRY
  434. ' Location of viewing eye.
  435. Dim EyeR As Single
  436. Dim EyeTheta As Single
  437. Dim EyePhi As Single
  438. Const dtheta = PI / 20
  439. Const Dphi = PI / 20
  440. Const dR = 1
  441. ' Location of focus point.
  442. Const FocusX = 0#
  443. Const FocusY = 0#
  444. Const FocusZ = 0#
  445. Dim Projector(1 To 4, 1 To 4) As Single
  446. Dim ThePicture As ObjPicture
  447. Dim ShowingParameters As Boolean
  448. ' *******************************************************
  449. ' Rotate the points in the cube and draw the cube.
  450. ' *******************************************************
  451. Private Sub DrawData(pic As Object)
  452. Dim old_draw As Integer
  453. Dim old_fill As Integer
  454. Dim t1(1 To 4, 1 To 4) As Single
  455. Dim t2(1 To 4, 1 To 4) As Single
  456. Dim T12(1 To 4, 1 To 4) As Single
  457. Dim T123(1 To 4, 1 To 4) As Single
  458. Dim pt As Point3D
  459.     MousePointer = vbHourglass
  460.     ' Get constants for the surfaces.
  461.     LightKd = CSng(KdText.Text)
  462.     LightKa = CSng(KaText.Text)
  463.     LightKdist = CSng(KdistText.Text)
  464.     LightKs = CSng(KsText.Text)
  465.     LightN = CSng(NText.Text)
  466.     ' Adjust LightIi.
  467.     LightIi = 255 * _
  468.         (ThePicture.Distance(LightX, LightY, LightZ) _
  469.         + LightKdist + 4)
  470.     ' Prevent overflow errors when drawing lines
  471.     ' too far out of bounds.
  472.     On Error Resume Next
  473.     ' Cull backfaces.
  474.     ThePicture.Culled = False
  475.     m3SphericalToCartesian EyeR, EyeTheta, EyePhi, EyeX, EyeY, EyeZ
  476.     ThePicture.Cull EyeX, EyeY, EyeZ
  477.     ' Clip faces behind the center of projection.
  478.     ThePicture.ClipEye EyeR
  479.     ' Transform coordinates into pixels.
  480.     m3Scale t1, _
  481.         Pict.ScaleX(1, Pict.ScaleMode, vbPixels), _
  482.         Pict.ScaleY(1, Pict.ScaleMode, vbPixels), _
  483.         1
  484.     m3Translate t2, _
  485.         -Pict.ScaleX(Pict.ScaleLeft, Pict.ScaleMode, vbPixels), _
  486.         -Pict.ScaleY(Pict.ScaleTop, Pict.ScaleMode, vbPixels), _
  487.         0
  488.     m3MatMultiply T12, t1, t2
  489.     m3MatMultiplyFull T123, Projector, T12
  490.     ' Transform the points.
  491.     ThePicture.ApplyFull T123
  492.     ' Clear the screen. We must do this before
  493.     ' selecting the pen and brush since Cls resets
  494.     ' the pen and brush to default values.
  495.     pic.Cls
  496.     ' Prepare to fill polygons.
  497.     old_draw = pic.DrawStyle
  498.     old_fill = pic.FillStyle
  499.     pic.DrawStyle = vbInvisible
  500.     pic.FillStyle = vbFSSolid
  501.     ' Display the data.
  502.     ThePicture.DrawShaded pic, EyeR
  503.     pic.Refresh
  504.     ' Restore the old draw and fill styles.
  505.     pic.DrawStyle = old_draw
  506.     pic.FillStyle = old_fill
  507.     ' Display the viewing parameters.
  508.     ShowViewingParameters
  509.     MousePointer = vbDefault
  510. End Sub
  511. Sub ShowViewingParameters()
  512.     ShowingParameters = True
  513.     RText.Text = Format$(EyeR, "0.0000")
  514.     ThetaText.Text = Format$(EyeTheta, "0.0000")
  515.     PhiText.Text = Format$(EyePhi, "0.0000")
  516.     RText.Refresh
  517.     ThetaText.Refresh
  518.     PhiText.Refresh
  519.     ShowingParameters = False
  520. End Sub
  521. Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  522.     Select Case KeyCode
  523.         Case vbKeyLeft
  524.             EyeTheta = EyeTheta - dtheta
  525.         
  526.         Case vbKeyRight
  527.             EyeTheta = EyeTheta + dtheta
  528.         
  529.         Case vbKeyUp
  530.             EyePhi = EyePhi - Dphi
  531.         
  532.         Case vbKeyDown
  533.             EyePhi = EyePhi + Dphi
  534.                 
  535.         Case Else
  536.             Exit Sub
  537.     End Select
  538.     m3PProject Projector, m3Perspective, EyeR, EyePhi, EyeTheta, FocusX, FocusY, FocusZ, 0, 1, 0
  539.     DrawData Pict
  540. End Sub
  541. Private Sub Form_KeyPress(KeyAscii As Integer)
  542.     Select Case KeyAscii
  543.         Case Asc("+")
  544.             EyeR = EyeR + dR
  545.         
  546.         Case Asc("-")
  547.             EyeR = EyeR - dR
  548.         
  549.         Case Else
  550.             Exit Sub
  551.     End Select
  552.     m3PProject Projector, m3Perspective, EyeR, EyePhi, EyeTheta, FocusX, FocusY, FocusZ, 0, 1, 0
  553.     DrawData Pict
  554. End Sub
  555. Private Sub Form_Load()
  556.     ' Make sure the screen supports palettes.
  557.     If Not GetDeviceCaps(hdc, RASTERCAPS) And RC_PALETTE Then
  558.         Beep
  559.         MsgBox "This monitor does not support palettes.", _
  560.             vbCritical
  561.         End
  562.     End If
  563.     ' Get system palette size and # static colors.
  564.     SysPalSize = GetDeviceCaps(hdc, SIZEPALETTE)
  565.     NumStaticColors = GetDeviceCaps(hdc, NUMRESERVED)
  566.     StaticColor1 = NumStaticColors \ 2 - 1
  567.     StaticColor2 = SysPalSize - NumStaticColors \ 2
  568.     ' Fill the picture's palette with grays.
  569.     MatchGrayPalette Pict
  570.     Pict.Cls
  571.     ' Initialize the eye position.
  572.     EyeR = 20
  573.     EyeTheta = PI * 0.2
  574.     EyePhi = PI * 0.05
  575.     ' Initialize the projection transformation.
  576.     m3PProject Projector, m3Perspective, EyeR, EyePhi, EyeTheta, FocusX, FocusY, FocusZ, 0, 1, 0
  577. End Sub
  578. ' ***********************************************
  579. ' Load the control's palette so the non-static
  580. ' colors are grays. Map the logical palette to
  581. ' match the system palette. Convert the image to
  582. ' use the non-static grays.
  583. ' Leave new system palette entries in SysPal().
  584. ' ***********************************************
  585. Sub MatchGrayPalette(pic As Control)
  586. Dim origpal(0 To 255) As PALETTEENTRY
  587. Dim wid As Long
  588. Dim hgt As Long
  589. Dim bytes() As Byte
  590. Dim i As Integer
  591. Dim bm As BITMAP
  592. Dim hbm As Integer
  593. Dim status As Long
  594. Dim x As Integer
  595. Dim y As Integer
  596. Dim gray As Single
  597. Dim dgray As Single
  598. Dim C As Integer
  599. Dim clr As Integer
  600. Dim logpal As Long
  601.     ' Make sure pic has the foreground palette.
  602.     pic.ZOrder
  603.     status = RealizePalette(pic.hdc)
  604.     DoEvents
  605.     ' Get the system palette entries.
  606.     status = GetSystemPaletteEntries(pic.hdc, 0, SysPalSize, origpal(0))
  607.         
  608.     ' Get the image pixels.
  609.     hbm = pic.Image
  610.     status = GetObject(hbm, BITMAP_SIZE, bm)
  611.     wid = bm.bmWidthBytes
  612.     hgt = bm.bmHeight
  613.     ReDim bytes(1 To wid, 1 To hgt)
  614.     status = GetBitmapBits(hbm, wid * hgt, bytes(1, 1))
  615.     ' Make the logical palette as big as possible.
  616.     logpal = pic.Picture.hPal
  617.     If ResizePalette(logpal, SysPalSize) = 0 Then
  618.         Beep
  619.         MsgBox "Error resizing logical palette.", _
  620.             vbExclamation
  621.         Exit Sub
  622.     End If
  623.     ' Blank the non-static colors.
  624.     For i = 0 To StaticColor1
  625.         syspal(i) = origpal(i)
  626.     Next i
  627.     For i = StaticColor1 + 1 To StaticColor2 - 1
  628.         With syspal(i)
  629.             .peRed = 0
  630.             .peGreen = 0
  631.             .peBlue = 0
  632.             .peFlags = PC_NOCOLLAPSE
  633.         End With
  634.     Next i
  635.     For i = StaticColor2 To 255
  636.         syspal(i) = origpal(i)
  637.     Next i
  638.     status = SetPaletteEntries(logpal, 0, SysPalSize, syspal(0))
  639.     ' Insert the non-static grays.
  640.     gray = 0
  641.     dgray = 255 / (StaticColor2 - StaticColor1 - 2)
  642.     For i = StaticColor1 + 1 To StaticColor2 - 1
  643.         C = gray
  644.         gray = gray + dgray
  645.         With syspal(i)
  646.             .peRed = C
  647.             .peGreen = C
  648.             .peBlue = C
  649.         End With
  650.     Next i
  651.     status = SetPaletteEntries(logpal, StaticColor1 + 1, StaticColor2 - StaticColor1 - 1, syspal(StaticColor1 + 1))
  652.     ' Realize the gray palette.
  653.     status = RealizePalette(pic.hdc)
  654.     pic.Refresh
  655. End Sub
  656. Private Sub mnuFileExit_Click()
  657.     Unload Me
  658. End Sub
  659. Private Sub mnuFileLoad_Click()
  660. Dim fname As String
  661. Dim filenum As Integer
  662. Dim txt As String
  663. Dim xmin As Single
  664. Dim ymin As Single
  665. Dim xmax As Single
  666. Dim ymax As Single
  667.     ' Allow the user to pick a file.
  668.     On Error Resume Next
  669.     LoadDialog.filename = "*.APF"
  670.     LoadDialog.ShowOpen
  671.     LoadDialog.Flags = cdlOFNFileMustExist + cdlOFNHideReadOnly
  672.     If Err.Number = cdlCancel Then
  673.         Unload LoadDialog
  674.         Exit Sub
  675.     ElseIf Err.Number <> 0 Then
  676.         Unload LoadDialog
  677.         Beep
  678.         MsgBox "Error selecting file.", , vbExclamation
  679.         Exit Sub
  680.     End If
  681.     On Error GoTo 0
  682.     fname = LoadDialog.filename
  683.     LoadDialog.InitDir = Left$(fname, Len(fname) _
  684.         - Len(LoadDialog.FileTitle) - 1)
  685.     ' Clear the picture.
  686.     Set ThePicture = Nothing
  687.     ' Open the file.
  688.     filenum = FreeFile
  689.     Open fname For Input As #filenum
  690.     ' Make sure it's an Object Picture File.
  691.     Input #filenum, txt
  692.     If txt <> "3D APF PICTURE" Then
  693.         Close filenum
  694.         Caption = "Light4"
  695.         Beep
  696.         MsgBox "Error reading file """ & fname & """.", , vbExclamation
  697.         Exit Sub
  698.     End If
  699.     ' Read the picture.
  700.     Set ThePicture = New ObjPicture
  701.     ThePicture.FileInput filenum
  702.     ' Close the file.
  703.     Close filenum
  704.     Caption = "Light4 [" & LoadDialog.FileTitle & "]"
  705.     ' Refresh the display.
  706.     DrawData Pict
  707. End Sub
  708. Private Sub PhiText_Change()
  709.     If ShowingParameters Then Exit Sub
  710.     EyePhi = CSng(PhiText.Text)
  711.     m3PProject Projector, m3Perspective, EyeR, EyePhi, EyeTheta, FocusX, FocusY, FocusZ, 0, 1, 0
  712.     DrawData Pict
  713. End Sub
  714. Private Sub RText_Change()
  715.     If ShowingParameters Then Exit Sub
  716.     EyeR = CSng(RText.Text)
  717.     m3PProject Projector, m3Perspective, EyeR, EyePhi, EyeTheta, FocusX, FocusY, FocusZ, 0, 1, 0
  718.     DrawData Pict
  719. End Sub
  720. Private Sub ThetaText_Change()
  721.     If ShowingParameters Then Exit Sub
  722.     EyeTheta = CSng(ThetaText.Text)
  723.     m3PProject Projector, m3Perspective, EyeR, EyePhi, EyeTheta, FocusX, FocusY, FocusZ, 0, 1, 0
  724.     DrawData Pict
  725. End Sub
  726.