[GraPhiX]

I got it working :) not 100% sure its clean but it works i have commented out the addhandler the mouse capture works but not sure why the addhandler causes grief

here is the conversion from C# class to VB.NET if anyone else can make use :)

Code:

'Imports System
'Imports System.Collections.Generic
'Imports System.ComponentModel
'Imports System.Data
'Imports System.Drawing
'Imports System.Linq
Imports System.Runtime.InteropServices
'Imports System.Text
Imports System.Windows
Imports System.Windows.Controls
Imports System.Windows.Forms
Imports System.Windows.Input
Imports System.Windows.Interop
Imports System.Windows.Media.Media3D
Imports Ab3d.Cameras
Imports Ab3d.Common.Cameras
Imports Ab3d.Common.EventManager3D
Imports Ab3d.Controls
Imports Ab3d.Utilities
Imports HorizontalAlignment = System.Windows.HorizontalAlignment
Imports System.Windows.Forms.Integration
Imports System.Windows.Media
'Imports MouseEventArgs = System.Windows.Forms.MouseEventArgs
'Imports Point = System.Drawing.Point


Partial Public Class FRM_3DViewer
    Inherits Form

    Private _viewport3D As Viewport3D
    Private _targetPositionCamera As TargetPositionCamera
    Private _mouseCameraController As MouseCameraController
    Private _rootGrid As Grid
    Private _eventManager3D As EventManager3D

    Dim _isSelectedBoxClicked As Boolean

    Dim _totalClickedHeight As Double

    Private _normalMaterial As DiffuseMaterial = New DiffuseMaterial(System.Windows.Media.Brushes.Silver)
    Private _selectedMaterial As DiffuseMaterial = New DiffuseMaterial(System.Windows.Media.Brushes.Orange)
    Private _clickedMaterial As DiffuseMaterial = New DiffuseMaterial(System.Windows.Media.Brushes.Red)

    Public Sub New()

        InitializeComponent()
        SetUpWpf3D()
        Setup3DObjects()

        MouseWheelMessageFilter.RegisterMouseWheelHandling(_rootGrid)


    End Sub

    Private Sub Setup3DObjects()
        Me._eventManager3D = New EventManager3D(Me._viewport3D)
        Dim visuald1 As New Ab3d.Visuals.WireGridVisual3D
        visuald1.Size = New Size(1000, 1000)
        visuald1.HeightCellsCount = 10
        visuald1.WidthCellsCount = 10
        visuald1.LineThickness = 3
        Dim visuald As Ab3d.Visuals.WireGridVisual3D = visuald1
        Me._viewport3D.Children.Add(visuald)
        Dim num As Integer = -3
        Do While True
            If (num > 3) Then
                Me.ToggleCameraAnimation()
                Return
            End If
            Dim num2 As Integer = -3
            Do While True
                If (num2 > 3) Then
                    num += 1
                    Exit Do
                End If
                Dim y As Double = ((5 - Math.Sqrt(CDbl(((num2 * num2) + (num * num))))) * 60)
                Dim visuald3 As New Ab3d.Visuals.BoxVisual3D
                visuald3.CenterPosition = New Point3D(CDbl((num2 * 100)), (y / 2), CDbl((num * 100)))
                visuald3.Size = New Size3D(80, y, 80)
                visuald3.Material = Me._normalMaterial
                Dim visuald2 As Ab3d.Visuals.BoxVisual3D = visuald3
                Me._viewport3D.Children.Add(visuald2)
                Dim eventSource As New VisualEventSource3D(visuald2)
                AddHandler eventSource.MouseEnter, New Mouse3DEventHandler(AddressOf Me.BoxOnMouseEnter)
                AddHandler eventSource.MouseLeave, New Mouse3DEventHandler(AddressOf Me.BoxOnMouseLeave)
                AddHandler eventSource.MouseClick, New MouseButton3DEventHandler(AddressOf Me.BoxOnMouseClick)
                Me._eventManager3D.RegisterEventSource3D(eventSource)
                num2 += 1
            Loop
        Loop

        ToggleCameraAnimation()
    End Sub
    Private Sub BoxOnMouseEnter(ByVal sender As Object, ByVal mouse3DEventArgs As Mouse3DEventArgs)
        Dim boxVisual3D = TryCast(mouse3DEventArgs.HitObject, Ab3d.Visuals.BoxVisual3D)
        If boxVisual3D Is Nothing Then Return
        _isSelectedBoxClicked = ReferenceEquals(boxVisual3D.Material, _clickedMaterial)
        boxVisual3D.Material = _selectedMaterial
    End Sub
    Private Sub BoxOnMouseLeave(ByVal sender As Object, ByVal mouse3DEventArgs As Mouse3DEventArgs)
        Dim boxVisual3D = TryCast(mouse3DEventArgs.HitObject, Ab3d.Visuals.BoxVisual3D)
        If boxVisual3D Is Nothing Then Return

        If _isSelectedBoxClicked Then
            boxVisual3D.Material = _clickedMaterial
        Else
            boxVisual3D.Material = _normalMaterial
        End If
    End Sub

    Private Sub BoxOnMouseClick(ByVal sender As Object, ByVal mouseButton3DEventArgs As MouseButton3DEventArgs)
        Dim boxVisual3D = TryCast(mouseButton3DEventArgs.HitObject, Ab3d.Visuals.BoxVisual3D)
        If boxVisual3D Is Nothing Then Return

        If Not _isSelectedBoxClicked Then
            boxVisual3D.Material = _clickedMaterial
            _isSelectedBoxClicked = True
            _totalClickedHeight += boxVisual3D.Size.Y
        Else
            boxVisual3D.Material = _normalMaterial
            _isSelectedBoxClicked = False
            _totalClickedHeight -= boxVisual3D.Size.Y
        End If

    End Sub
    Private Sub SetUpWpf3D()

        _rootGrid = New Grid()
        _rootGrid.Background = System.Windows.Media.Brushes.White
        _viewport3D = New Viewport3D()
        _rootGrid.Children.Add(_viewport3D)

        _targetPositionCamera = New Ab3d.Cameras.TargetPositionCamera()
        With _targetPositionCamera
            .TargetPosition = New Point3D(0, 0, 0)
            .Distance = 1300
            .Heading = 30
            .Attitude = -20
            .ShowCameraLight = ShowCameraLightType.Always
            .TargetViewport3D = _viewport3D
        End With
        _rootGrid.Children.Add(_targetPositionCamera)

        _mouseCameraController = New Ab3d.Controls.MouseCameraController()
        With _mouseCameraController
            .RotateCameraConditions = MouseCameraController.MouseAndKeyboardConditions.RightMouseButtonPressed
            .MoveCameraConditions = MouseCameraController.MouseAndKeyboardConditions.RightMouseButtonPressed Or MouseCameraController.MouseAndKeyboardConditions.ControlKey
            .EventsSourceElement = _rootGrid
            .TargetCamera = _targetPositionCamera
        End With
        _rootGrid.Children.Add(_mouseCameraController)

        Dim cameraControlPanel = New Ab3d.Controls.CameraControlPanel()
        With cameraControlPanel
            .VerticalAlignment = VerticalAlignment.Bottom
            .HorizontalAlignment = HorizontalAlignment.Right
            .Margin = New Thickness(5, 5, 5, 5)
            .Width = 225
            .Height = 75
            .ShowMoveButtons = True
            .TargetCamera = _targetPositionCamera
        End With
        _rootGrid.Children.Add(cameraControlPanel)
        ElementHost1.Child = _rootGrid
    End Sub


    Private Sub BTN_animateButton_Click(sender As Object, e As EventArgs) Handles BTN_animateButton.Click
        ToggleCameraAnimation()

    End Sub
    Private Sub ToggleCameraAnimation()
        If _targetPositionCamera.IsRotating Then
            _targetPositionCamera.StopRotation()
            BTN_animateButton.Text = "Start animation"
        Else
            _targetPositionCamera.StartRotation(10, 0)
            BTN_animateButton.Text = "Stop animation"
        End If
    End Sub


    Public Class MouseWheelMessageFilter
        Implements IMessageFilter

        Private Const WM_MOUSEWHEEL As Integer = &H20A
        Private _element As FrameworkElement
        Private sender As Object
        Private args As Object

        Private Sub New(ByVal element As FrameworkElement)
            Me._element = element

            'AddHandler Me._element.Loaded, (sender, args) >= Application.AddMessageFilter(Me)
            'AddHandler Me._element.Unloaded, (sender, args) >= Application.RemoveMessageFilter(Me)
        End Sub



        Public Shared Sub RegisterMouseWheelHandling(ByVal element As FrameworkElement)
            Dim filter As New MouseWheelMessageFilter(element)
        End Sub

        <DllImport("user32.dll")>
        Private Shared Function SendMessage(ByVal hWnd As IntPtr, ByVal Msg As Integer, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As Integer
        End Function

        Public Function IMessageFilter_PreFilterMessage(ByRef m As Message) As Boolean Implements IMessageFilter.PreFilterMessage
            Dim flag2 As Boolean
            If Me._element.IsVisible Then
                If (m.Msg = &H20A) Then
                    Dim rect As New Rect(0, 0, Me._element.ActualWidth, Me._element.ActualHeight)
                    If rect.Contains(Mouse.GetPosition(Me._element)) Then
                        MouseWheelMessageFilter.SendMessage(DirectCast(PresentationSource.FromVisual(Me._element), HwndSource).Handle, m.Msg, m.WParam, m.LParam)
                        Return True
                    End If
                End If
                flag2 = False
            Else
                flag2 = False
            End If
            Return flag2
        End Function
    End Class



End Class