Using Visual Basic 5 (Platinum Edition)/vb5.iso/ACTIVEX/VIS3SPAC/DATA.9/examples/vb/10_01AddEventCB/10_1AddEventCB.frm

Visual Basic Form | 1996-11-14 | 8.7 KB | 253 lines

VERSION 4.00
Begin VB.Form Form1
   Caption         =   "10_01 Keyboard Event Callback"
   ClientHeight    =   5415
   ClientLeft      =   1140
   ClientTop       =   1425
   ClientWidth     =   10530
   Height          =   5790
   Left            =   1080
   LinkTopic       =   "Form1"
   ScaleHeight     =   5415
   ScaleWidth      =   10530
   Top             =   1110
   Width           =   10650
   Begin VB.Label keyText
      Alignment       =   2  'Center
      BeginProperty Font
         name            =   "MS Sans Serif"
         charset         =   0
         weight          =   700
         size            =   13.5
         underline       =   0   'False
         italic          =   0   'False
         strikethrough   =   0   'False
      EndProperty
      Height          =   855
      Left            =   120
      TabIndex        =   3
      Top             =   4320
      Width           =   3855
   End
   Begin VB.Label Label2
      Caption         =   $"10_1AddEventCB.frx":0000
      BeginProperty Font
         name            =   "MS Sans Serif"
         charset         =   0
         weight          =   400
         size            =   12
         underline       =   0   'False
         italic          =   0   'False
         strikethrough   =   0   'False
      EndProperty
      Height          =   1815
      Left            =   120
      TabIndex        =   2
      Top             =   2280
      Width           =   3735
   End
   Begin VB.Label Label1
      Caption         =   $"10_1AddEventCB.frx":0096
      BeginProperty Font
         name            =   "MS Sans Serif"
         charset         =   0
         weight          =   400
         size            =   12
         underline       =   0   'False
         italic          =   0   'False
         strikethrough   =   0   'False
      EndProperty
      Height          =   1935
      Left            =   120
      TabIndex        =   1
      Top             =   240
      Width           =   3975
   End
   Begin TgsVisual3SpaceLibCtl.V3Space V3Space1
      Height          =   5415
      Left            =   4200
      TabIndex        =   0
      Top             =   0
      Width           =   6375
      _Version        =   131072
      _ExtentX        =   11245
      _ExtentY        =   9551
      _StockProps     =   0
      decorationOn    =   0   'False
      viewingOn       =   0   'False
      selectionEnable =   -1  'True
   End
Attribute VB_Name = "Form1"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
    Dim cube As SoCube
    Dim sphere As SoSphere
    Dim cone As SoCone
    Dim cylinder As SoCylinder
    Dim cubeTransform As SoTransform
    Dim sphereTransform As SoTransform
    Dim coneTransform As SoTransform
    Dim cylTransform As SoTransform
Private Sub Form_Initialize()
    On Error Resume Next
    Dim selectionRoot As SoSelection
    Set selectionRoot = V3Space1.getSceneRoot
    'Add an event callback to catch mouse button presses.
    'The callback is set up later on.
    Dim myEventCB As SoEventCallback
    Set myEventCB = New SoEventCallback
    Call selectionRoot.addChild(myEventCB)
    'Add some geometry to the scene
    'a red cube
    Dim cubeRoot As SoSeparator
    Set cubeRoot = New SoSeparator
    Dim cubeMaterial As SoMaterial
    Set cubeMaterial = New SoMaterial
    Set cubeTransform = New SoTransform
    Call cubeRoot.addChild(cubeTransform)
    Call cubeRoot.addChild(cubeMaterial)
    Set cube = New SoCube
    Call cubeRoot.addChild(cube)
    Call cubeTransform.translation.setValue(-2, 2, 0)
    Call cubeMaterial.diffuseColor.setValue(0.8, 0, 0)
    Call selectionRoot.addChild(cubeRoot)
    'a blue sphere
    Dim sphereRoot As SoSeparator
    Set sphereRoot = New SoSeparator
    Dim sphereMaterial As SoMaterial
    Set sphereMaterial = New SoMaterial
    Set sphereTransform = New SoTransform
    Call sphereRoot.addChild(sphereTransform)
    Call sphereRoot.addChild(sphereMaterial)
    Set sphere = New SoSphere
    Call sphereRoot.addChild(sphere)
    Call sphereTransform.translation.setValue(2, 2, 0)
    Call sphereMaterial.diffuseColor.setValue(0, 0, 0.8)
    Call selectionRoot.addChild(sphereRoot)
    'a green cone
    Dim coneRoot As SoSeparator
    Set coneRoot = New SoSeparator
    Dim coneMaterial As SoMaterial
    Set coneMaterial = New SoMaterial
    Set coneTransform = New SoTransform
    Call coneRoot.addChild(coneTransform)
    Call coneRoot.addChild(coneMaterial)
    Set cone = New SoCone
    Call coneRoot.addChild(cone)
    Call coneTransform.translation.setValue(2, -2, 0)
    Call coneMaterial.diffuseColor.setValue(0, 0.8, 0)
    Call selectionRoot.addChild(coneRoot)
    'a magenta cylinder
    Dim cylRoot As SoSeparator
    Set cylRoot = New SoSeparator
    Dim cylMaterial As SoMaterial
    Set cylMaterial = New SoMaterial
    Set cylTransform = New SoTransform
    Call cylRoot.addChild(cylTransform)
    Call cylRoot.addChild(cylMaterial)
    Set cylinder = New SoCylinder
    Call cylRoot.addChild(cylinder)
    Call cylTransform.translation.setValue(-2, -2, 0)
    Call cylMaterial.diffuseColor.setValue(0.8, 0, 0.8)
    Call selectionRoot.addChild(cylRoot)
    Call V3Space1.viewAll
    Static eCB As SoEventCallbackCB
    Set eCB = New SoEventCallbackCB
    'keyboard
    eCB.nType = 3
    Set eCB.userDataObject = V3Space1.getSceneRoot
    Dim idisp As Object
    Set idisp = V3Space1.GetIDispatch
    Call myEventCB.addEventCallback(idisp, eCB)
    Call V3Space1.viewAll
    Set idisp = Nothing
    Set selectionRoot = Nothing
    Set cubeRoot = Nothing
    Set coneRoot = Nothing
    Set sphereRoot = Nothing
    Set cylRoot = Nothing
    Set cubeMaterial = Nothing
    Set coneMaterial = Nothing
    Set sphereMaterial = Nothing
    Set cylMaterial = Nothing
End Sub
Private Sub Form_Terminate()
    Set cube = Nothing
    Set cone = Nothing
    Set cylinder = Nothing
    Set cubeTransform = Nothing
    Set sphereTransform = Nothing
    Set coneTransform = Nothing
    Set cylTransform = Nothing
End Sub
Private Sub V3Space1_KeyboardEvent(ByVal eventCallbackCB As Object, ByVal eventCallback As Object)
    On Error Resume Next
    Dim ev As SoKeyboardEvent
    Set ev = eventCallback.getEvent()
    Dim key As Long
    key = ev.getKey()
    keyText.Caption = "Key Pressed: " + ev.getPrintableCharacter()
    If key <> 65362 And key <> 65364 Then
        GoTo cleanup
    End If
    If key = 65362 Then
        Call myScaleSelection(eventCallbackCB.userDataObject, 1.1)
        keyText.Caption = "Key Pressed: shift-up arrow"
    Else
        Call myScaleSelection(eventCallbackCB.userDataObject, 0.9)
        keyText.Caption = "Key Pressed: shift-down arrow"
    End If
cleanup:
    Set ev = Nothing
    Set eventCallbackCB = Nothing
    Set eventCallback = Nothing
End Sub
Public Sub myScaleSelection(selection As SoSelection, sf As Single)
    On Error Resume Next
    Dim selectedPath As SoPath
    Dim xform As SoTransform
    Dim scaleFactor As SbVec3f
    Dim i As Integer
    Dim j As Integer
    'Scale each object in the selection list
    Dim selCnt As Long
    Dim selLen As Long
    selCnt = selection.getNumSelected()
    For i = 0 To selCnt - 1
        Set selectedPath = selection.getPath(i)
        Set xform = Nothing
        'Look for the shape node, starting from the tail of the
        'path.  Once we know the type of shape, we know which
        'transform to modify
        selLen = selectedPath.getLength()
        Dim n As Object
        For j = 0 To selLen - 1
            Set n = selectedPath.getNodeFromTail(j)
            If n.isOfType(cube.getClassTypeId()) Then
                Set xform = cubeTransform
                Exit For
            ElseIf n.isOfType(sphere.getClassTypeId()) Then
                Set xform = sphereTransform
                Exit For
            ElseIf n.isOfType(cylinder.getClassTypeId()) Then
                Set xform = cylTransform
                Exit For
            ElseIf n.isOfType(cone.getClassTypeId()) Then
                Set xform = coneTransform
                Exit For
            End If
            Set n = Nothing
        Next j
        Set n = Nothing
        'Apply the scale
        If Not (xform Is Nothing) Then
            Set scaleFactor = xform.scaleFactor.getValueVec()
            Call scaleFactor.multiplyScalar(sf)
            Call xform.scaleFactor.setValueVec3f(scaleFactor)
            Set scaleFactor = Nothing
            Set xform = Nothing
        End If
        Set selectedPath = Nothing
    Next i
End Sub