VERSION 5.00
Object = "{34F681D0-3640-11CF-9294-00AA00B8A733}#1.0#0"; "danim.dll"
Begin VB.Form Picking 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Picking"
   ClientHeight    =   4665
   ClientLeft      =   30
   ClientTop       =   270
   ClientWidth     =   5055
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4665
   ScaleWidth      =   5055
   StartUpPosition =   3  'Windows Default
   Begin DirectAnimationCtl.DAViewerControlWindowed DAViewerControlWindowed 
      Height          =   4455
      Left            =   120
      OleObjectBlob   =   "Pick3.frx":0000
      TabIndex        =   0
      Top             =   120
      Width           =   4815
   End
End
Attribute VB_Name = "Picking"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'Pick3 Visual Basic Sample
Private Sub Form_Load()
  pi = 3.1459

  Dim size As DATransform3
  Set size = Scale3Uniform(0.25)

  Dim speed As DANumber
  Set speed = DANumber(0.07)
  
  ' Set up relative paths for media imports.  Does not work in VB
  ' debug.  Create executable.
  Dim mediaBase, geoBase, imgBase As String
  mediaBase = CurDir + "\..\..\..\..\..\Media\"
  geoBase = mediaBase + "geometry\"
  imgBase = mediaBase + "image\"
  
  'Import the geometries.
  Dim rawCube As DAGeometry
  Set rawCube = ImportGeometry(geoBase + "cube.x").Transform(size)
  
  Dim rawCylinder As DAGeometry
  Set rawCylinder = ImportGeometry(geoBase + "cylinder.x").Transform(size)
  
  Dim rawCone As DAGeometry
  Set rawCone = ImportGeometry(geoBase + "cone.x").Transform(size)
  
  'Import background.
  Dim stillSky As DAImage
  Set stillSky = ImportImage(imgBase + "cldtile.jpg")
  
  'Make the geometries pickable.
  Set cone1 = activate(rawCone, Green)
  Set cube1 = activate(rawCube, Magenta)
  Set cube2 = activate(rawCube, ColorHslAnim(Div(LocalTime, DANumber(8)), DANumber(1), DANumber(0.5)))
  Set cylinder = activate(rawCylinder, ColorRgb(0.8, 0.4, 0.4))
  
  'Construct the final geometry, scale and rotate it.
  Set multigeo = UnionGeometry(cone1.Transform(Translate3(0, 1, 0)), _
    UnionGeometry(cube1.Transform(Translate3(0, 0, 1)), _
    UnionGeometry(cube2.Transform(Translate3(0, 0, -1)), cylinder)))
    
  Set X = Add(DAStatics.Abs(DAStatics.Sin(Mul(LocalTime, _
    DANumber(0.2)))), DANumber(0.5))
  Set Y = Add(DAStatics.Abs(DAStatics.Sin(Mul(LocalTime, _
    DANumber(0.26)))), DANumber(0.5))
  Set Z = Add(DAStatics.Abs(DAStatics.Sin(Mul(LocalTime, _
    DANumber(0.14)))), DANumber(0.5))
     
  Set geo = multigeo.Transform(Scale3Anim(X, Y, Z))

  Set maxSky = stillSky.BoundingBox().Max()
  
  Set tiledSky = stillSky.Tile()
  Set movingSky = tiledSky.Transform(Translate2Anim(Mul(LocalTime, _
    Div(maxSky.X, DANumber(8))), Mul(LocalTime, Div(maxSky.X, DANumber(16)))))

  Set movingGeoImg = geometryImage(geo.Transform(Compose3(Rotate3Anim(ZVector3, _
    Mul(speed, Mul(LocalTime(), DANumber(1.9)))), _
      Rotate3Anim(YVector3, Mul(speed, Mul(LocalTime(), DANumber(pi)))))), speed)
  
  Set fs = DefaultFont.size(14).Color(Black)
  Set titleIm = StringImage("Left Click on an Object", fs).Transform(Translate2(0, 0.04))
    
  DAViewerControlWindowed.UpdateInterval = 0.2
  
  'Display the final image.
  DAViewerControlWindowed.Image = Overlay(titleIm, Overlay(movingGeoImg, movingSky))
  
  'Start the animation.
  DAViewerControlWindowed.Start
End Sub

Function activate(unpickedGeo As DAGeometry, col As DAColor) As DAGeometry
  Dim pickGeo As DAPickableResult
  Set pickGeo = unpickedGeo.Pickable()
  
  Dim pickEvent As DAEvent
  Set pickEvent = AndEvent(LeftButtonDown, pickGeo.pickEvent)
  
  Dim numcyc As DANumber
  Set numcyc = CreateObject("DirectAnimation.DANumber")
  numcyc.Init DAStatics.Until(DANumber(0), pickEvent, DAStatics.Until(DANumber(1), pickEvent, numcyc))
  
  Dim colcyc As DAColor
  Set colcyc = CreateObject("DirectAnimation.DAColor")
  colcyc.Init DAStatics.Until(White, pickEvent, DAStatics.Until(col, pickEvent, colcyc))

  Dim xf As DATransform3
  Set xf = Rotate3Anim(XVector3, Integral(numcyc))
  
  Set activate = pickGeo.Geometry.DiffuseColor(colcyc).Transform(xf)
End Function
Function geometryImage(geo As DAGeometry, speed As DANumber) As DAImage
  Dim scaleFactor As DANumber
  Set scaleFactor = DANumber(0.02)
  
  Dim perspTransform As DATransform3
  Set perspTransform = CreateObject("DirectAnimation.DATransform3")
    perspTransform.Init DAStatics.Until(Compose3(Rotate3Anim(XVector3, _
      Mul(speed, LocalTime)), Translate3(0, 0, 0.2)), RightButtonDown, _
        DAStatics.Until(Rotate3Anim(XVector3, Mul(speed, LocalTime)), _
          RightButtonDown, perspTransform))

  Set light = UnionGeometry(DirectionalLight.Transform(perspTransform), _
    DirectionalLight)
    
  Dim strcyl As DAString
  Set strcyl = CreateObject("DirectAnimation.DAString")
  strcyl.Init DAStatics.Until(DAString("Perspective - Right Click to Switch"), _
    RightButtonDown, DAStatics.Until(DAString("Parallel - Right Click to Switch"), _
      RightButtonDown, strcyl))
      
  Dim perspectiveCam As DACamera
  Set perspectiveCam = PerspectiveCamera(1, 0).Transform(Compose3(Rotate3Anim(XVector3, _
    Mul(speed, LocalTime)), Translate3(0, 0, 0.2)))

  Dim parallelCam As DACamera
  Set parallelCam = ParallelCamera(1).Transform(Rotate3Anim(XVector3, _
    Mul(speed, LocalTime)))
  
  Dim camera As DACamera
  Set camera = CreateObject("DirectAnimation.DACamera")
  camera.Init DAStatics.Until(perspectiveCam, RightButtonDown, _
    DAStatics.Until(parallelCam, RightButtonDown, camera))
  
  Dim fs As DAFontStyle
  Set fs = DefaultFont.size(14).Color(Red)
  
  Dim txtIm, xltTxt As DAImage
  Set txtIm = StringImageAnim(strcyl, fs)
  Set xltTxt = txtIm.Transform(Translate2(0, -0.045))
    
  Set geometryImg = UnionGeometry(geo.Transform(Scale3UniformAnim(scaleFactor)), _
    light).Render(camera)
  
  Set geometryImage = Overlay(xltTxt, geometryImg)
End Function