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 relative paths for the bin\visualbasic directory.
  Dim mediaBase, geoBase, imgBase As String
  
  'Find out if your are in the bin directory of the SDK,
  'and append the path accordingly.
  strBin = "bin"
  binPos = InStr(1, CurDir, strBin)
  If (binPos > 0) Then
    mediaBase = CurDir + "\..\..\..\Media\"
  Else
    mediaBase = CurDir + "\..\..\..\..\Media\"
  End If

  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 IDAPickableResult
  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