Find Code:
All Words
Any of the Words
Exact Phrase
Home
:
Code
:
Forums
:
Submit
:
Mailing List
:
About
:
Contact
Code
All
VB.NET
ASP.NET
C#
VB Classic
ASP Classic
Snippets
Popular
Resources
Submit Code
Forums
Articles
Tips
Links
Books
Contest
Link to us
Xna Refresh in Visual Basic
Author:
Michel Renaud
Submitted:
5/27/2012
Version:
VB 2010
Compatibility:
VB 2010
Category:
Graphics
Views:
5610
A 2d scrolling text draw on bitmap with Xna Engine on A window form.
Declarations:
Imports System Imports Microsoft.Xna.Framework Imports Microsoft.Xna.Framework.Audio Imports Microsoft.Xna.Framework.Content Imports Microsoft.Xna.Framework.GamerServices Imports Microsoft.Xna.Framework.Graphics Imports Microsoft.Xna.Framework.Input Imports Microsoft.Xna.Framework.Media
Code:
Public Class Form1 Dim x, y, dx, dy As Integer Dim r As New Random Dim MemStream As System.IO.MemoryStream = New System.IO.MemoryStream() 'set aside a portion of memory to hold the bitmap Dim Device As Microsoft.Xna.Framework.Graphics.GraphicsDevice = Nothing 'A couple of Global objects that will be set using the WriteText Sub below and run from the Render loop Dim SB As SpriteBatch = Nothing Dim Tex2d As Texture2D = Nothing 'needed for mesurestring -used for scrolling Dim StringSize As SizeF Dim Bmp As Bitmap Dim vec As Vector2 'The Sub that will create and define the necessary objects and variables Public Sub WriteText(ByVal str As String, ByVal FontName As String, ByVal FontSize As Single, ByVal _FontStyle As FontStyle, _ ByVal StringColour As Brush, ByVal BitmapXPos As Single, ByVal BitmapYPos As Single, ByRef Texture1 As Texture2D, ByRef Vector1 As Vector2) Dim NewFont As Font = New Font(FontName, FontSize, _FontStyle) ' The font that the text will be written in Dim Gr As Drawing.Graphics = System.Drawing.Graphics.FromHwnd(Me.Handle) ' The Graphics object that will 'write the text onto the bitmap StringSize = Gr.MeasureString(str, NewFont) 'The length of the text Bmp = New Bitmap(CInt(StringSize.Width), CInt(StringSize.Height)) ' the bitmap that will hold the text Gr = System.Drawing.Graphics.FromImage(Bmp) 'tell the graphics object that it will be using the bitmap Gr.TextRenderingHint = Drawing.Text.TextRenderingHint.AntiAliasGridFit ' and how it will display the text Gr.DrawString(str, NewFont, StringColour, 0, 0) ' Draw the string on the bitmap Bmp.Save(MemStream, System.Drawing.Imaging.ImageFormat.Png) ' save the bitmap to the portion of memory MemStream.Position = 0 ' dont know what this does, but it is necessary Texture1 = Texture2D.FromStream(Device, MemStream) ' create a texture to be used in the spritebatch from the End Sub Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load Timer1.Interval = 1 End Sub Dim surColor As New SurfaceFormat Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick x += dx y += dy If x > Me.Width - StringSize.Width Then dx = -dx ElseIf x < 0 Then dx = -dx End If If y > Me.Height - StringSize.Height Then dy = -dy ElseIf y < 0 Then dy = -dy End If Application.DoEvents() vec = New Vector2(x, y) Dim ada As GraphicsAdapter 'set it to your computer graphics card ada = GraphicsAdapter.Adapters.Item(0) Dim pprofile As New GraphicsProfile 'hi def pprofile = GraphicsProfile.HiDef Dim ppar As New PresentationParameters 'the viewing area ppar.BackBufferHeight = Me.ClientRectangle.Height ppar.BackBufferWidth = Me.ClientRectangle.Width ppar.BackBufferFormat = SurfaceFormat.Vector2 ppar.DeviceWindowHandle = Me.Handle ppar.IsFullScreen = False 'define the values for the adapter Device = New GraphicsDevice(ada, pprofile, ppar) If Device Is Nothing Then Return 'Clear the backbuffer to a blue color Device.Clear(ClearOptions.Target, Color.Black, 1.0F, 0) SB = New SpriteBatch(Device) Dim blendSt As New Graphics.BlendState() blendSt = BlendState.Additive blendSt = Device.BlendState 'can experiment Dim ssMode As New SpriteSortMode ssMode = SpriteSortMode.BackToFront SB.Begin(ssMode, blendSt) Tex2d = New Texture2D(Device, x + StringSize.Width, y + StringSize.Height, True, surColor) ' vector set the position of the texture vec = New Vector2(x, y) 'Create the texture that holds the text WriteText("Xna Refresh 2012 " & vbNewLine & " is now supported in" & vbNewLine & "Visual Basic 2010", "Mirror", 26, FontStyle.Bold, Brushes.White, x, y, Tex2d, vec) SB.Draw(Tex2d, vec, Color.White) SB.End() Device.Present() ' invaldate i believe is not nedded ' but application doEvents is! Application.DoEvents() End Sub Private Sub btnStart_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnStart.Click 'create a toggle Select Case btnStart.Text Case Is = "Start" x = r.Next(0, Me.ClientRectangle.Width - StringSize.Width) y = r.Next(0, Me.ClientRectangle.Height - StringSize.Height) dx = r.Next(1, 30) dy = r.Next(1, 30) Timer1.Start() btnStart.Text = "Stop" Case Is = "Stop" Timer1.Stop() btnStart.Text = "Start" End Select 'set property anchor bottom, left, name= btnStart End Sub End Class
Home
|
Forums
|
Submit
|
Books
|
Mailing List
|
Advertising
|
About
|
Contact
© 2024 A1VBCode. All rights reserved.
Legal disclaimer & terms of use
Privacy statement