I am currently solving a bug that will remove the created rectangle on the PictureBox. The problem is that when I click an Item on the PictureBox and Resize the windows form, the rectangle does not move on with the item selected. This is the code creating the rectangle:
Private Sub paintRectangle(pictBox As System.Windows.Forms.PictureBox, pic As Image)
If pic Is Nothing Then Exit Sub
pictBox.Image = pic
If m_rect_x = -1 And m_rect_y = -1 Then
Return
End If
Dim graphic As System.Drawing.Graphics
Dim redselpen As System.Drawing.Pen
Dim yNegative As Integer = 3
redselpen = New System.Drawing.Pen(Color.Blue)
redselpen.DashStyle = Drawing2D.DashStyle.DashDot
If pictBox.Image IsNot Nothing Then
graphic = System.Drawing.Graphics.FromImage(pictBox.Image)
graphic.DrawRectangle(redselpen, m_rect_x, m_rect_y - yNegative, SystemConfig.iRectWidth, SystemConfig.iRectHeight + 2)
pictBox.Image = pictBox.Image
End If
End Sub
After Resizing the Form, I want to remove the create a rectangle on the PictureBox.
I tried this solution but the Rectangle is still in the PictureBox.
How to remove all the drawn rectangles on the picture box? (Not on the image)
But it does not work, the rectangle is still in the picturebox.
Here's a simple example showing the Paint() event of a PictureBox being used to draw a rectangle that can be moved and turned on/off:
Public Class Form1
Private yNegative As Integer = 3
Private pt As New Nullable(Of Point)
Private drawRectangle As Boolean = False
Private Sub PictureBox1_Paint(sender As Object, e As PaintEventArgs) Handles PictureBox1.Paint
If drawRectangle AndAlso pt.HasValue Then
Using redselpen As New System.Drawing.Pen(Color.Blue)
redselpen.DashStyle = Drawing2D.DashStyle.DashDot
e.Graphics.DrawRectangle(redselpen, pt.Value.X, pt.Value.Y - yNegative, SystemConfig.iRectWidth, SystemConfig.iRectHeight + 2)
End Using
End If
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
pt = New Point(25, 25)
drawRectangle = True
PictureBox1.Invalidate()
End Sub
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
drawRectangle = Not drawRectangle ' toggle the rectangle on/off
PictureBox1.Invalidate()
End Sub
Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
pt = New Point(150, 25)
drawRectangle = True
PictureBox1.Invalidate()
End Sub
End Class
Related
I'm trying to create a simple game where my character has deal with a maze, in visual basic 2019
I cannot stop my character(picturebox) from passing through a wall(picturebox).
I have to say that I am far away from an expert and it's just an important project for school.
I tried this
Dim colliding As Boolean = False
For Each PictureBox In Me.Controls
If PictureBox1.Bounds.IntersectsWith(PictureBox.Bounds) Then
colliding = True
Else
colliding = False
End If
Next
and this
Dim colliding As Boolean = False
For Each PictureBox In Me.Controls
If PictureBox IsNot PictureBox1 AndAlso PictureBox21.Bounds.IntersectsWith(PictureBox.Bounds) Then
colliding = True
Else
colliding = False
End If
Next
in both attends I failed hard, and my character (picturebox1) can still pass through a wall
Code assumes that all PictureBoxes are DIRECTLY contained by the Form itself (they are not inside another container like a Panel), and that anything besides PictureBox1 is a wall:
Dim colliding As Boolean = False
For Each PB As PictureBox In Me.Controls.OfType(Of PictureBox)
If PB IsNot PictureBox1 Then
If PB.Bounds.IntersectsWith(PictureBox1.Bounds) Then
colliding = True
Exit For
End If
End If
Next
An alternate approach using a bit of LINQ:
Public Class Form1
Private Walls As New List(Of PictureBox)
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Walls = Me.Controls.OfType(Of PictureBox).Where(Function(pb) pb IsNot PictureBox1).ToList
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim colliding As Boolean = Walls.Any(Function(pb) pb.Bounds.IntersectsWith(PictureBox1.Bounds))
End Sub
End Class
Here is another option for dealing with the collision.
This assumes 4 buttons to move the 'character'
Private Enum MoveDirection
Left
Down
Right
Up
End Enum
Private Sub RightButton_Click(sender As Object, e As EventArgs) Handles RightButton.Click
MovePicBox(CharacterPicBox, MoveDirection.Right)
End Sub
Private Sub LeftButton_Click(sender As Object, e As EventArgs) Handles LeftButton.Click
MovePicBox(CharacterPicBox, MoveDirection.Left)
End Sub
Private Sub UpButton_Click(sender As Object, e As EventArgs) Handles UpButton.Click
MovePicBox(CharacterPicBox, MoveDirection.Up)
End Sub
Private Sub DownButton_Click(sender As Object, e As EventArgs) Handles DownButton.Click
MovePicBox(CharacterPicBox, MoveDirection.Down)
End Sub
Private Sub MovePicBox(PicBox As PictureBox, movement As MoveDirection)
'save the old location to move the pic box back if a clash occurs
Dim oldLocation As Point = PicBox.Location
Dim newLocation As Point
Dim stepSize As Integer = 50
'calculate new position
Select Case movement
Case MoveDirection.Down
newLocation.X = oldLocation.X
newLocation.Y = oldLocation.Y + stepSize
Case MoveDirection.Left
newLocation.X = oldLocation.X - stepSize
newLocation.Y = oldLocation.Y
Case MoveDirection.Up
newLocation.X = oldLocation.X
newLocation.Y = oldLocation.Y - stepSize
Case MoveDirection.Right
newLocation.X = oldLocation.X + stepSize
newLocation.Y = oldLocation.Y
End Select
'move the picture box
PicBox.Location = newLocation
'check if it has collided
For Each wallPicBox As PictureBox In Me.Controls.OfType(Of PictureBox)
If wallPicBox Is PicBox Then
Continue For
End If
If PicBox.Bounds.IntersectsWith(wallPicBox.Bounds) Then
'move it back
PicBox.Location = oldLocation
End If
Next
End Sub
I'm trying to autoscroll panel with an image using mousemove event simulating a dynamic zoom.
I found this example Pan/scroll an image in VB.NET and this Scroll panel based on mouse position in VB.NET but I realized that the user have to click on the image to drag it, so I tried to modify the code but doesn't work
This is what I tried:
Private m_PanStartPoint As New Point
Private Sub PictureBox2_MouseMove(sender As Object, e As MouseEventArgs) Handles PictureBox2.MouseMove
Dim DeltaX As Integer = (m_PanStartPoint.X - e.X)
Dim DeltaY As Integer = (m_PanStartPoint.Y - e.Y)
Panel1.AutoScrollPosition = New Point((DeltaX - Panel1.AutoScrollPosition.X), (DeltaY - Panel1.AutoScrollPosition.Y))
End Sub
Private Sub PictureBox2_MouseEnter(sender As Object, e As EventArgs) Handles PictureBox2.MouseEnter
PictureBox2.SizeMode = PictureBoxSizeMode.AutoSize
m_PanStartPoint = New Point(MousePosition)
End Sub
Private Sub PictureBox2_MouseLeave(sender As Object, e As EventArgs) Handles PictureBox2.MouseLeave
PictureBox2.SizeMode = PictureBoxSizeMode.StretchImage
End Sub
I also tried adding the event MouseHover:
Private Sub PictureBox2_MouseHover(sender As Object, e As EventArgs) Handles PictureBox2.MouseHover
m_PanStartPoint = New Point(MousePosition)
End Sub
if there is a way to do it without a panel, it would be better.
'The VB/XAML code below implements left mouse button click+hold scrolling and also works with touch screens. When using this code, put your frame/grid/image within a scrollviewer as shown below:
'XAML
<ScrollViewer x:Name="ScrollViewerObject" HorizontalScrollBarVisibility="Disabled" VerticalScrollBarVisibility="Hidden" ScrollViewer.CanContentScroll="False" PreviewMouseDown="Part_ScrollViewer_PreviewMouseDown" PreviewMouseMove="Part_ScrollViewer_PreviewMouseMove">
<Frame x:Name="PartViewer" NavigationUIVisibility="Hidden"/>
</ScrollViewer>
'VB
Dim LastScrollPos As Double = 0
Dim MouseStartPos AS Double = 0
Private Sub ScrollViewerObject_PreviewMouseDown(sender As Object, e As MouseButtonEventArgs)
Dim position As Point = Mouse.GetPosition(ScrollViewerObject)
ScrollViewerObject.UpdateLayout()
LastScrollPos = ScrollViewerObject.ContentVerticalOffset
MouseStartPos = position.Y
End Sub
Private Sub ScrollViewerObject_PreviewMouseMove(sender As Object, e As MouseEventArgs)
If Mouse.LeftButton = MouseButtonState.Pressed Then
Dim position As Point = Mouse.GetPosition(ScrollViewerObject)
ScrollViewerObject.ScrollToVerticalOffset(LastScrollPos + (position.Y - MouseStartPos))
End If
End Sub
Making a joke VB program that requires a button click to make a PictureBox very quickly switch between two pictures. I tried using the sleep command but nothing changes on screen. Here's what I've tried so far.
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
TransClass2.Image = My.Resources._21
System.Threading.Thread.Sleep(100)
TransClass2.Image = My.Resources._11
System.Threading.Thread.Sleep(100)
End Sub
TransClass2 is a class that inherits PictureBox. It's used to add transparent functionalities to PictureBoxes.
Public Class TransClass
Inherits PictureBox
Protected Overrides Sub OnPaintBackground(e As System.Windows.Forms.PaintEventArgs)
MyBase.OnPaintBackground(e)
If Parent IsNot Nothing Then
Dim index As Integer = Parent.Controls.GetChildIndex(Me)
For i As Integer = Parent.Controls.Count - 1 To index + 1 Step -1
Dim c As Control = Parent.Controls(i)
If c.Bounds.IntersectsWith(Bounds) AndAlso c.Visible = True Then
Dim bmp As New Bitmap(c.Width, c.Height, e.Graphics)
c.DrawToBitmap(bmp, c.ClientRectangle)
e.Graphics.TranslateTransform(c.Left - Left, c.Top - Top)
e.Graphics.DrawImageUnscaled(bmp, Point.Empty)
e.Graphics.TranslateTransform(Left - c.Left, Top - c.Top)
bmp.Dispose()
End If
Next
End If
End Sub
End Class
Mark the click handler as Async, then use Await Task.Delay():
Private Async Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
TransClass2.Image = My.Resources._21
Await Task.Delay(100)
TransClass2.Image = My.Resources._11
Await Task.Delay(100)
End Sub
I think 100 might be too fast!
I've been trying to create a code to simulate a queue for something(haven't got to that yet) for school and am trying to create multiple picture boxes and store them in a list. For some reason they are not appearing...anyone got any suggestions?
Public Class Form1
Dim peoples As New List(Of PictureBox)()
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Timer1.Enabled = True
Timer1.Interval = randomnumber(100, 500)
End Sub
Sub loopover()
Timer1.Interval = randomnumber(100, 500)
End Sub
Function randomnumber(lower As Integer, upper As Integer)
Randomize()
Return Int((upper * Rnd()) + lower)
End Function
Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
loopover()
newqueuemember()
End Sub
Private Sub newqueuemember()
Dim pictureBox As New PictureBox
pictureBox.Width = 50
pictureBox.Visible = True
pictureBox.Height = 50
Dim selectperson As Integer = randomnumber(1, 3)
If selectperson = 1 Then
pictureBox.Image = My.Resources.person1
ElseIf selectperson = 2 Then
pictureBox.Image = My.Resources.person2
Else
pictureBox.Image = My.Resources.person3
End If
pictureBox.Location = New Point(10, 20)
peoples.Add(pictureBox)
End Sub
End Class
Under:
peoples.Add(pictureBox)
add:
Me.Controls.Add(pictureBox)
Here's a C# reference (easily translated to VB):
https://support.microsoft.com/en-us/help/319266/how-to-programmatically-add-controls-to-windows-forms-at-run-time-by-u
Use a flow layout panel, Define the size (width, height) of the objects, then simply add them to the flow layout panel, you can even have a scrollbar if the length of the list of picture boxes is longer than the height of the panel.
FlowLayoutPanel1.controls.add(picturebox_object)
I have used the following code to draw what I want but when I used this code I cannot see the image I set on my picturebox. What should I do to draw on the picture box with an image? Please help me with this.
Public Class Form1
Dim draw As Boolean
Dim DrawColor As Color = Color.Black
Dim DrawSize As Integer = 6
Dim bmp As Bitmap
Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
cbxSize.SelectedIndex = 2
bmp = New Bitmap(pbDraw.Width, pbDraw.Height)
pbDraw.Image = bmp
Dim down = False
End Sub
Private Sub PaintBrush(X As Integer, Y As Integer)
Using g As Graphics = Graphics.FromImage(pbDraw.Image)
g.FillRectangle(New SolidBrush(DrawColor), New Rectangle(X, Y, DrawSize, DrawSize))
End Using
pbDraw.Refresh()
End Sub
Drawing event
Private Sub pbtest_MouseDown(sender As Object, e As System.Windows.Forms.MouseEventArgs) Handles pbDraw.MouseDown
draw = True
PaintBrush(e.X, e.Y)
End Sub
Private Sub pbtest_MouseMove(sender As Object, e As System.Windows.Forms.MouseEventArgs) Handles pbDraw.MouseMove
If draw = True Then
PaintBrush(e.X, e.Y)
End If
End Sub
Private Sub pbtest_MouseUp(sender As Object, e As System.Windows.Forms.MouseEventArgs) Handles pbDraw.MouseUp
draw = False
End Sub
Please help me