home *** CD-ROM | disk | FTP | other *** search
/ PC Pro 1998 October / DPPCPRO1098.ISO / Ocx / VCFIMP / VCIMPRES.Z / sun32.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1995-11-01  |  9.0 KB  |  284 lines
  1. VERSION 4.00
  2. Begin VB.Form Form1 
  3.    BorderStyle     =   1  'Fixed Single
  4.    Caption         =   "LightSource Vector Example"
  5.    ClientHeight    =   6735
  6.    ClientLeft      =   1170
  7.    ClientTop       =   1515
  8.    ClientWidth     =   9435
  9.    Height          =   7200
  10.    Icon            =   "sun32.frx":0000
  11.    Left            =   1080
  12.    LinkTopic       =   "Form1"
  13.    MaxButton       =   0   'False
  14.    MinButton       =   0   'False
  15.    ScaleHeight     =   6735
  16.    ScaleWidth      =   9435
  17.    Top             =   1140
  18.    Width           =   9615
  19.    Begin VB.Frame Frame2 
  20.       Caption         =   " Set Vector By Time "
  21.       Height          =   1935
  22.       Left            =   7440
  23.       TabIndex        =   6
  24.       Top             =   3420
  25.       Width           =   1815
  26.       Begin VB.CommandButton cmdSetTime 
  27.          Caption         =   "Set Time"
  28.          Height          =   315
  29.          Left            =   360
  30.          TabIndex        =   9
  31.          Top             =   1440
  32.          Width           =   1155
  33.       End
  34.       Begin VB.TextBox txtTime 
  35.          Height          =   285
  36.          Left            =   360
  37.          TabIndex        =   7
  38.          Text            =   "Time"
  39.          Top             =   960
  40.          Width           =   1155
  41.       End
  42.       Begin VB.Label Label1 
  43.          Caption         =   "0 = Midnight  0.5 = Noon"
  44.          BeginProperty Font 
  45.             name            =   "Arial"
  46.             charset         =   0
  47.             weight          =   400
  48.             size            =   9
  49.             underline       =   0   'False
  50.             italic          =   0   'False
  51.             strikethrough   =   0   'False
  52.          EndProperty
  53.          Height          =   495
  54.          Left            =   420
  55.          TabIndex        =   8
  56.          Top             =   360
  57.          Width           =   1155
  58.       End
  59.    End
  60.    Begin VB.Frame Frame1 
  61.       Caption         =   " Light Vector "
  62.       Height          =   2115
  63.       Left            =   7440
  64.       TabIndex        =   2
  65.       Top             =   1020
  66.       Width           =   1815
  67.       Begin VB.CommandButton cmdSetVector 
  68.          Caption         =   "Set Vector"
  69.          Height          =   315
  70.          Left            =   360
  71.          TabIndex        =   10
  72.          Top             =   1620
  73.          Width           =   1155
  74.       End
  75.       Begin VB.TextBox txtX 
  76.          Height          =   285
  77.          Left            =   420
  78.          TabIndex        =   5
  79.          Text            =   "X"
  80.          Top             =   420
  81.          Width           =   1215
  82.       End
  83.       Begin VB.TextBox txtZ 
  84.          Height          =   285
  85.          Left            =   420
  86.          TabIndex        =   4
  87.          Text            =   "Z"
  88.          Top             =   1140
  89.          Width           =   1215
  90.       End
  91.       Begin VB.TextBox txtY 
  92.          Height          =   285
  93.          Left            =   420
  94.          TabIndex        =   3
  95.          Text            =   "Y"
  96.          Top             =   780
  97.          Width           =   1215
  98.       End
  99.       Begin VB.Label Label2 
  100.          Caption         =   "Z:"
  101.          Height          =   255
  102.          Index           =   2
  103.          Left            =   180
  104.          TabIndex        =   13
  105.          Top             =   1200
  106.          Width           =   195
  107.       End
  108.       Begin VB.Label Label2 
  109.          Caption         =   "Y:"
  110.          Height          =   255
  111.          Index           =   1
  112.          Left            =   180
  113.          TabIndex        =   12
  114.          Top             =   840
  115.          Width           =   195
  116.       End
  117.       Begin VB.Label Label2 
  118.          Caption         =   "X:"
  119.          Height          =   255
  120.          Index           =   0
  121.          Left            =   180
  122.          TabIndex        =   11
  123.          Top             =   480
  124.          Width           =   195
  125.       End
  126.    End
  127.    Begin VB.CommandButton cmdAnimate 
  128.       Caption         =   "Animate"
  129.       Height          =   435
  130.       Left            =   7800
  131.       TabIndex        =   1
  132.       Top             =   5760
  133.       Width           =   1155
  134.    End
  135.    Begin VCIFiLib.VtChart VtChart1 
  136.       Height          =   6615
  137.       Left            =   60
  138.       TabIndex        =   0
  139.       Top             =   60
  140.       Width           =   7215
  141.       _version        =   65536
  142.       _extentx        =   12726
  143.       _extenty        =   11668
  144.       _stockprops     =   96
  145.       borderstyle     =   1
  146.       filename        =   "sun32.frx":030A
  147.    End
  148. Attribute VB_Name = "Form1"
  149. Attribute VB_Creatable = False
  150. Attribute VB_Exposed = False
  151. Option Explicit
  152. Sub LoadSufaceData(filename$)
  153.    Dim rows%, cols%, i%, j%, junk$, value#
  154.    On Error GoTo LoadSufaceDataError
  155.    Open filename For Input As #1
  156.    Input #1, junk, rows
  157.    Input #1, junk, cols
  158.    With VtChart1
  159.       .RowCount = rows
  160.       .ColumnCount = cols
  161.       With .DataGrid
  162.          For i = 1 To rows
  163.             For j = 1 To cols
  164.                Input #1, value
  165.                .SetData i, j, value, False
  166.             Next j
  167.          Next i
  168.       End With
  169.    End With
  170.    Close #1
  171.       
  172.    Exit Sub
  173. LoadSufaceDataError:
  174.    MsgBox Error
  175. End Sub
  176. Sub FormatSurfaceChart()
  177.    Dim i%, attr As Object
  178.    With VtChart1
  179.       .ChartType = VtChChartType3dSurface
  180.       .Backdrop.Fill.Style = VtFillStyleBrush
  181.       .Backdrop.Fill.Brush.FillColor.Set 64, 192, 192
  182.       
  183.       With .Plot
  184.          .Light.EdgeVisible = False
  185.          .Elevation.Surface.WireframePen.Style = VtPenStyleNull
  186.          .Elevation.Surface.DisplayType = VtChSurfaceDisplayTypeCBands
  187.          .PlotBase.BaseHeight = 0
  188.          .Wall.Pen.Style = VtPenStyleNull
  189.          
  190.          .Axis(VtChAxisIdZ).AxisGrid.MajorPen.Style = VtPenStyleNull
  191.          .Axis(VtChAxisIdZ).AxisScale.Hide = True
  192.          
  193.          .Axis(VtChAxisIdY).AxisGrid.MajorPen.Style = VtPenStyleNull
  194.          .Axis(VtChAxisIdY).AxisScale.Hide = True
  195.          
  196.          .Axis(VtChAxisIdY2).AxisGrid.MajorPen.Style = VtPenStyleNull
  197.          .Axis(VtChAxisIdY2).AxisScale.Hide = True
  198.          
  199.          .Axis(VtChAxisIdX).AxisGrid.MajorPen.Style = VtPenStyleNull
  200.          .Axis(VtChAxisIdX).AxisScale.Hide = True
  201.          
  202.          .View3d.Set 58, 16
  203.          
  204.          With .Elevation
  205.             '' Set up the contours
  206.             .AutoValues = False
  207.             .ColorType = VtChContourColorTypeManual
  208.             
  209.             With .Attributes
  210.                For i = 1 To .Count - 5
  211.                   .Remove (i)
  212.                Next i
  213.                
  214.                '' Set contour values and their color
  215.                .Item(1).value = 0
  216.                .Item(2).value = 0.01
  217.                .Item(3).value = 43
  218.                .Item(4).value = 43.5
  219.                .Item(5).value = 50
  220.                
  221.                .Item(1).Brush.FillColor.Set 0, 0, 202
  222.                .Item(2).Brush.FillColor.Set 0, 0, 202
  223.                .Item(3).Brush.FillColor.Set 10, 128, 10
  224.                .Item(4).Brush.FillColor.Set 210, 210, 210
  225.                .Item(5).Brush.FillColor.Set 255, 255, 255
  226.             End With
  227.             
  228.             For Each attr In .Attributes
  229.                attr.Brush.Style = VtBrushStyleSolid
  230.             Next attr
  231.             
  232.          End With
  233.       End With
  234.    End With
  235. End Sub
  236. Sub SetLightForTime(ch As Object, theTime!)
  237. '' Times are in the spreadsheet serial number format where
  238. '' 1 = a day so zero = midnight and 0.5 = noon. For trig
  239. '' functions Pi/2 = midnight and 3Pi/2 = noon. The code
  240. '' below maps time to light source coordinates. We also throw
  241. '' in some ambient intensity to simulate the reflected light
  242. '' during midday. Note that we are setting the direction
  243. '' of the sun's rays, not its position. See the associated
  244. '' readme for chart/light coordinate systems.
  245.    Const r = 20
  246.    Const HALFPI = 1.5708
  247.    Dim radians!, x!, y!, z!
  248.    radians = (theTime / 0.25) * HALFPI + HALFPI
  249.    x = r * Cos(radians)
  250.    y = r * Sin(radians)
  251.    z = -0.1 + theTime
  252.    ch.Plot.Light.LightSources.Item(1).Set x, y, z, 1
  253.    ch.Plot.Light.AmbientIntensity = 1.25 * (IIf(theTime > 0.5, 1 - theTime, theTime))
  254.    txtX.Text = Str(x)
  255.    txtY.Text = Str(y)
  256.    txtZ.Text = Str(z)
  257. End Sub
  258. Private Sub cmdAnimate_Click()
  259.    Static when!
  260.    For when = 0 To 1 Step 0.05
  261.       SetLightForTime VtChart1, when
  262.       txtTime.Text = Format(when, "hh:mm")
  263.       DoEvents
  264.    Next when
  265. End Sub
  266. Private Sub cmdSetTime_Click()
  267.    Dim theTime!
  268.    theTime = Val(txtTime.Text)
  269.    If theTime >= 0 And theTime <= 1 Then
  270.       txtTime.Text = Format(theTime, "hh:mm")
  271.       SetLightForTime VtChart1, theTime
  272.    Else
  273.       MsgBox "Time must be a number between 0 and 1."
  274.    End If
  275.       
  276. End Sub
  277. Private Sub cmdSetVector_Click()
  278.    VtChart1.Plot.Light.LightSources.Item(1).Set Val(txtX.Text), Val(txtY.Text), Val(txtZ.Text), 1
  279. End Sub
  280. Private Sub Form_Load()
  281.    LoadSufaceData App.Path & "\surfdata.txt"
  282.    FormatSurfaceChart
  283. End Sub
  284.