VB Silverlight

Imports Microsoft.Xna.Framework.Content
Imports Microsoft.Xna.Framework.Graphics
Imports Microsoft.Xna.Framework
Imports System.Windows.Graphics

Partial Public Class MainPage
    Inherits UserControl

    Public Sub New()
        InitializeComponent()
    End Sub

    Dim contentManager As ContentManager
    Dim spriteBatch As SpriteBatch
    Dim cameraPositon As Vector3 = New Vector3(0,16.0F,11.0F)
    Dim cameraTarget As Vector3 = New Vector3(0,3.0F,-2.0F)
    Dim cameraUpVector As Vector3 = New Vector3(0,19.0F,11.0F)
    Dim mouseCaptured As Boolean
    Dim originalPosition As Vector2?
    Dim model As Model
    Dim graphicsDevice As GraphicsDevice
    Dim speed As Double = 0.1F


    Private Sub myDrawingSurface_MouseLeftButtonDown(sender As System.Object,e As System.Windows.Input.MouseButtonEventArgs)
        Focus()
        Dim location As System.Windows.Point = e.GetPosition(myDrawingSurface)
        Dim rectangle As Rect = New Rect(0,myDrawingSurface.RenderSize.Width,myDrawingSurface.RenderSize.Height)
        If (rectangle.Contains(location)) Then
            mouseCaptured = True
            HandleMouseDown(New Vector2(CDbl(location.X),CDbl(location.Y)))
        End If
    End Sub

    Public Sub HandleMouseDown(ByVal position As Vector2)
        originalPosition = position
    End Sub

    Public Sub HandleMouseMove(ByVal position As Vector2)
        If (Not originalPosition.HasValue) Then
            originalPosition = position
        End If
        Dim diff As Vector2 = (originalPosition.Value - position)
        If diff = Vector2.Zero Then
            Return
        End If
        If diff.X = 0 Then
            Dim side As Integer = 0
            If position.X = 0 Then
                side = -1
            ElseIf position.X = myDrawingSurface.RenderSize.Width - 1 Then
                side = 1
            End If
            diff.X -= 20 * side
        End If
        diff *= 0.004F
        cameraTarget -= New Vector3(diff.X,cameraTarget.Y,cameraTarget.Z)
        originalPosition = position
    End Sub

    Private Sub myDrawingSurface_MouseLeftButtonUp(sender As System.Object,e As System.Windows.Input.MouseButtonEventArgs)
        If (mouseCaptured) Then
            mouseCaptured = False
        End If
    End Sub

    Private Sub myDrawingSurface_MouseMove(sender As System.Object,e As System.Windows.Input.MouseEventArgs)
        If (mouseCaptured) Then
            Dim location As System.Windows.Point = e.GetPosition(myDrawingSurface)
            HandleMouseMove(New Vector2(CDbl(location.X),CDbl(location.Y)))
        End If
    End Sub

    Private Sub myDrawingSurface_KeyUp(sender As System.Object,e As System.Windows.Input.KeyEventArgs)

    End Sub

    Private Sub myDrawingSurface_Loaded(sender As System.Object,e As System.Windows.RoutedEventArgs)
        graphicsDevice = GraphicsDeviceManager.Current.GraphicsDevice
        Dim contentManager As ContentManager = New ContentManager(Nothing,"Content/Searching3DContent")
        spriteBatch = New SpriteBatch(graphicsDevice)
        model = contentManager.Load(Of Model)("Searching")
    End Sub

    Private Sub myDrawingSurface_Draw(sender As System.Object,e As System.Windows.Controls.DrawEventArgs)
        graphicsDevice = GraphicsDeviceManager.Current.GraphicsDevice
        graphicsDevice.Clear(Color.Black)
        spriteBatch = New SpriteBatch(graphicsDevice)
        spriteBatch.Begin(0,BlendState.AlphaBlend)
        spriteBatch.End()
        graphicsDevice.DepthStencilState = DepthStencilState.Default
        DrawModels(graphicsDevice,model)
        e.InvalidateSurface()
    End Sub

    Public Sub DrawModels(ByVal graphicsDevice As GraphicsDevice,ByVal models As Model)
        Dim transforms = New Matrix(models.Bones.Count) {}
        models.CopyAbsoluteBoneTransformsTo(transforms)
        For Each mesh As ModelMesh In models.Meshes
            For Each effect As BasicEffect In mesh.Effects
                effect.World = transforms(mesh.ParentBone.Index)
                effect.View = Matrix.CreateLookAt(cameraPositon,cameraTarget,cameraUpVector)
                effect.Projection = Matrix.CreatePerspectiveFieldOfView(MathHelper.Pi / 3.3F,graphicsDevice.Viewport.AspectRatio,1,1000)
                effect.EnableDefaultLighting()
                effect.SpecularColor = Vector3.One
            Next
            mesh.Draw()
        Next
    End Sub

    Private Sub myDrawingSurface_KeyDown(sender As System.Object,e As System.Windows.Input.KeyEventArgs)
        Dim direction As Vector3 = Vector3.Zero
        Select Case e.Key
            Case Key.W
                direction = New Vector3(0,-speed)
            Case Key.S
                direction = New Vector3(0,speed)
            Case Key.A
                direction = New Vector3(-speed,0)
            Case Key.D
                direction = New Vector3(speed,0)
        End Select
        If direction <> Vector3.Zero Then
            cameraTarget = New Vector3(direction.X + cameraTarget.X,direction.Y + cameraTarget.Y,direction.Z + cameraTarget.Z)
            cameraPositon = New Vector3(direction.X + cameraPositon.X,direction.Y + cameraPositon.Y,direction.Z + cameraPositon.Z)
        End If
    End Sub

    Private Sub myDrawingSurface_MouseWheel(sender As System.Object,e As System.Windows.Input.MouseWheelEventArgs)
        Dim direction As Vector3 = Vector3.Zero
        If e.Delta > 0 Then
            direction = New Vector3(0,-speed,-speed)
        Else
            direction = New Vector3(0,speed,speed)
        End If
        If direction <> Vector3.Zero Then
            cameraTarget = New Vector3(direction.X + cameraTarget.X,direction.Z + cameraTarget.Z)
        End If
    End Sub
End Class

 
    ''' <summary>
    ''' 获取模型资源
    ''' </summary>
    ''' <param name="obj"></param>
    ''' <param name="args"></param>
    ''' <remarks></remarks>
    Private Sub wb_OpenReadCompleted(obj As Object,args As OpenReadCompletedEventArgs)
        NewSearchingContent = New SearchingContentManager(Nothing,"Content/")
        graphicsDevice = GraphicsDeviceManager.Current.GraphicsDevice
        '添加Source资源
        Dim modelsDic As New Dictionary(Of String,Dictionary(Of String,Byte()))
        For Each modelNames As String In Source.Split(",")
            Dim modelsDicName As String = modelNames.Split("|")(0)

            For Each modelName As String In modelNames.Split("|")
                Dim modelDic As Dictionary(Of String,Byte()) = GetModelDictionary(args.Result,modelName)
                If Not modelsDic.ContainsKey(modelsDicName) Then modelsDic.Add(modelsDicName,modelDic)
            Next
            '读取完成加载模型
            NewSearchingContent.newModelByte = modelsDic
            listModel.Add(searchingContent.Load(Of Model)(modelsDicName))
        Next

        
    End Sub

    ''' <summary>
    ''' 获取模型资源字典
    ''' </summary>
    ''' <param name="result">资源包流文件</param>
    ''' <param name="modelName">模型名称</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Private Function GetModelDictionary(ByVal result As Stream,ByVal modelName As String) As Dictionary(Of String,Byte())
        Dim xap As StreamResourceInfo = New Windows.Resources.StreamResourceInfo(result,Nothing)
        Dim modelStream As Stream = Application.GetResourceStream(xap,New Uri(modelName,UriKind.Relative)).Stream

        'Stream转换为bytes()
        Dim modelBytes() As Byte = New Byte(modelStream.Length) {}
        modelStream.Read(modelBytes,modelBytes.Length)
        modelStream.Seek(0,SeekOrigin.Begin)

        Dim dic As New Dictionary(Of String,Byte())
        dic.Add(modelName,modelBytes)
        Return dic
    End Function

    Dim wb As New WebClient()

    Private Sub ModelEx_Loaded(ByVal sender As Object,ByVal e As System.Windows.RoutedEventArgs) Handles Me.Loaded
        wb.OpenReadAsync(New Uri("SilverlightModel.xap",UriKind.Relative))
        AddHandler wb.OpenReadCompleted,AddressOf wb_OpenReadCompleted
    End Sub







 
 

  
  ??
 
 
    
        
 

（编辑：李大同）

【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容!