Visual-Basic-Forum VB-Paradise.de

Visual Basic Quellcode

Public Function Kollisionskontrolle(ByVal Rect1 As Microsoft.Xna.Framework.Rectangle, ByVal Rect2 As Microsoft.Xna.Framework.Rectangle) As Boolean
Dim sx, sy As Boolean
sx = Rect1.Left <= (Rect2.Left + Rect2.Width) And (Rect1.Left + Rect1.Width) >= Rect2.Left
sy = (Rect1.Top + Rect1.Height) >= Rect2.Top And Rect1.Top <= (Rect2.Top + Rect1.Height)
Kollisionskontrolle = sx And sy
End Function

Visual Basic Quellcode

Private Shared Function GetMax(ByVal Value1 As Integer, ByVal Value2 As Integer) As Integer
If Value1 > Value2 Then
Return Value1
Else
Return Value2
End If
End Function

Public Shared Function CheckForKollision2(ByVal rect1 As Microsoft.Xna.Framework.Rectangle, ByVal rect2 As Microsoft.Xna.Framework.Rectangle) As Boolean
' Genauer Prüfen
' rect2 = Object dass sich bewegt
Dim bmp As New Bitmap(GetMax(rect1.X + rect1.Width, rect2.X + rect2.Width) + 1, GetMax(rect1.Y + rect1.Height, rect2.Y + rect2.Height) + 1)
Using g As Graphics = Graphics.FromImage(bmp)
Dim r1 As New Rectangle(rect1.X, rect1.Y, rect1.Width, rect1.Height)
Dim r2 As New Rectangle(rect2.X, rect2.Y, rect2.Width, rect2.Height)
g.FillRectangle(Brushes.Black, r1)
g.FillRectangle(Brushes.Red, r2)
Dim hclr As Color = bmp.GetPixel(r2.X + 1, r2.Y + 1)
For x = r1.X To r1.X + r1.Width
For y = r1.Y To r1.Y + r1.Height
If bmp.GetPixel(x, y) = hclr Then
MsgBox(x.ToString & " ," & y.ToString)
Return True
Exit Function
End If
Next
Next
End Using
Return False
End Function

Visual Basic Quellcode

Imports Microsoft.Xna.Framework
Imports Microsoft.Xna.Framework.Graphics
Imports Microsoft.Xna.Framework.Input
Public Class Kamera
	''' <summary>
	''' Position der Kamera.
	''' </summary>
	''' Darf man nach Unten mit der Kamera?
	Dim Downe As Boolean
	' Darf man nach oben mit der Kamera?
	Dim Upe As Boolean
	' Darf man nach Links mit der Kamera?
	Dim Lefte As Boolean
	' Darf man nach rechts mit der Kamera?
	Dim Righte As Boolean
	' Aktuelle Kamera Position
	Public Property Position() As Vector2
    	Get
        	' m_position enthält die Kamera Position && Wiedergeben
        	Return m_position
    	End Get
    	Set(ByVal value As Vector2)
        	' Value = wert der Zugewiesen werden soll
        	m_position = value
    	End Set
	End Property
	' enthält die aktuelle Position (private) kann nicht von aussen
	' ohne die Property geändert werden
	Private m_position As Vector2

	Public Sub Update(ByVal gameTime As GameTime)
    	' gametime = Zeit des SPiels
    	Dim elapsed As Single = CSng(gameTime.ElapsedGameTime.TotalSeconds)
    	' Stand der Tastatur in Variable speichern
    	Dim kbState As KeyboardState = Keyboard.GetState()

    	' Kamera bewegen
    	' Darf man nach oben mit der Kamera?
    	If Upe Then
        	' Prüfen ob Oben Taste gedrückt ist:
        	If kbState.IsKeyDown(Keys.Up) Then
            	' Nach oben bewegen bewegen
            	m_position.Y += 200.0F * elapsed
        	End If
    	End If
    	' Darf man nach unten mit der Kamera?
    	If Downe Then
        	' Prüfen ob Unten Taste gedrückt ist:
        	If kbState.IsKeyDown(Keys.Down) Then
            	' Nach unten bewegen
            	m_position.Y -= 200.0F * elapsed
        	End If
    	End If
    	' Darf man nach Links mit der Kamera?
    	If Lefte Then
        	' Prüfen ob Linke Taste gedrückt ist:
        	If kbState.IsKeyDown(Keys.Left) Then
            	' Nach Links bewegen
            	m_position.X -= 200.0F * elapsed
        	End If
    	End If

    	' Darf man nach Rechts mit der Kamera?
    	If Righte Then
        	' Prüfen ob Nach Rechts gedrückt ist?
        	If kbState.IsKeyDown(Keys.Right) Then
            	' Nach Rechts bewegen mit der Kamera
            	m_position.X += 200.0F * elapsed
        	End If
    	End If
	End Sub

	Public Function GetMatrix() As Matrix
    	' Matrix zurückgeben
    	Return Matrix.CreateTranslation(New Vector3(m_position, 0))
	End Function

	Public Sub New(ByVal DownEnabled As Boolean, ByVal UpEnabled As Boolean, ByVal Leftenabled As Boolean, ByVal RightEnabled As Boolean)
    	' werte in den Booleans zuweisen
    	' wo man mit der Kamera hin darf!
    	Downe = DownEnabled
    	Upe = UpEnabled
    	Lefte = Leftenabled
    	Righte = RightEnabled
	End Sub
End Class

Visual Basic Quellcode

spriteBatch.Begin(SpriteBlendMode.AlphaBlend, SpriteSortMode.Deferred, SaveStateMode.None, camera.GetMatrix())

Visual Basic Quellcode

Imports Microsoft.Xna.Framework
Imports Microsoft.Xna.Framework.Graphics
Imports Microsoft.Xna.Framework.Input
Imports Microsoft.Xna.Framework.Content
Imports Microsoft.Xna.Framework.Game
Public Class AnimatedSprite
Public Texture As Texture2D
Private totalElapsed As Double
Private rows As Integer
Private columns As Integer
Private width As Integer
Private height As Integer
Private animationspeed As Double
Private currentRow As Integer
Private currentColumn As Integer

Public Sub LoadGraphics(ByVal texture As Texture2D, ByVal rows As Integer, ByVal columns As Integer, ByVal animationspeed As Double)
Me.Texture = texture
Me.rows = rows
Me.columns = columns
Me.width = width
Me.height = height
Me.animationspeed = 1 / animationspeed
totalElapsed = 0
currentRow = 0
currentColumn = 0
End Sub

Public Sub Update(ByVal elapsed As Double)
totalElapsed += elapsed
If totalElapsed > animationspeed Then
totalElapsed -= animationspeed
currentColumn += 1
If currentColumn >= columns Then
currentRow += 1
currentColumn = 0
If currentRow > rows Then
currentRow = 0
End If
End If
End If
End Sub

Public Sub Draw(ByRef spritebatch As SpriteBatch, ByVal Position As Vector2, ByVal Color As Color)
spritebatch.Draw(Texture, New Rectangle(CInt(Position.X), CInt(Position.Y), width, height), New Rectangle(currentColumn * width, currentRow * height, width, height), Color)
End Sub
End Class

Visual Basic Quellcode

Dim wasweißich As New AnimatedSprite
wasweißich.LoadGraphics(Texture2D.Fromfile(graphics.Graphicsdevice, "Pfad"), 5, 5, 1.5)
' = 5 Reihen 5 Spalten und Animationspeed 1.5

Visual Basic Quellcode

Public Structure Tile
Dim Texture As Texture2D
Dim Kollision As Boolean
Dim Position As Vector2
End Structure

Visual Basic Quellcode

Dim Pfad As String = "Pfad"
    Dim Content As String = IO.File.ReadAllText(Pfad)
    For Each lines As String In Content.Split(vbCrLf.ToCharArray)
        Dim count As Integer = 0
        Dim tile As New Tile
        For Each Propertys As String In lines.Split(Convert.ToChar("|"))
            count += 1
            If count = 1 Then
                tile.Texture = Texture2D.FromFile(graphics.GraphicsDevice, Propertys)
            ElseIf count = 2 Then
                tile.Kollision = Convert.ToBoolean(Propertys)
            ElseIf count = 3 Then
                Dim Vector As New Vector2(0, 0)
                Dim cnt As Integer = 0
                For Each vxy As Integer In Propertys.Split(Convert.ToChar(","))
                    cnt += 1
                    If cnt = 1 Then
                        Vector.X = vxy
                    ElseIf cnt = 2 Then
                        Vector.Y = vxy
                    End If
                Next
                tile.Position = Vector
            End If
            Tiles.Add(tile)
        Next
    Next

Visual Basic Quellcode

For each Tile As Tile in Me.Tiles
spritebatch.draw(Tile.Texture, Tile.Position, Color.white)
next