I'm currently making an arcade shooting game in Visual Basic which spawns enemies at the top of the form which move vertically downward toward the player. My current code spawns the enemy, but any attempt to add another 'enemyShip' to the 'enemyShips' array fails and hence, only a single enemy is spawned. Any help as to how to spawn multiple enemies would be appreciated. My current code is below:
Dim enemySize As Integer = 32
Dim enemySpawn As New Point(150, 0)
Dim enemyShip As New Rectangle(150, 0, enemySize, enemySize)
Dim enemyLoc As New Point(enemyShip.Location)
Dim enemySpr As Image = My.Resources.sprEnemy32x32
Dim enemySpeed As Integer = 5
Dim enemyShips(-1) As Rectangle
Dim intCount As Integer = 0
Dim g, bbg As Graphics
Dim backBuff As Bitmap
Private Sub frmMain_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
g = Me.CreateGraphics
backBuff = New Bitmap(300, 300, Imaging.PixelFormat.Format32bppPArgb)
bbg = Graphics.FromImage(backBuff)
tmrSpawn.Enabled = True
tmrRender.Enabled = True
End Sub
Private Sub tmrSpawn_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles tmrSpawn.Tick
SpawnEnemy()
End Sub
Private Sub SpawnEnemy()
'Add enemyShip to index in array enemyShips
'Add 1 to enemyShip's index so new rectangle is stored in the next index
ReDim Preserve enemyShips(intCount)
enemyShips(intCount) = enemyShip
intCount += 1
'Move newly created enemyShip vertically downward on the form
For Each Me.enemyShip In enemyShips
enemyLoc = New Point(enemyShip.Location.X, enemyShip.Location.Y + enemySpeed)
enemyShip.Location = enemyLoc
Next
End Sub
Private Sub tmrRender_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles tmrRender.Tick
bbg.DrawImage(enemySpr, enemyShip)
g.DrawImage(backBuff, 0, 0)
bbg.Clear(Color.Gray)
End Sub
Related
I am trying to write (type) directly onto a bitmap. I need to be able to type at the mouse position, so where ever on the screen i click the mouse, I can start typing text with the keyboard.
Here is a working VS 2017 VB Win Form code that will print "Hello World" at the mousedown position. But it only works with predetermined text. I would like to be able to just type at that spot. I feel I am so close, just can't get it to work.
Imports System.IO
Imports System.Windows.Forms.DataVisualization.Charting
Public Class Form1
Dim WithEvents Chart1 As New Chart
Private Structure TextPoints
Dim MPos As Point
Dim Txt As String
End Structure
Private TextList As New List(Of TextPoints)
Private TempPoint As Point
Private FirstPoint As Point
Dim xcnt As Integer = -1
Dim ycnt As Integer = -1
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles Me.Load
Me.Size = New Size(1100, 700)
Me.Location = New Point(10, 10)
MakeBackImage()
With Chart1
.Name = "Chart1"
.Location = New System.Drawing.Point(40, 40)
.Size = New System.Drawing.Size(1010, 610)
.BackImage = "BackImg.jpg"
.Parent = Me
End With
End Sub
Private Sub Chart1_MouseDown(ByVal sender As Object,
ByVal e As System.Windows.Forms.MouseEventArgs) _
Handles Chart1.MouseDown
FirstPoint = New Point(e.X, e.Y)
TempPoint = New Point(e.X, e.Y)
Me.Refresh()
End Sub
Private Sub Chart1_MouseUp(ByVal sender As Object,
ByVal e As System.Windows.Forms.MouseEventArgs) _
Handles Chart1.MouseUp
Dim T As New TextPoints With {
.MPos = TempPoint,
.Txt = "Hello World"}
TextList.Add(T)
Me.Refresh()
End Sub
Private Sub MakeBackImage()
Dim x, y As Integer
Dim img As Image = New Bitmap(1020, 620)
Dim graphics As Graphics = Graphics.FromImage(img)
graphics.Clear(Drawing.Color.White)
For x = 0 To 1000 Step 20
graphics.DrawLine(Pens.Black, x, 0, x, 600)
xcnt += 1
Next
For y = 0 To 600 Step 20
ycnt += 1
graphics.DrawLine(Pens.Black, 0, y, 1000, y)
Next
img.Save("BackImg.jpg", Imaging.ImageFormat.Jpeg)
End Sub
Private Sub Chart1_Paint(ByVal sender As Object,
ByVal e As System.Windows.Forms.PaintEventArgs) _
Handles Chart1.Paint
Dim drawString As String = "Hello World"
Dim drawFont As New Font("Arial", 14)
Dim drawBrush As New SolidBrush(Color.Black)
For Each t As TextPoints In TextList
e.Graphics.DrawString(t.Txt, drawFont,
drawBrush, t.MPos.X, t.MPos.Y)
Next
End Sub
End Class
This is a simplified code. Actually, the background image is only created once, but I added code to dynamically create it here to make the demo better.
I am trying to make some code for a game that has a grid and a tick counter but the grid just tries to fill the window instead of stopping and does not display the tick counter. The error that keeps coming up is:
A first chance exception of type 'System.ObjectDisposedException' occurred in System.Windows.Forms.dll
I have no idea what this means and I don't know how to fix it.
Heres my code:
Public Class Form1
Dim G As Graphics
Dim BBG As Graphics
Dim BB As Bitmap
Dim r As Rectangle
Dim tSec As Integer = TimeOfDay.Second
Dim tTicks As Integer = 0
Dim MaxTicks As Integer = 0
Dim IsRunning As Boolean = True
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Me.Show()
Me.Focus()
G = Me.CreateGraphics
BB = New Bitmap(Me.Width, Me.Height)
StartGameLoop()
End Sub
Private Sub DrawGraphics()
For X = 0 To 19
For Y = 0 To 14
r = New Rectangle(X * 32, Y * 32, 32, 32)
G.FillRectangle(Brushes.BurlyWood, r)
G.DrawRectangle(Pens.Black, r)
Next
Next
G.DrawString("Ticks: " & tTicks & vbCrLf & _
"TPS: " & MaxTicks, Me.Font, Brushes.Black, 650, 0)
G = Graphics.FromImage(BB)
BBG = Me.CreateGraphics
BBG.DrawImage(BB, 0, 0, Me.Width, Me.Height)
G.Clear(Color.Wheat)
End Sub
Private Sub StartGameLoop()
Do While IsRunning = True
Application.DoEvents()
DrawGraphics()
TickCounter()
Loop
End Sub
Private Sub TickCounter()
If tSec = TimeOfDay.Second And IsRunning = True Then
tTicks = tTicks + 1
Else
MaxTicks = tTicks
tTicks = 0
tSec = TimeOfDay.Second
End If
End Sub
End Class
You are utilizing a lot of bad practice here...
First of all, using Me.CreateGraphics() is bad and the resulting object can only be drawn with once, which means that you are forced to call it several times. Continuously calling it will just create more and more graphics objects that increases memory usage. Even if you were to dispose of them every time you've finished drawing it's still a huge bottleneck because it slows down processing.
Secondly, using Application.DoEvents() is VERY BAD PRACTICE and will burn your CPU in a loop like that. Unless used correctly (which you don't) it can cause unexpected and unpredictable behaviour. The error you're getting is a good example of such unexpected behaviour.
I suggest you read this MSDN blog, it explains exactly why one shouldn't use Application.DoEvents(): Keeping your UI Responsive and the Dangers of Application.DoEvents.
Instead, in order to do this correctly:
Replace Me.CreateGraphics() with your form's Paint event and do all the drawing in there through the e.Graphics object.
Replace your game loop with a Timer that continuously calls Me.Invalidate() to redraw the form.
For example:
Dim WithEvents GameTimer As New Timer() With {.Interval = 1}
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
GameTimer.Start()
End Sub
Private GameTimer_Tick(sender As System.Object, e As System.EventArgs) Handles GameTimer.Tick
Me.Invalidate() 'Redraw the form.
TickCounter()
End Sub
Private Sub Form1_Paint(sender As System.Object, e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint
e.Graphics.Clear(Color.Wheat)
For X = 0 To 19
For Y = 0 To 14
Dim r As New Rectangle(X * 32, Y * 32, 32, 32)
e.Graphics.FillRectangle(Brushes.BurlyWood, r)
e.Graphics.DrawRectangle(Pens.Black, r)
Next
Next
e.Graphics.DrawString("Ticks: " & tTicks & vbCrLf & _
"TPS: " & MaxTicks, Me.Font, Brushes.Black, 650, 0)
End Sub
I'm experimenting on paint event in Windows Form, what I want to achieved is to repaint the colors of the arrow. I think I successfully did that, I just have a question on whether should I use the Me.Invalidate or Me.Refresh when performing the repaint event on the form? Both of them are working.
Note that I will create many objects later so one of my goals is to lessen the performance issues.
When you clicked the button 1 it will change the color of the line 1 to yellow using the Me.Invalidate, when you clicked the button 2 it will change the line 1 to blue using the Me.Refresh. Both of them are working.
This is my whole code:
Public Class Form1
Private Sub Form1_Paint(sender As Object, e As PaintEventArgs) Handles MyBase.Paint
drawLeftArrow(e, "a", 100, 250, 400, 50)
End Sub
Dim aPen As Pen = New Pen(Color.Red, 8)
Dim bPen As Pen
Dim cPen As Pen
Dim line1 As Point()
Dim line2 As Point()
Dim line3 As Point()
Sub drawLeftArrow(e As PaintEventArgs, letterPosition As String, startPointX As Integer, startPointY As Integer, endPointX As Integer, endPointY As Integer)
bPen = New Pen(Color.Green, 8)
cPen = New Pen(Color.Yellow, 8)
Dim mycap As Drawing2D.CustomLineCap = New Drawing2D.AdjustableArrowCap(5, 5)
' Create points that define curve.
Dim startPoint As New Point(startPointX, startPointY)
Dim endPoint As New Point(endPointX, endPointY)
Select Case letterPosition
Case "a"
Dim middlePoint1 As New Point(startPointX + 250, startPointY)
Dim middlePoint2 As New Point(startPointX + 300, endPointY + 150)
line1 = {startPoint, middlePoint1}
line2 = {middlePoint1, middlePoint2}
line3 = {middlePoint2, endPoint}
cPen.CustomEndCap = mycap
' Draw lines between original points to screen.
e.Graphics.DrawLines(aPen, line1)
e.Graphics.DrawLines(bPen, line2)
e.Graphics.DrawLines(cPen, line3)
Exit Select
End Select
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
aPen = New Pen(Color.Yellow, 8)
Me.Invalidate()
End Sub
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
aPen = New Pen(Color.Blue, 8)
Me.Refresh()
End Sub
End class
Output:
I'm currently working on a game in Visual Basic similar to an arcade shooter. The player moves their ship left and right across the screen using the arrow keys, while they 'shoot' using the spacebar. Problem is, I'm not sure where to place the bullet's movement so it will constantly move (not just spawn on a key-down event) and be updated by the Render() function. Any help or suggestions would be greatly appreciated.
My current code is displayed below; it's my first time using a game loop, so apologies if anything's misused.
Public Class frmMain
'Diming drawing surface & controls
Dim g, bbg As Graphics
Dim backBuff As Bitmap
Dim keys(256) As Boolean
Dim clientWidth, clientHeight As Integer
Dim timer As Stopwatch
Dim interval, startTick As Long
'Diming playerShip
Dim playerSize As Long = 64
Dim playerShip As New Rectangle(180, 430, playerSize, playerSize)
Dim playerLoc As New Point(playerShip.Location)
Dim playerSpr As Image = My.Resources.sprPlayer
Dim playerSpeed As Long
'Diming playerBullet
Dim playerBulletWidth As Long = 9
Dim playerBulletHeight As Long = 20
Dim playerBullet As New Rectangle(playerLoc.X, playerLoc.Y - 20, playerBulletWidth, playerBulletHeight)
Dim playerBulletLoc As New Point(playerBullet.Location)
Dim playerBulletSpr As Image = My.Resources.sprPlayerBullet
Dim playerBulletSpeed As Long
Dim playerShoot As Boolean = False
Public Sub frmMain_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
'Configuring specific properties of the form
Me.DoubleBuffered = True
Me.MaximizeBox = False
Me.FormBorderStyle = Windows.Forms.FormBorderStyle.Fixed3D
'Me.BackColor = Color.Black
'configuring timer controls
interval = 16
timer = New Stopwatch()
'Assigning values to empty variables
clientWidth = 450
clientHeight = 550
playerSpeed = 5
playerBulletSpeed = 5
'Configuring drawing surface
g = Me.CreateGraphics
backBuff = New Bitmap(clientWidth, clientHeight, Imaging.PixelFormat.Format32bppPArgb)
bbg = Graphics.FromImage(backBuff)
'Initially draw playerShip
bbg.DrawImage(playerSpr, playerShip)
'bbg.DrawImage(playerBulletSpr, playerBullet)
End Sub
Private Sub frmMain_KeyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles Me.KeyDown
keys(e.KeyCode) = True
End Sub
Private Sub frmMain_KeyUp(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles Me.KeyUp
keys(e.KeyCode) = False
End Sub
Private Sub frmMain_Shown(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Shown
GameLoop()
End Sub
Private Sub GameLoop()
timer.Start()
Do While (Me.Created)
startTick = timer.ElapsedMilliseconds
GameLogic()
Render()
Application.DoEvents()
'Allows game to run at constant speed on different machines
Do While timer.ElapsedMilliseconds - startTick < interval
Loop
Loop
End Sub
Private Sub GameLogic()
'Spawning, movement & collision
Dim keyPressed As Boolean = False
'playerShip movement & shooting
'Checks for no collision with form's right wall
If Not playerShip.Location.X + playerSpeed > clientWidth - playerShip.Width - playerSpeed Then
'Move playerShip right (right arrow)
If keys(39) Then
playerLoc = New Point(playerShip.Location.X + playerSpeed, playerShip.Location.Y)
playerShip.Location = playerLoc
keyPressed = True
End If
End If
'Checks for no collision with form's left wall
If Not playerShip.Location.X - playerSpeed < 0 Then
'Move playerShip left (left arrow)
If keys(37) Then
playerLoc = New Point(playerShip.Location.X - playerSpeed, playerShip.Location.Y)
playerShip.Location = playerLoc
keyPressed = True
End If
End If
'Launch bullet (space-bar)
If keys(32) Then
playerShoot = True
keyPressed = True
PlayerShipShoot()
End If
End Sub
Private Sub PlayerShipShoot()
'Add bullet activity here... maybe
End Sub
Private Sub Render()
'Drawing playerShip & playerBullet
bbg.DrawImage(playerSpr, playerShip)
If playerShoot = True Then
bbg.DrawImage(playerBulletSpr, playerBullet)
End If
'Drawing backBuff to the form
g.DrawImage(backBuff, 0, 0)
bbg.Clear(Color.Silver)
End Sub
End Class
Thanks.
Dim HaveToDraw As New Boolean
Dim xMouse As Integer
Dim yMouse As Integer
Private Sub foo(sender As Object, e As PaintEventArgs) Handles PictureBox1.Paint
If HaveToDraw = True Then
e.Graphics.FillEllipse(Brushes.Green, xMouse, yMouse, 10, 10)
End If
HaveToDraw = False
End Sub
Sub PictureBox1_MouseClick(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseClick
If RadioButton1.Checked = True Then
xMouse = e.X
yMouse = e.Y
HaveToDraw = True
PictureBox1.Refresh()
End If
End Sub
This code lets the user draw an elipse when he clicks on any point on the map, but there are 2 problems with it: 1 - The user is able to draw only one elipse; 2 - The user is not able to erase a previously created elipse.
So, how can I do that solving these two problems?
As #Idle_Mind suggested, you could use a list to store your points, and a right-click event to remove the points:
Dim radius as Integer = 5
Private points As New List(Of Point)()
Private Sub pictureBox1_MouseClick(sender As Object, e As MouseEventArgs)
If e.Button = System.Windows.Forms.MouseButtons.Left Then
points.Add(e.Location) ' add point on left click
ElseIf e.Button = System.Windows.Forms.MouseButtons.Right Then
For i As Integer = 0 To points.Count - 1 ' remove points on right-click
If distance(points(i).X, points(i).Y, e.Location) < radius Then
points.RemoveAt(i)
End If
Next
End If
pictureBox1.Refresh()
End Sub
'helper function
Private Function distance(x__1 As Integer, y__2 As Integer, mousep As Point) As Integer
Dim X__3 As Integer = CInt(Math.Pow(CDbl(x__1 - mousep.X), 2))
Dim Y__4 As Integer = CInt(Math.Pow(CDbl(y__2 - mousep.Y), 2))
Return CInt(Math.Sqrt(CDbl(X__3 + Y__4)))
End Function
Private Sub pictureBox1_Paint(sender As Object, e As PaintEventArgs)
For i As Integer = 0 To points.Count - 1
e.Graphics.FillEllipse(Brushes.Green, points(i).X - radius, points(i).Y - radius, radius * 2, radius * 2)
Next
End Sub
I also changed the paint code to draw the circles so that they are centered under the mouse-click.