home *** CD-ROM | disk | FTP | other *** search
/ Using Visual Basic 5 (Platinum Edition) / vb5.iso / ACTIVEX / VIS3SPAC / DATA.9 / examples / vb / vbStates2.0 / vbStates.frm (.txt) next >
Encoding:
Visual Basic Form  |  1996-11-14  |  14.2 KB  |  482 lines
  1. VERSION 4.00
  2. Begin VB.Form Form1 
  3.    Caption         =   "vbStates"
  4.    ClientHeight    =   8355
  5.    ClientLeft      =   1770
  6.    ClientTop       =   675
  7.    ClientWidth     =   7530
  8.    BeginProperty Font 
  9.       name            =   "Times New Roman"
  10.       charset         =   0
  11.       weight          =   700
  12.       size            =   18
  13.       underline       =   0   'False
  14.       italic          =   0   'False
  15.       strikethrough   =   0   'False
  16.    EndProperty
  17.    Height          =   8730
  18.    Left            =   1710
  19.    LinkTopic       =   "Form1"
  20.    ScaleHeight     =   8355
  21.    ScaleWidth      =   7530
  22.    Top             =   360
  23.    Width           =   7650
  24.    Begin VB.PictureBox Picture1 
  25.       AutoSize        =   -1  'True
  26.       BeginProperty Font 
  27.          name            =   "MS Sans Serif"
  28.          charset         =   0
  29.          weight          =   400
  30.          size            =   8.25
  31.          underline       =   0   'False
  32.          italic          =   0   'False
  33.          strikethrough   =   0   'False
  34.       EndProperty
  35.       Height          =   1020
  36.       Left            =   5880
  37.       Picture         =   "vbStates.frx":0000
  38.       ScaleHeight     =   960
  39.       ScaleWidth      =   1500
  40.       TabIndex        =   7
  41.       Top             =   120
  42.       Width           =   1560
  43.    End
  44.    Begin VB.CommandButton Command4 
  45.       Caption         =   "Edit Light"
  46.       BeginProperty Font 
  47.          name            =   "MS Sans Serif"
  48.          charset         =   0
  49.          weight          =   400
  50.          size            =   8.25
  51.          underline       =   0   'False
  52.          italic          =   0   'False
  53.          strikethrough   =   0   'False
  54.       EndProperty
  55.       Height          =   492
  56.       Left            =   3960
  57.       TabIndex        =   5
  58.       Top             =   840
  59.       Width           =   1692
  60.    End
  61.    Begin VB.CommandButton thumb 
  62.       Caption         =   "Thumbwheels On"
  63.       BeginProperty Font 
  64.          name            =   "MS Sans Serif"
  65.          charset         =   0
  66.          weight          =   400
  67.          size            =   8.25
  68.          underline       =   0   'False
  69.          italic          =   0   'False
  70.          strikethrough   =   0   'False
  71.       EndProperty
  72.       Height          =   492
  73.       Left            =   1920
  74.       TabIndex        =   4
  75.       Top             =   840
  76.       Width           =   1572
  77.    End
  78.    Begin VB.CommandButton Command3 
  79.       Caption         =   "Reset"
  80.       BeginProperty Font 
  81.          name            =   "MS Sans Serif"
  82.          charset         =   0
  83.          weight          =   400
  84.          size            =   8.25
  85.          underline       =   0   'False
  86.          italic          =   0   'False
  87.          strikethrough   =   0   'False
  88.       EndProperty
  89.       Height          =   492
  90.       Left            =   5520
  91.       TabIndex        =   3
  92.       Top             =   5280
  93.       Width           =   1692
  94.    End
  95.    Begin VB.CommandButton Command2 
  96.       Caption         =   "Day 2"
  97.       BeginProperty Font 
  98.          name            =   "MS Sans Serif"
  99.          charset         =   0
  100.          weight          =   400
  101.          size            =   8.25
  102.          underline       =   0   'False
  103.          italic          =   0   'False
  104.          strikethrough   =   0   'False
  105.       EndProperty
  106.       Height          =   492
  107.       Left            =   2760
  108.       TabIndex        =   2
  109.       Top             =   5280
  110.       Width           =   1692
  111.    End
  112.    Begin VB.CommandButton Command1 
  113.       Caption         =   "Day 1"
  114.       BeginProperty Font 
  115.          name            =   "MS Sans Serif"
  116.          charset         =   0
  117.          weight          =   400
  118.          size            =   8.25
  119.          underline       =   0   'False
  120.          italic          =   0   'False
  121.          strikethrough   =   0   'False
  122.       EndProperty
  123.       Height          =   492
  124.       Left            =   120
  125.       TabIndex        =   1
  126.       Top             =   5280
  127.       Width           =   1692
  128.    End
  129.    Begin VB.Label Label6 
  130.       Caption         =   "San Diego, California 92121"
  131.       BeginProperty Font 
  132.          name            =   "Times New Roman"
  133.          charset         =   0
  134.          weight          =   400
  135.          size            =   12
  136.          underline       =   0   'False
  137.          italic          =   0   'False
  138.          strikethrough   =   0   'False
  139.       EndProperty
  140.       Height          =   252
  141.       Left            =   2280
  142.       TabIndex        =   12
  143.       Top             =   7560
  144.       Width           =   2892
  145.    End
  146.    Begin VB.Label Label5 
  147.       Caption         =   "9920 Pacific Heights Blvd, Suite 200"
  148.       BeginProperty Font 
  149.          name            =   "Times New Roman"
  150.          charset         =   0
  151.          weight          =   400
  152.          size            =   12
  153.          underline       =   0   'False
  154.          italic          =   0   'False
  155.          strikethrough   =   0   'False
  156.       EndProperty
  157.       Height          =   252
  158.       Left            =   2040
  159.       TabIndex        =   11
  160.       Top             =   7200
  161.       Width           =   3612
  162.    End
  163.    Begin VB.Label Label4 
  164.       Alignment       =   2  'Center
  165.       AutoSize        =   -1  'True
  166.       Caption         =   "http://www.tgs.com"
  167.       BeginProperty Font 
  168.          name            =   "Times New Roman"
  169.          charset         =   0
  170.          weight          =   400
  171.          size            =   12
  172.          underline       =   0   'False
  173.          italic          =   0   'False
  174.          strikethrough   =   0   'False
  175.       EndProperty
  176.       Height          =   264
  177.       Left            =   2760
  178.       TabIndex        =   10
  179.       Top             =   6480
  180.       Width           =   1884
  181.    End
  182.    Begin VB.Label Label3 
  183.       Alignment       =   2  'Center
  184.       Caption         =   "Template Graphics Software, Inc."
  185.       BeginProperty Font 
  186.          name            =   "Times New Roman"
  187.          charset         =   0
  188.          weight          =   700
  189.          size            =   16.5
  190.          underline       =   0   'False
  191.          italic          =   0   'False
  192.          strikethrough   =   0   'False
  193.       EndProperty
  194.       Height          =   492
  195.       Left            =   1320
  196.       TabIndex        =   9
  197.       Top             =   6720
  198.       Width           =   4932
  199.    End
  200.    Begin VB.Label Label2 
  201.       Alignment       =   2  'Center
  202.       Caption         =   "For more information on this control and other TGS 3D/VRML desktop applications, contact:"
  203.       BeginProperty Font 
  204.          name            =   "Times New Roman"
  205.          charset         =   0
  206.          weight          =   400
  207.          size            =   12
  208.          underline       =   0   'False
  209.          italic          =   0   'False
  210.          strikethrough   =   0   'False
  211.       EndProperty
  212.       Height          =   732
  213.       Left            =   480
  214.       TabIndex        =   8
  215.       Top             =   5880
  216.       Width           =   6972
  217.    End
  218.    Begin VB.Label Label1 
  219.       Caption         =   "Web Hits By State"
  220.       BeginProperty Font 
  221.          name            =   "Times New Roman"
  222.          charset         =   0
  223.          weight          =   700
  224.          size            =   24
  225.          underline       =   0   'False
  226.          italic          =   0   'False
  227.          strikethrough   =   0   'False
  228.       EndProperty
  229.       Height          =   612
  230.       Left            =   240
  231.       TabIndex        =   6
  232.       Top             =   120
  233.       Width           =   4332
  234.    End
  235.    Begin TgsVisual3SpaceLibCtl.V3Space V3Space1 
  236.       Height          =   3732
  237.       Left            =   0
  238.       TabIndex        =   0
  239.       Top             =   1440
  240.       Width           =   7572
  241.       _Version        =   131072
  242.       _ExtentX        =   13356
  243.       _ExtentY        =   6583
  244.       _StockProps     =   0
  245.       decorationOn    =   0   'False
  246.       text3dBlue      =   0
  247.       text3dSpeedX    =   0
  248.       text3dSpeedZ    =   0
  249.       url             =   "examples\vb\vbStates2.0/models/usamap.wrl"
  250.    End
  251. Attribute VB_Name = "Form1"
  252. Attribute VB_Creatable = False
  253. Attribute VB_Exposed = False
  254. Const SCALE_MAX = 2#
  255. Dim aSensorCB
  256. Dim aSensor
  257. Dim states(50)
  258. Dim stateIndex
  259. Dim stopIndex
  260. Dim myReset
  261. Private Sub Command1_Click()
  262.     OnDay1
  263. End Sub
  264. Private Sub Command2_Click()
  265.     OnDay2
  266. End Sub
  267. Private Sub Command3_Click()
  268.     OnReset
  269. End Sub
  270. Private Sub Command4_Click()
  271.    Call V3Space1.EditHeadlight
  272. End Sub
  273. Private Sub Form_Load()
  274.     On Error Resume Next
  275.     Call InitStates
  276.     Dim idisp
  277.     Set idisp = V3Space1.GetIDispatch()
  278.     Set aSensorCB = New SoSensorCB
  279.     'sensor=0,alarm=1,timer=2,idle=3,oneShot=4,field=5,node=6,path=7
  280.     aSensorCB.sensorType = 3
  281.     Set aSensor = New SoIdleSensor
  282.     Call aSensor.setFunction(idisp, aSensorCB)
  283.     idisp = Null
  284.     myReset = False
  285.     Call V3Space1.Play("examples\vb\vbStates2.0\models\vbstates.wav", 4)
  286. End Sub
  287. Public Sub SetStateHeight(stateStr, newValue)
  288.     On Error Resume Next
  289.     Dim numFields
  290.     Dim coord
  291.     Dim vec3f
  292.     Dim aState
  293.     Dim theValue
  294.     Dim theStates
  295.     theValue = newValue / SCALE_MAX
  296.     Set theStates = V3Space1.getSceneRoot()
  297.     Set aState = theStates.getByName(stateStr)
  298.     'Get the top of the state
  299.     Dim Top
  300.     Set Top = aState.getChild(2)
  301.     'Get the Coordinates for the top
  302.     Set coord = Top.getChild(1)
  303.     numFields = coord.Point.getNum()
  304.     'Loop through the Coordinates
  305.     Dim i
  306.     Dim X
  307.     Dim Y
  308.     Dim Z
  309.     For i = numFields - 1 To 0 Step -1
  310.         Set vec3f = coord.Point.getAt(i)
  311.         'Call vec3f.getValue(X, Y, Z)
  312.         X = vec3f.getX()
  313.         Z = vec3f.getZ()
  314.         Call coord.Point.set1Value(i, X, theValue, Z)
  315.         Set vec3f = Nothing
  316.     Next i
  317.     'Clean Up
  318.     Set coord = Nothing
  319.     numFields = 0
  320.     'Set the size of the walls
  321.     Dim walls
  322.     Set walls = aState.getChild(3)
  323.     Set coord = walls.getChild(1)
  324.     numFields = coord.Point.getNum()
  325.     For i = numFields - 1 To (numFields / 2) Step -1
  326.         Set vec3f = coord.Point.getAt(i)
  327.         'Call vec3f.getValue(X, Y, Z)
  328.         X = vec3f.getX()
  329.         Z = vec3f.getZ()
  330.         Call coord.Point.set1Value(i, X, theValue, Z)
  331.         Set vec3f = Nothing
  332.     Next i
  333.   Set aState = Nothing
  334.   Set theStates = Nothing
  335. End Sub
  336. Public Sub InitStates()
  337.       
  338.   On Error Resume Next
  339.   states(1) = "ALABAMA"
  340.   states(2) = "ARKANSAS"
  341.   states(3) = "CONNECTICUT"
  342.   states(4) = "DELAWARE"
  343.   states(5) = "FLORIDA"
  344.   states(6) = "GEORGIA"
  345.   states(7) = "ILLINOIS"
  346.   states(8) = "INDIANA"
  347.   states(9) = "IOWA"
  348.   states(10) = "KENTUCKY"
  349.   '11
  350.   states(11) = "LOUISIANA"
  351.   states(12) = "MAINE"
  352.   states(13) = "MARYLAND"
  353.   states(14) = "MASSACHUSETTS"
  354.   states(15) = "MICHIGAN"
  355.   states(16) = "MICHIGAN_UPPER"
  356.   states(17) = "MINNESOTA"
  357.   states(18) = "MISSISSIPPI"
  358.   states(19) = "MISSOURI"
  359.   states(20) = "NEW_HAMPSHIRE"
  360.   '21
  361.   states(21) = "NEW_JERSEY"
  362.   states(22) = "NEW_YORK"
  363.   states(23) = "LONG_ISLAND"
  364.   states(24) = "NORTH_CAROLINA"
  365.   states(25) = "OHIO"
  366.   states(26) = "PENNSYLVANIA"
  367.   states(27) = "RHODE_ISLAND"
  368.   states(28) = "SOUTH_CAROLINA"
  369.   states(29) = "TENNESSEE"
  370.   states(30) = "VERMONT"
  371.   '31
  372.   states(31) = "VIRGINIA"
  373.   states(32) = "WEST_VIRGINIA"
  374.   states(33) = "WISCONSIN"
  375.   '34
  376.   states(34) = "WYOMING"
  377.   states(35) = "ARIZONA"
  378.   states(36) = "CALIFORNIA"
  379.   states(37) = "COLORADO"
  380.   states(38) = "IDAHO"
  381.   states(39) = "KANSAS"
  382.   states(40) = "MONTANA"
  383.   states(41) = "NEBRASKA"
  384.   states(42) = "NEVADA"
  385.   '43
  386.   states(43) = "NEW_MEXICO"
  387.   states(44) = "NORTH_DAKOTA"
  388.   states(45) = "OKLAHOMA"
  389.   states(46) = "OREGON"
  390.   states(47) = "SOUTH_DAKOTA"
  391.   states(48) = "TEXAS"
  392.   states(49) = "UTAH"
  393.   states(50) = "WASHINGTON"
  394. End Sub
  395. Public Sub OnDay1()
  396.     On Error Resume Next
  397.     If aSensor.isScheduled() = 1 Then
  398.         Call aSensor.unschedule
  399.     End If
  400.     Call V3Space1.Play("", -1)
  401.     Call V3Space1.Play("examples\vb\vbStates2.0\models\day1.wav", 4)
  402.     stateIndex = 1
  403.     stopIndex = 33
  404.     'window.status = "Computing Hits by State..."
  405.     myReset = False
  406.     Call aSensor.schedule
  407. End Sub
  408. Public Sub OnDay2()
  409.     On Error Resume Next
  410.     If aSensor.isScheduled = 1 Then
  411.         Call aSensor.unschedule
  412.     End If
  413.         
  414.     Call V3Space1.Play("examples\vb\vbStates2.0\models/day2.wav", 4)
  415.     stateIndex = 34
  416.     stopIndex = 50
  417.     'window.status = "Computing Hits by State..."
  418.     myReset = False
  419.     Call aSensor.schedule
  420. End Sub
  421. Public Sub OnReset()
  422.     On Error Resume Next
  423.     If aSensor.isScheduled Then
  424.         Call aSensor.unschedule
  425.     End If
  426.     myReset = True
  427.     stateIndex = 1
  428.     stopIndex = 50
  429.     'window.status = "Reseting..."
  430.     Call aSensor.schedule
  431. End Sub
  432. Public Sub thumbs()
  433.   If V3Space1.decorationOn = True Then
  434.     thumb.Caption = "Thumbwheels On"
  435.     V3Space1.decorationOn = False
  436.   Else
  437.     V3Space1.decorationOn = True
  438.     thumb.Caption = "Thumbwheels Off"
  439.   End If
  440. End Sub
  441. Private Sub Form_Terminate()
  442.     On Error Resume Next
  443.     If aSensor.isScheduled() = 1 Then
  444.         Call aSensor.unschedule
  445.     End If
  446.     Set aSensorCB = Nothing
  447.     Set aSensor = Nothing
  448.     Call V3Space1.Play("", -1)
  449.     Call V3Space1.deleteSceneGraph
  450. End Sub
  451. Private Sub thumbs_Click()
  452.     thumbs
  453. End Sub
  454. Private Sub thumb_Click()
  455.     thumbs
  456. End Sub
  457. Private Sub V3Space1_IdleSensor(ByVal sensorCB As Object, ByVal sensor As Object)
  458.     On Error Resume Next
  459.     If (myReset) Then
  460.         If (stateIndex <= stopIndex) Then
  461.             Call SetStateHeight(states(stateIndex), 0)
  462.             stateIndex = stateIndex + 1
  463.             Call aSensor.schedule
  464.         Else
  465.             'window.status = "Done."
  466.             myReset = False
  467.         End If
  468.         Exit Sub
  469.     End If
  470.     If stateIndex <= stopIndex Then
  471.         If stateIndex <= 33 Then
  472.             Call SetStateHeight(states(stateIndex), Rnd + 0.3)
  473.         Else
  474.             Call SetStateHeight(states(stateIndex), Rnd + 1#)
  475.         End If
  476.         stateIndex = stateIndex + 1
  477.         Call aSensor.schedule
  478.     Else
  479.         'window.status = "Done."
  480.     End If
  481. End Sub
  482.