Search
 
 

Display results as :
 


Rechercher Advanced Search

Latest topics
October 2017
SunMonTueWedThuFriSat
1234567
891011121314
15161718192021
22232425262728
293031    

Calendar Calendar

RSS feeds


Yahoo! 
MSN 
AOL 
Netvibes 
Bloglines 


Social bookmarking

Social bookmarking Digg  Social bookmarking Delicious  Social bookmarking Reddit  Social bookmarking Stumbleupon  Social bookmarking Slashdot  Social bookmarking Yahoo  Social bookmarking Google  Social bookmarking Blinklist  Social bookmarking Blogmarks  Social bookmarking Technorati  

Bookmark and share the address of battle programmers alliance on your social bookmarking website

vb.net game map + char on it

View previous topic View next topic Go down

vb.net game map + char on it

Post  kurosen on Sun Jun 05, 2016 10:18 pm

the code will be used for stuff far beyong
the code may be updated sometime

add picbox with map elements for map tiles (invisible)
add picbox with char (up down left right facing) invisible

Code:
Imports System.Drawing
Imports System.Math
Public Class Form1
    ' view scale
    Dim resWidth As Integer = 750
    Dim resHeight As Integer = 550
    Dim tileSize As Integer = 32
    Dim g As Graphics
    Dim bbg As Graphics
    Dim bb As Bitmap
    'mutationed Dim r As Rectangle to
    Dim bmpTile As Bitmap ' image of tile
    Dim sRect As Rectangle ' source image tile
    Dim dRect As Rectangle ' destination image tile
    '
    Dim tSec As Integer = TimeOfDay.Second
    Dim tTicks As Integer = 0
    Dim maxTicks As Integer = 0
    ' map vars
    Dim map(100, 100, 10) As Integer
    ' map vars for saving
    Dim mapx As Integer = 20
    Dim mapy As Integer = 20
    ' game running ?
    Dim isRunning As Boolean = True
    'mouce locations
    Dim mouseX As Integer
    Dim mouseY As Integer
    Dim mMapX As Integer
    Dim mMapY As Integer
    'toon variables
    Dim bmpToon As Bitmap
    Dim xPos As Integer
    Dim yPos As Integer
    Dim moveSpeed As Integer = 8
    Dim moveDir As Short = 0
    Dim lastDir As Short = 2
    ' paint brush
    Dim paintbrush As Integer = 0

    Private Sub Form1_KeyPress(sender As Object, e As KeyPressEventArgs) Handles Me.KeyPress
        Select Case e.KeyChar
            Case "w"
                moveDir = 1
            Case "a"
                moveDir = 2
            Case "s"
                moveDir = 3
            Case "d"
                moveDir = 4
        End Select
        lastDir = moveDir

    End Sub

    Private Sub Form1_KeyUp(sender As Object, e As KeyEventArgs) Handles Me.KeyUp
        moveDir = 0
    End Sub

    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        Me.Show()
        Me.Focus()
        ' initialize graphics object
        g = Me.CreateGraphics
        bb = New Bitmap(resWidth, resHeight)
        bmpTile = New Bitmap(PictureBox1.Image)
        bmpToon = New Bitmap(pbToon.Image)

        map(21, 21, 0) = 1 'example populate a tile on D map

        startGameLoop()
    End Sub
    Private Sub startGameLoop()
        Do While isRunning
            ' keep app responsive
            Application.DoEvents()
            ' get user input
            moveToon(moveDir)
            ' run a.i
            ' update object data
            ' chk triggers & conditions
            ' draw graphics
            drawGraphics()
            ' update tick counter
            tickCounter()
        Loop
    End Sub
    Private Sub moveToon(ByVal dir) 'duplicate #, var mutation for loop nested with conjurati formula
        Select Case dir
            Case 1
                mapy -= 1
            Case 2
                mapy += 1
            Case 3
                mapx -= 1
            Case 4
                mapx += 1
        End Select
    End Sub
    Private Sub drawGraphics()
        ' fill D backbuffer
        ' draw tiles
        For x = 0 To 19
            For y = 0 To 14
                'mutation r deleted
                getSourceRect(mapx + x, mapy + y, tileSize, tileSize)
                dRect = New Rectangle(x * tileSize, y * tileSize, tileSize, tileSize)
                g.DrawImage(bmpTile, dRect, sRect, GraphicsUnit.Pixel)
            Next
        Next
        g.FillRectangle(Brushes.Red, 21 * tileSize, 4 * tileSize, tileSize, tileSize)
        g.FillRectangle(Brushes.Blue, 21 * tileSize, 6 * tileSize, tileSize, tileSize)
        'draw toon
        getToom(lastDir)
        bmpToon.MakeTransparent(Color.Fuchsia)
        g.DrawImage(bmpToon, 9 * tileSize, 6 * tileSize, sRect, GraphicsUnit.Pixel)


        ' mark mouse
        g.DrawRectangle(Pens.Red, mouseX * tileSize, mouseY * tileSize, tileSize, tileSize)
        ' draw final layers
        g.DrawString("Ticks:" & tTicks & vbCrLf & "TPS: " & maxTicks & vbCrLf &
                    "mouseXPos: " & mouseX & vbCrLf & "mouseYPos: " & mouseY & vbCrLf & "mMapY" & mMapY & vbCrLf &
                    "mMapx :" & mMapX & vbCrLf, Me.Font, Brushes.Black, 650, 0)
        'copy back buffer to graphics object
        g = Graphics.FromImage(bb)
        'draw backbuffer to screen
        bbg = Me.CreateGraphics
        bbg.DrawImage(bb, 0, 0, resWidth, resHeight)
        'clear overdraw
        g.Clear(Color.Wheat)

    End Sub
    Private Sub getToom(ByVal dir As Short)
        Select Case dir
            Case 1
                sRect = New Rectangle(32, 0, tileSize, tileSize)
            Case 2
                sRect = New Rectangle(0, 0, tileSize, tileSize)
            Case 3
                sRect = New Rectangle(0, 32, tileSize, tileSize)
            Case 4
                sRect = New Rectangle(32, 32, tileSize, tileSize)

        End Select
    End Sub
    Private Sub tickCounter()
        If tSec = TimeOfDay.Second And isRunning Then
            tTicks += 1
        Else
            maxTicks = tTicks
            tTicks = 0
            tSec = TimeOfDay.Second

        End If
    End Sub

    Private Sub Form1_MouseClick(sender As Object, e As MouseEventArgs) Handles Me.MouseClick
        If mouseX = 21 Then
            If mouseY = 4 Then
                paintbrush = 1
            ElseIf mouseY = 6 Then
                paintbrush = 2
            End If
        End If
        Select Case paintbrush
            Case 0
            Case 1 ' red
                map(mMapX, mMapY, 0) = 1
            Case 2 'blue
                map(mMapX, mMapY, 0) = 2

        End Select
    End Sub

    Private Sub Form1_MouseMove(sender As Object, e As MouseEventArgs) Handles Me.MouseMove
        mouseX = Math.Floor(e.X / tileSize)
        mouseY = Math.Floor(e.Y / tileSize)
        mMapX = mapx + mouseX
        mMapY = mapy + mouseY
    End Sub
    Private Sub getSourceRect(ByVal x As Integer, y As Integer, w As Integer, h As Integer)
        Select Case map(x, y, 0)
            Case 0 'grass
                sRect = New Rectangle(32, 0, tileSize, tileSize)
            Case 1 'tree or whatevet tjis is the tile image type m'kay
                sRect = New Rectangle(128, 128, tileSize, tileSize)
        End Select
    End Sub
End Class
avatar
kurosen

Posts : 64
Join date : 2012-04-17

View user profile

Back to top Go down

View previous topic View next topic Back to top

- Similar topics

 
Permissions in this forum:
You cannot reply to topics in this forum