Imports Microsoft.Xna.Framework.ContentImports Microsoft.Xna.Framework.GraphicsImports Microsoft.Xna.FrameworkImports System.Windows.GraphicsPartial 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, 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, 0, -speed) Case Key.S direction = New Vector3(0, 0, speed) Case Key.A direction = New Vector3(-speed, 0, 0) Case Key.D direction = New Vector3(speed, 0, 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.Y + cameraTarget.Y, direction.Z + cameraTarget.Z) End If End SubEnd 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, 0, 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
