I have tried to do this both with GDI+/Invalidate and by using a Line Shape Control. In both cases the memory spirals out of control. To demonstrate, create a windows form application with a timer object which is set to 100ms and enabled and use the following code:
Public Class Form1
Private Y As Integer
Private intDirection As Integer = 1
Private Sub timTest_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles timTest.Tick
Me.Invalidate()
End Sub
Private Sub Form1_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint
Dim g As Graphics = Me.CreateGraphics
Dim myPen As New Pen(Color.Black)
myPen.Width = 1
g.SmoothingMode = Drawing2D.SmoothingMode.AntiAlias
g.DrawLine(myPen, 10, 10, 200, Y)
Y += intDirection
If Y > Me.Height - 20 Then intDirection = -1
If Y < 0 Then intDirection = 1
g.Dispose()
myPen.Dispose()
End Sub
End Class
So the code above causes a memory leak as the line moves. I think the reason is that there are unmanaged bitmaps created behind the scenes to paint the form which are not being released because on the managed side it is just a pointer.
If I add the following code at the start of the paint function
Dim intAlloc As Integer = Me.Width * Me.Height * 16
GC.AddMemoryPressure(intAlloc)
and at the end of the function I call
GC.RemoveMemoryPressure(intAlloc)
The memory utilization grows a little and shrinks a little but never grows out of control. The AddMemoryPressure and RemoveMemoryPressure seems to alert the GC that it needs to run. Is there a better way to do this or is this correct? The code above is just a simplification for example purposes to get to the root of a problem I have in a larger component with several moving lines. Also is this the best way to calculate the proper value to place in AddMemoryPressure?
Related
So, I am making a game for my programming class as part of my final project. I'm just in the planning and experimenting stage at the moment and I decided to get a headstart on graphics and collisions. I first made my program just by experimenting with the Graphics class VB has to offer, instead of using PictureBoxes. Alongside that, I added keyboard input to move an Image around. When I decided to add collision detection through the intersectsWith() method of the Image class, things became weird.
Basically, in my code, the "Player" entity has three different images - which change depending on which way they are facing, which is in turn determined by what key the user presses. Without any collision detection code, the movement and image changing works fine and the image moves about. However, as soon as I add collision detection the player does not move at all, only the way they face changes. This happens even if the player's Image is nowhere near the image I want to test for intersection (a dollar sign). Here's my entire code:
Public Class Form1
Enum DirectionFacing
FORWARDS
BACKWARD
LEFT
RIGHT
End Enum
' Player X position.
Dim pX As Integer = 100
' Player Y position.
Dim pY As Integer = 100
' The direction the player is facing - by default, backward.
Dim dir As DirectionFacing = DirectionFacing.BACKWARD
' The image of the player.
Dim pI As Image = My.Resources.MainCharacter_Forward
' Another image designed to test for collision detection.
Dim dI As Image = My.Resources.DollarSign
Private Sub Form1_KeyDown(ByVal sender As System.Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles MyBase.KeyDown
If (e.KeyCode = Keys.W) Then
' If they press W, move forward.
dir = DirectionFacing.FORWARDS
pI = My.Resources.MainCharacter_Forward
movePlayer(DirectionFacing.FORWARDS, 10)
ElseIf (e.KeyCode = Keys.S) Then
' If they press S, move backward.
dir = DirectionFacing.BACKWARD
pI = My.Resources.MainCharacter_Behind
movePlayer(DirectionFacing.BACKWARD, 10)
ElseIf (e.KeyCode = Keys.A) Then
' If they press A, move to the left.
pI = My.Resources.MainCharacter_Side
dir = DirectionFacing.LEFT
movePlayer(DirectionFacing.LEFT, 10)
ElseIf (e.KeyCode = Keys.D) Then
' If they press D, move to the right. To make the player face rightward,
' the image can be flipped.
Dim flipped As Image = My.Resources.MainCharacter_Side
flipped.RotateFlip(RotateFlipType.RotateNoneFlipX)
pI = flipped
dir = DirectionFacing.LEFT
movePlayer(DirectionFacing.RIGHT, 10)
End If
End Sub
' Moves the player by a certain amount AND checks for collisions.
Private Sub movePlayer(dir As DirectionFacing, amount As Integer)
If (dI.GetBounds(GraphicsUnit.Pixel).IntersectsWith(pI.GetBounds(GraphicsUnit.Pixel))) Then
Return
End If
If (dir = DirectionFacing.FORWARDS) Then
pY -= 10
ElseIf (dir = DirectionFacing.BACKWARD) Then
pY += 10
ElseIf (dir = DirectionFacing.LEFT) Then
pX -= 10
ElseIf (dir = DirectionFacing.RIGHT) Then
pX += 10
End If
End Sub
Private Sub draw(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint
Dim g As Graphics = e.Graphics()
g.DrawImage(dI, 400, 350)
g.DrawImage(pI, pX, pY)
Me.Invalidate()
End Sub
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Me.DoubleBuffered = True
End Sub
End Class
Basically, every time I press a key and want the image to move, the image doesn't move at all (even when the Player is nowhere close to the dollar sign), but the direction they are facing still changes. How can I keep the player moving and still stop the player from colliding with another image?
Well, the
If (dI.GetBounds(GraphicsUnit.Pixel).IntersectsWith(pI.GetBounds(GraphicsUnit.Pixel)))
will always return False since the GetBounds method does not return the current location of each rectangle. So they will never intersect, and your drawing scene remains the same.
So let's try to solve this problem.
Enum DirectionFacing
FORWARDS
BACKWARD
LEFT
RIGHT
End Enum
' The image of the player.
Dim pI As New Bitmap(My.Resources.MainCharacter_Forward)
' Another image designed to test for collision detection.
Dim dI As New Bitmap(My.Resources.DollarSign)
'The rectangle of the player's image.
Dim pIrect As New Rectangle(100, 100, pI.Width, pI.Height)
'The static rectangle of the collision's image.
Dim dIrect As New Rectangle(400, 350, dI.Width, dI.Height)
Now the IntersectWith function should work in the movePlayer method:
Private Sub movePlayer(dir As DirectionFacing, amount As Integer)
Dim px = pIrect.X
Dim py = pIrect.Y
Select Case dir
Case DirectionFacing.FORWARDS
py -= amount
Case DirectionFacing.BACKWARD
py += amount
Case DirectionFacing.LEFT
px -= amount
Case DirectionFacing.RIGHT
px += amount
End Select
If Not New Rectangle(px, py, pI.Width, pI.Height).IntersectsWith(dIrect) Then
pIrect = New Rectangle(px, py, pI.Width, pI.Height)
Invalidate()
End If
End Sub
Note that, both px and py variables are now locals because we already have pIrect which includes the currect x and y. We replaced the If statement with Select Case as a better approach I believe. We created a new rectangle to check any possible collision, if not, then we update our pIrect and refresh the drawing.
Besides moving the image through the W S A D keys, you also can make use of the ← ↑ → ↓ keys. To intercept them in the KeyDown event, just override the IsInputKey function as follow:
Protected Overrides Function IsInputKey(keyData As Keys) As Boolean
Select Case keyData And Keys.KeyCode
Case Keys.Left, Keys.Up, Keys.Right, Keys.Down
Return True
Case Else
Return MyBase.IsInputKey(keyData)
End Select
End Function
Thus, the KeyDown event:
Private Sub Form1_KeyDown(sender As Object, e As KeyEventArgs) Handles MyBase.KeyDown
Select Case e.KeyCode
Case Keys.W, Keys.Up
pI?.Dispose()
pI = New Bitmap(My.Resources.MainCharacter_Forward)
movePlayer(DirectionFacing.FORWARDS, 10)
Case Keys.S, Keys.Down
pI?.Dispose()
pI = New Bitmap(My.Resources.MainCharacter_Behind)
movePlayer(DirectionFacing.BACKWARD, 10)
Case Keys.A, Keys.Left
pI?.Dispose()
pI = New Bitmap(My.Resources.MainCharacter_Side)
movePlayer(DirectionFacing.LEFT, 10)
Case Keys.D, Keys.Right
pI?.Dispose()
pI = New Bitmap(My.Resources.MainCharacter_Side)
pI.RotateFlip(RotateFlipType.RotateNoneFlipX)
movePlayer(DirectionFacing.RIGHT, 10)
End Select
End Sub
Again, we replaced the If Then Else statement with Select Case. If you are not supposed to do that, I believe it will be easy for you to revert and use If e.KeyCode = Keys.W OrElse e.KeyCode = Keys.Up Then ....
The Paint routine:
Private Sub draw(sender As Object, e As PaintEventArgs) Handles Me.Paint
Dim g As Graphics = e.Graphics()
g.DrawImage(dI, dIrect)
g.DrawImage(pI, pIrect)
End Sub
Finally, don't forget to clean up:
Private Sub Form1_FormClosed(sender As Object, e As FormClosedEventArgs) Handles Me.FormClosed
pI?.Dispose()
dI?.Dispose()
End Sub
Good luck
I'm coding Conway's game of life. My grid is entirely in a picture box but when I load the form the back button in the upper right is completely white. Refreshing the form fixes the button but makes it incredibly laggy. Every other button shows up fine, just the back button is broken. How can I fix this?
Option Strict On
Public Class frmGame
' Declaring public variables
Public bmp As Bitmap
Public G As Graphics
Public WithEvents speed As Timer
Public grid(50, 40) As Boolean
Public input(50, 40) As Boolean
Public intGens As Integer = 0
Public change As Boolean = False
Public P As New Pen(Color.Black)
Private Sub picGrid_Paint(sender As Object, e As PaintEventArgs) Handles picGrid.Paint
' Loads bitmap, graphics, etc and prepares to begin simulation
' Creates graphics device
bmp = New Bitmap(600, 480)[enter image description here][1]
picGrid.Image = bmp
G = Graphics.FromImage(bmp)
' Defining variables for grid
Dim x As Integer = 0
Dim y As Integer = 0
' Draws grid
For y = 0 To 480
For x = 0 To 600
G.DrawRectangle(pen:=P, x:=x, y:=y, width:=12, height:=12)
x += 12
Next
x = 0
y += 12
Next
End Sub
Private Sub btnBack_Click(sender As Object, e As EventArgs) Handles btnBack.Click
' Hides rules form, shows main menu form
frmMainMenu.Show()
Me.Hide()
End Sub
Private Sub frmGame_FormClosed(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosedEventArgs) Handles Me.FormClosed
' Frees memory when form is closed
G.Dispose()
bmp.Dispose()
speed.Dispose()
End Sub
End Class
I'm not exactly sure do I understand your problem, nor I can recreate it with code provided.
But I can recommend some thing's that can help you.
First of all do not use Control.Refresh() while working with drawing, use instead Control.Invalidate() & Control.Update(), that may fix lag issue.
Do you relay need 2 forms (that i understand is the root of problem)?
Instead of hiding form, hide PictureBox (.Visible = False) and show other controls you need at that moment.
I am writing a simple test program that draws an axis/crosshair in a form. I have two text boxes, where I put in the x-center and y-center and draw the crosshair based on that. I want to be able to put in new coordinates, and move the crosshair to the new position, but when I do, the old drawing stays there. I want to erase the old drawing and then draw the new one.
My code is below:
Public Class Form1
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim mypen As Pen
mypen = New Pen(Drawing.Color.Red, 1)
Dim mygraphics As Graphics = Me.CreateGraphics
Dim x_center = Integer.Parse(xPos.Text)
Dim y_center = Integer.Parse(yPos.Text)
mygraphics.DrawLine(mypen, x_center - 50, x_center, x_center + 50, x_center)
mygraphics.DrawLine(mypen, y_center, y_center - 50, y_center, y_center + 50)
End Sub
End Class
The Drawing on a Control surface is usually handled through the Control's Paint() event, using its PaintEventArgs class object.
To raise the Paint() event of a Control, call its Invalidate() method.
(Note that the Invalidate() method has a number of overloads, some of which allows to re-paint only a defined region of the surface.)
If a Graphics object is created elsewhere (as you're doing now), the drawings performed with this object will persist or will be erased when you don't want to (e.g. if a Control needs to repaint itself - and this happens quite often - the drawings will be erased).
Also, the Graphics object can't be stored. It will become an invalid object as soon as a Control has repainted its surface.
You could re-design you code in this way.
Create a shared Pen (you can redefined it at any moment if you need to, using its properties) so you don't have to create a new one every time you need to draw something.
Use a shared Point field to store the current center of the drawing.
Move the Graphics.DrawLine() to the Paint event of your Form.
Remember to Dispose() the Pen object when the Form closes (you can use it's Dispose() pre-defined method).
Public Class Form1
Private mypen As Pen = New Pen(Color.Red, 1)
Private Position As Point = New Point(-1, -1)
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
If (Integer.TryParse(xPos.Text, Position.X) = True) AndAlso
(Integer.TryParse(yPos.Text, Position.Y) = True) Then
Me.Invalidate()
End If
End Sub
Private Sub Form1_Paint(sender As Object, e As PaintEventArgs) Handles MyBase.Paint
If Position.X > -1 Then
e.Graphics.DrawLine(mypen, Position.X - 50, Position.Y, Position.X + 50, Position.Y)
e.Graphics.DrawLine(mypen, Position.X, Position.Y - 50, Position.X, Position.Y + 50)
End If
End Sub
End Class
This is, however, not that much efficient, because you need to invalidate the entire Form.
For a full implementation, take a look a this Class (PasteBin - CrossHair).
I have code that makes a list of 11 circle objects and draws them to a picture box in a VB windows form. They are supposed to move across it and when they reach the end, restart at the beginning.
The circles get populated correctly, and move as they are supposed to, but after two cycles once they reach the end they disappear and don't reset to the beginning. Here is the code i am currently using.
Public Class frmContent
Private chocolatemark As New List(Of circlemark)
Public Sub frmContent_Load(sender As Object, e As EventArgs) Handles MyBase.Load
For i As Integer = 0 To 10
chocolatemark.Add(New circlemark(Rnd() * 630 + 1, Rnd() * 220 + 140))
Next
End Sub
Private Sub rndGen_Tick(sender As Object, e As EventArgs) Handles rndGen.Tick
picturebox.Invalidate()
End Sub
Private Sub picturebox_Paint(sender As Object, e As PaintEventArgs) Handles picturebox.Paint
For i As Integer = 0 To 10
chocolatemark(i).update()
chocolatemark(i).draw(e)
Next
End Sub
End Class
Public Class circlemark
Private pos As Point = New Point(0, 0)
Sub New(ByVal x As Double, ByVal y As Double)
pos.X = x
pos.Y = y
End Sub
Public Sub draw(ByRef e As PaintEventArgs)
e.Graphics.DrawEllipse(Pens.Red, pos.X, pos.Y, 5, 5)
End Sub
Public Sub update()
If pos.X < 640 Then
pos.X += globalvalue.speed
End If
If pos.X > 640 Then
pos.X = 0
End If
End Sub
End Class
Public Class globalvalue
Public Shared speed As Integer = 5
End Class
Does anyone know why this might be happening?
If pos.X < 640 Then
pos.X += globalvalue.speed
End If
If pos.X > 640 Then
pos.X = 0
End If
You created a black hole for the objects, one they can never escape from. Once the value reaches 640, they'll get stuck forever. Can't get higher, can't get back to 0. It should of course be >= 640.
This problem became hard to diagnose (although the debugger can easily show you) because you used a "magic number". 640 isn't actually the size of the picture box. So you couldn't see them being stuck. Never use magic numbers. PictureBox.ClientSize.Width is the correct value to use, minus the object size. Don't hard-code that either, turns in a fleck of dust on a "retina" display.
I have a module that generates fill out a System.Drawing.Graphics object.
I then try to print it with a event on my main form but the print preview comes out blank.
This is my print page
Private Sub MyPrintDocument_PrintPage(ByVal sender As System.Object, ByVal e As System.Drawing.Printing.PrintPageEventArgs) Handles MyPrintDocument.PrintPage
Dim MyGraphic As Graphics
MyPrintDocument.PrinterSettings.DefaultPageSettings.Margins.Top = 200
MyPrintDocument.PrinterSettings.DefaultPageSettings.Margins.Left = 100
MyPrintDocument.PrinterSettings.DefaultPageSettings.Margins.Right = 100
MyPrintDocument.PrinterSettings.DefaultPageSettings.Margins.Bottom = 75
MyGraphic = MyGrpahicPage
End Sub
MyGrpahicPage is the public graphics object my module fill out.
I think the problem is that you have to print to the Graphics object provided by the event argument, not another one that you may have hanging around. In other words, you need to draw on e.Graphics. The help page for PrintPageEventArgs.Graphics shows how this is supposed to work.
I found the way.
1. step: you must create thy MyGraphics in your form:
... Form declaration ...
Private GrBitmap As Bitmap
Private GrGraphics As Graphics
Dimm Withevents pd as new PrintDocument 'The withevents is important!
...
2. step: Anywhere (ig, in the formload sub, or in a buttonclick sub) :
GrBitmap = New Bitmap(Width, Height)
GrGraphics = Graphics.FromImage(GrBitmap)
...
(the Width and the Height values you must calculate by the content of the graphics)
3. step:
Complete the GrGraphics with any .DrawString, .DrawLine, etc. methods
4. step:
Create a sub of Printdocument:
Private Sub pd_PrintPage(sender As Object, ev As PrintPageEventArgs) Handles pd.PrintPage
ev.Graphics.DrawImage(Me.GrBitmap, New Point(0, 0))
End Sub