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