battle programmers alliance

battle programming a forum for elite programmers with extreme will power to sharpen theire skills
 
HomeCalendarFAQSearchMemberlistUsergroupsRegisterLog in
Share | 
 

 vb.net game map + char on it

View previous topic View next topic Go down 
AuthorMessage
kurosen

avatar

Posts : 63
Join date : 2012-04-17

PostSubject: vb.net game map + char on it    Mon Jun 06, 2016 1:18 am

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
Back to top Go down
View user profile
 
vb.net game map + char on it
View previous topic View next topic Back to top 
Page 1 of 1
 Similar topics
-
» Blokus Game Giveaway *Canada and usa only*
» Future Forward Game Changer Award 2011
» Learning Palace Blurt Game Giveaway! *usa only*
» SoBe Lifewater Facebook SUMMER OF SoBe Game *usa only*
» The Pun Game Thread

Permissions in this forum:You cannot reply to topics in this forum
battle programmers alliance :: battle programming alliance :: battle programming-
Jump to: