VB Silverlight

概述Imports Microsoft.Xna.Framework.ContentImports Microsoft.Xna.Framework.GraphicsImports Microsoft.Xna.FrameworkImports System.Windows.GraphicsPartial Public Class MainPage Inherits UserControl

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


                     

总结

以上是内存溢出为你收集整理的VB Silverlight全部内容，希望文章能够帮你解决VB Silverlight所遇到的程序开发问题。

如果觉得内存溢出网站内容还不错，欢迎将内存溢出网站推荐给程序员好友。