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
Related
enter image description herei am looking for this problem for very long time and I have found nothing about that... :( .
So, I have 2 .csv files. In the .csv file 1 are the listboxes and all of these listboxes have one number between 1 and 6. In the .csv file 2 are some tools like (audi, bmw) and the tools have one numer between 1 and 6 too.
Example:
.csv file 1
Listbox 1 (X,Y,Length,Width) category 1
Listbox 2 (X,Y,Length,Width) category 2
Listbox 3 (X,Y,Length,Width) category 3
.csv file 2
Mercedes category 1
BMW category 2
Audi category 3
So, I want compare the 2 .csv files and allow the listbox 2 for only BMW to drag and drop.
If I drop categroy 2 to category 1 in the listbox, it should be false.
Imports System.Windows.Forms
Imports System.IO
Public Class Form2
Private meineListBoxen As New List(Of ListBox)
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles Me.Load
Dim strZeilen() As String
Dim strFelder() As String
Dim strZeilen0() As String
Dim strZeilen2() As String = IO.File.ReadAllLines("K:\Ruebel_Andreas\Modellpflege\Datenerfassung.csv")
Dim strFelder1() As String
strZeilen = File.ReadAllLines("K:\Ruebel_Andreas\Modellpflege\listboxpflege.csv")
strZeilen0 = IO.File.ReadAllLines("K:\Ruebel_Andreas\Modellpflege\Spritzguss.csv")
For i As Integer = 1 To strZeilen.GetUpperBound(0)
strFelder = strZeilen(i).Split(";")
meineListBoxen.Add(New ListBox)
With meineListBoxen(i - 1)
.Left = strFelder(0)
.Top = strFelder(1)
.Width = strFelder(2)
.Height = strFelder(3)
End With
Me.Controls.Add(meineListBoxen(i - 1))
Me.meineListBoxen(i - 1).AllowDrop = True
AddHandler meineListBoxen(i - 1).MouseDown, AddressOf meineListbox_MouseDown
AddHandler meineListBoxen(i - 1).DragDrop, AddressOf meineListbox_DragDrop
AddHandler meineListBoxen(i - 1).DragEnter, AddressOf meineListbox_DragEnter
Next
For a As Integer = 0 To strZeilen0.GetUpperBound(0)
Me.meineListBoxen(1 - 1).Items.Add(strZeilen0(a).Substring(0, strZeilen0(a).IndexOf(";")))
Next
For j As Integer = 1 To strZeilen2.GetUpperBound(0)
strFelder1 = strZeilen2(j).Split(" ")
With meineListBoxen(j)
.Items.Add(strFelder1(4))
End With
For Each itm In meineListBoxen(j).Items
If meineListBoxen(1 - 1).Items.Contains(itm) Then meineListBoxen(1 - 1).Items.Remove(itm)
Next
Next
End Sub
Private Sub Form1_MouseMove(sender As Object, e As MouseEventArgs) Handles Me.MouseMove
Me.lblMaus.Text = "X: " & e.X & " , Y:" & e.Y
End Sub
Private source As ListBox
Private sourceIndex As Integer
Private Sub meineListbox_MouseDown(ByVal sendre As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs)
Dim aPoint As Point
Dim lbx As ListBox
Dim aIndex As Integer
lbx = CType(sendre, ListBox)
aPoint = New Point(e.X, e.Y)
aIndex = lbx.IndexFromPoint(aPoint)
Try
If aIndex <= 0 Then
source = lbx
sourceIndex = aIndex
lbx.DoDragDrop(lbx.Items(aIndex), DragDropEffects.All)
End If
Catch ex As Exception
MessageBox.Show("Bitte wählen Sie ein Werkzeug aus")
End Try
End Sub
Private Sub meineListbox_DragDrop(ByVal sender As System.Object,
ByVal e As System.Windows.Forms.DragEventArgs)
Dim lbx As ListBox
lbx = CType(sender, ListBox)
If Not source Is Nothing Then
source.Items.RemoveAt(sourceIndex)
End If
lbx.Items.Add(e.Data.GetData(DataFormats.Text))
End Sub
Private Sub meineListbox_DragEnter(ByVal sender As System.Object,
ByVal e As System.Windows.Forms.DragEventArgs)
If (e.Data.GetDataPresent(DataFormats.Text)) Then
e.Effect = DragDropEffects.All
Else
e.Effect = DragDropEffects.None
End If
End Sub
Private Sub cmdSave_Click(ByVal sender As Object, ByVal e As EventArgs) Handles Speichern.Click
Dim w As New IO.StreamWriter("K:\Ruebel_Andreas\Modellpflege\Datenerfassung.csv")
For i = 0 To meineListBoxen.Count - 1
w.WriteLine(meineListBoxen.Item(i))
Next
w.Close()
End Sub
Private Sub WerkzeugHinzufügen_Click(sender As Object, e As EventArgs) Handles WerkzeugHinzufügen.Click
Process.Start("K:\Ruebel_Andreas\Modellpflege\Spritzguss.csv")
End Sub
Private Sub StellplatzHinzufügen_Click(sender As Object, e As EventArgs) Handles StellplatzHinzufügen.Click
Process.Start("K:\Ruebel_Andreas\Modellpflege\listboxpflege.csv")
End Sub
End Class
Private Sub cmdSave_Click(ByVal sender As Object, ByVal e As EventArgs) Handles Speichern.Click
Using w As New StreamWriter("K:\Ruebel_Andreas\Modellpflege\Datenerfassung.csv")
For i = 0 To meineListBoxen.Count - 1
w.WriteLine(meineListBoxen.Item(i))
Next
End Using
End Sub
I find it odd that the Handles clause does not match the name of the method. The default would be Private Sub Speichern_Click
StreamWriter needs to be disposed. Using...End Using blocks will handle this even if there is an error.
Let's say you have 3 list boxes. Your loop will go from index 0 to index 2. WriteLine will call ToString on each item in the list of ListBox. I don't believe that a ListBox provides an implementation of ToString so you will get the fully qualified name of the object's type. I don't think you want this.
Private Sub cmdSave_Click(ByVal sender As Object, ByVal e As EventArgs) Handles Speichern.Click
Using w As New StreamWriter("K:\Ruebel_Andreas\Modellpflege\Datenerfassung.csv")
For Each LB As ListBox In meineListBoxen
For Each item As String In LB.Items
w.WriteLine(item)
Next
Next
End Using
End Sub
You can initialize your variables as you declare them and with Option Infer they will be strongly typed (only works for local variables.
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles Me.Load
Dim strZeilen2 = File.ReadAllLines("K:\Ruebel_Andreas\Modellpflege\Datenerfassung.csv")
Dim strZeilen = File.ReadAllLines("K:\Ruebel_Andreas\Modellpflege\listboxpflege.csv")
Dim strZeilen0 = File.ReadAllLines("K:\Ruebel_Andreas\Modellpflege\Spritzguss.csv")
For i = 1 To strZeilen.GetUpperBound(0) 'Why are skipping the first line?
Dim strFelder = strZeilen(i).Split(";"c)
Dim LB As New ListBox
With LB
.Left = CInt(strFelder(0))
.Top = CInt(strFelder(1))
.Width = CInt(strFelder(2))
.Height = CInt(strFelder(3))
.AllowDrop = True
.Name = "ListBox" & i 'In case you need to refer to the control be name
End With
If i = 1 Then
For a As Integer = 0 To strZeilen0.GetUpperBound(0)
LB.Items.Add(strZeilen0(a).Substring(0, strZeilen0(a).IndexOf(";")))
Next
End If
AddHandler LB.MouseDown, AddressOf meineListbox_MouseDown
AddHandler LB.DragDrop, AddressOf meineListbox_DragDrop
AddHandler LB.DragEnter, AddressOf meineListbox_DragEnter
'I fleshed out the control before adding to the collections
Controls.Add(LB)
meineListBoxen.Add(LB)
Next
For j = 1 To strZeilen2.GetUpperBound(0) 'Again skipping first line, perhaps it is a title line
Dim strFelder1 = strZeilen2(j).Split(" "c)
meineListBoxen(j).Items.Add(strFelder1(4)) 'You are skipping the first list box
For Each itm In meineListBoxen(j).Items
If meineListBoxen(0).Items.Contains(itm) Then
meineListBoxen(0).Items.Remove(itm)
End If
Next
Next
End Sub
No need to define a point, just pass the coordinates to the IndexFromPoint method. You can use DirectCast to get the ListBox since we are sure the sender is a ListBox. DirectCast skips some of the checks that CType does so the method so is a bit faster. I am not sure if the check on the value of aIndex is necessary. Exception handling is heavy and shouldn't be used for a simple value check.
Private Sub meineListbox_MouseDown(sender As System.Object, e As System.Windows.Forms.MouseEventArgs)
Dim lbx = DirectCast(sender, ListBox)
Dim aIndex = lbx.IndexFromPoint(e.X, e.Y)
If aIndex < 0 Then
MessageBox.Show("Bitte wählen Sie ein Werkzeug aus")
Else
source = lbx
sourceIndex = aIndex
lbx.DoDragDrop(lbx.Items(aIndex), DragDropEffects.All)
End If
End Sub
Use IsNot when checking for null objects.
Private Sub meineListbox_DragDrop(sender As System.Object, e As System.Windows.Forms.DragEventArgs)
Dim lbx = DirectCast(sender, ListBox)
If source IsNot Nothing Then
source.Items.RemoveAt(sourceIndex)
End If
lbx.Items.Add(e.Data.GetData(DataFormats.Text))
End Sub
Updating this label over and over will just slow things down. Delete this Sub.
'Private Sub Form1_MouseMove(sender As Object, e As MouseEventArgs) Handles Me.MouseMove
'lblMaus.Text = "X: " & e.X & " , Y: " & e.Y
'End Sub
I can't help more without correct data from your files. At one point, you are splitting by a semicolon and there aren't any in your sample data! The file content you showed is certainly not a CSV file.
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 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
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)
So I am using Visual Basic Power Packs to do some basic easy graphics. I have the ability to draw many lines where I need to, and also VB power packs allows me to select the actual lines I have drawn, but I don't know how to implement code for when I do actually select these lines.
Here is my code:
Imports Microsoft.VisualBasic.PowerPacks
Public Class Form1
Dim ptA, ptB As Point ' starting and ending point
Dim down = False
Dim lines As New List(Of LineShape)
Dim temp As LineShape ' temporary line to be drawn
Dim canvas As New ShapeContainer 'shape container
Private Sub Form1_MouseDown(sender As Object, e As MouseEventArgs) Handles MyBase.MouseDown
down = True
canvas.Parent = Me
temp = New LineShape
temp.Parent = canvas
ptA = New Point(e.X, e.Y)
temp.StartPoint = ptA
temp.EndPoint = ptA
End Sub
Private Sub Form1_MouseUp(sender As Object, e As MouseEventArgs) Handles MyBase.MouseUp
down = False
ptB = New Point(e.X, e.Y)
lines.Add(temp)
temp = Nothing
End Sub
Private Sub Form1_MouseMove(sender As Object, e As MouseEventArgs) Handles MyBase.MouseMove
If down = True Then
temp.X2 = e.X
temp.Y2 = e.Y
End If
End Sub
End Class
When I run and compile this, everytime I hold the mouse button down, move and release, I can draw a line. I can select the lines, I just don't know how to add code so that when I select it, it will do something. If someone could please help me I would greatly appreciate it. If someone could maybe just show me how to make a message box show up when a line is clicked with its starting and ending points.
I am creating a structural analysis program should allow a user to draw a building frame, then click on the lines and add properties such as the material it is made of and such.
Thank you very much!!
JD
Add a click handler to your temp Line...
Imports Microsoft.VisualBasic.PowerPacks
Public Class Form1
Dim ptA, ptB As Point ' starting and ending point
Dim down = False
Dim lines As New List(Of LineShape)
Dim temp As LineShape ' temporary line to be drawn
Dim canvas As New ShapeContainer 'shape container
Private Sub Form1_MouseDown(sender As Object, e As MouseEventArgs) Handles MyBase.MouseDown
down = True
canvas.Parent = Me
temp = New LineShape
temp.Parent = canvas
ptA = New Point(e.X, e.Y)
temp.StartPoint = ptA
temp.EndPoint = ptA
End Sub
Private Sub Form1_MouseUp(sender As Object, e As MouseEventArgs) Handles MyBase.MouseUp
down = False
ptB = New Point(e.X, e.Y)
AddHandler temp.Click, AddressOf LineClickHandler
lines.Add(temp)
temp = Nothing
End Sub
Private Sub Form1_MouseMove(sender As Object, e As MouseEventArgs) Handles MyBase.MouseMove
If down = True Then
temp.X2 = e.X
temp.Y2 = e.Y
End If
End Sub
Private Sub LineClickHandler(sender As Object, e As MouseEventArgs)
Dim MyLine As LineShape = DirectCast(sender, LineShape)
MsgBox("Start = " & MyLine.StartPoint.ToString & " End Point = " & MyLine.EndPoint.ToString)
End Sub
End Class