One picture box shown many times in the same form - vb.net

My Goal is to create a maze in VS using VB.net, I currently have managed to make a random Generator that makes the "maze" and shows the location of the last wall made.
Horizontalwalls = Randomizer.Next(60, 91) 'Makes 60 - 90 Horizontal Walls
VirticalWalls = Randomizer.Next(60, 91) 'Makes 60 -90 Vertical Walls
Dim HLoops = 0 'counter for Horizontal walls
Dim VLoops = 0
lbxHorizontal.Items.Clear() 'empties the list box i have which stores the walls location
lbxvertical.Items.Clear()
Do While HLoops < (Horizontalwalls)
HLoops += 1 'adds to the counter
lbxHorizontal.Items.Insert(0, Randomizer.Next(0, 10))
lbxHorizontal.Items.Insert(0, Randomizer.Next(0, 10))
'Attempt at making visable walls
pbxhorizontalwall.Top = (lbxHorizontal.Items.Item(0) * GridSize - 2) 'This and next line puts the wall in desired location
pbxhorizontalwall.Left = (lbxHorizontal.Items.Item(1) * GridSize - 2)
Loop
however the only way i know to make all the walls visible is to make 90 horizontal wall pictures, go though naming them all, then GLaaa... there must be a easier way to copy the same image over the screen at the desired location.
At the moment, all i really want to know is the line of code that will copy the image (and maybe a way to mass clear them all when the maze is reset) and then i'll work out how to get it into place...

You first create the list of images with:
Dim imageList As New List(Of Bitmap)
imageList.Add("image to add") 'do it for all the images you have
Then create a bitmap:
Dim bitmapWall as Bitmap = New Bitmap(widthOfbitmap, heightofbitmap, Drawing.Imaging.PixelFormat.Format24bppRgb)
Draw the list of images to the bimap:
Dim objGraphics As Graphics = Graphics.FromImage(bitmapWall)
For i = 0 To imageList.Count
objGraphics.DrawImage(imageList(i), x, y, imageList(i).Width, imageList(i).Height)
Next
objGraphics.Dispose()
x,y is the coordinates of where your images are drawn (you should change them for every iteration)
Lastly:
Me.BackgroundImage = bitmapWall
Me.Invalidate()
Dont forget to dispose the list and the bitmap in the end.
valter

Related

Program first draws on invisible picturebox then picturebox becomes visible DESPITE Visibility supposed to c ome first then dynamic drawing

A snippet of my code:
Dim G As Graphics
Dim BBG As Graphics
Dim BB As Bitmap
Dim R As Rectangle
..................................................................
picMainScreen.Visible = True
G = picMainScreen.CreateGraphics
BB = New Bitmap(picMainScreen.Width, picMainScreen.Height)
For x = 0 To 256 * 3 - 1 Step 24
For y = 0 To 240 * 3 - 1 Step 24
R = New Rectangle(New Point(x, y), New Point(24, 24))
G.DrawRectangle(Pens.Black, R)
Next
Next
In this snippet of code, picMainScreen was a PictureBox that was originally not supposed to be visible.
Then through some conditions, picMainScreen was SUPPOSED to TURN Visible.
And THEN, the code draws all the rectangles onto the picture.
However, that isn't the case: the rectangles are first drawn onto the picture, and THEN the picture becomes visible.
Why does this happen? And what's the remedy?
Your rectangle instantiation is interesting since you are using two parameters of type Point.
R = New Rectangle(New Point(x, y), New Point(24, 24))
The Microsoft Docs show these parameter types;
Rectangle(Point, Size)
Initializes a new instance of the Rectangle class with the specified location and size.
https://learn.microsoft.com/en-us/dotnet/api/system.drawing.rectangle.-ctor?view=netframework-4.7.2
I'm not sure if the parameter types are the problem; however you are mixing drawing graphics with a picture control and they might not cohabitate in the same space well.
You could try calling DoEvents() after making the picture control visible to force it to be displayed first.

Notification When Screen is Flashing VB.Net

I would like a notification to be triggered when part the screen starts to flash. This notification can be a msgbox for now, but I will eventually evolve it into an audible sound.
The purpose of this is we have a dashboard that displays various cells throughout the company. When a cell needs assistance, its spot on the dashboard starts to flash. The cells are displayed in horizontally stackedboxes like this;
Cell 1
Cell 2
Cell 3
Ect...
I would like to build an application that scans the screen, lets say every second, and gets each cells pixel intensity.
The notification will be triggered if/when the cells pixel intensity changes each scan for three consecutive scans in a row (ie. the cell must be flashing).
I am hoping that you guys can help me find a way to scan the screen an return a regions average pixel intensity to which I can then replicate and do the comparison to find out if it is flashing.
Thank you in advance, I am using VB.Net.
I was able to accomplish what I was asking by using this:
Private Sub AvgColors(ByVal InBitmap As Bitmap)
Dim btPixels(InBitmap.Height * InBitmap.Width * 3 - 1) As Byte
Dim hPixels As GCHandle = GCHandle.Alloc(btPixels, GCHandleType.Pinned)
Dim bmp24Bpp As New Bitmap(InBitmap.Width, InBitmap.Height, InBitmap.Width * 3,
Imaging.PixelFormat.Format24bppRgb, hPixels.AddrOfPinnedObject)
Using gr As Graphics = Graphics.FromImage(bmp24Bpp)
gr.DrawImageUnscaledAndClipped(InBitmap, New Rectangle(0, 0,
bmp24Bpp.Width, bmp24Bpp.Height))
End Using
Dim sumRed As Int32
Dim sumGreen As Int32
Dim sumBlue As Int32
For i = 0 To btPixels.Length - 1 Step 3
sumRed += btPixels(i)
sumGreen += btPixels(i + 1)
sumBlue += btPixels(i + 2)
Next
hPixels.Free()
Dim avgRed As Byte = CByte(sumRed / (btPixels.Length / 3))
Dim avgGreen As Byte = CByte(sumGreen / (btPixels.Length / 3))
Dim avgBlue As Byte = CByte(sumBlue / (btPixels.Length / 3))
MsgBox(avgRed & vbCrLf & avgGreen & vbCrLf & avgBlue)
End Sub
Private Function Screenshot() As Bitmap
Dim b As Bitmap = New Bitmap(Screen.PrimaryScreen.Bounds.Width, Screen.PrimaryScreen.Bounds.Height)
Using g As Graphics = Graphics.FromImage(b)
g.CopyFromScreen(0, 0, 0, 0, b.Size, CopyPixelOperation.SourceCopy)
g.Save()
End Using
Return b
End Function
and from here I can just adjust the range of bitmap to what I need, add a timer to tick every second, and keep a variable to compare average RGB's to.
Most of the code found from here:
http://www.vbforums.com/showthread.php?776021-RESOLVED-Getting-Average-RGB-Color-Value-of-Entire-Screen

Picturebox will not display image

I'm writing a program that will create and load pictureboxs at run time. The problem is that they will not show up or display anything. Not sure what i'm doing wrong. i have checked and the full path for the images are correct.
Sub DrawScreen()
'Call g.DrawImage to draw whatever you want in here
Dim layers(Me.ListBox1.Items.Count) As PictureBox
For i = 0 To ListBox1.Items.Count - 1
'Create New Layer as picturebox
layers(i) = New PictureBox
layers(i).Parent = Me.picWatch
layers(i).BackColor = Color.Transparent
layers(i).Visible = True
Select Case ListBox1.Items(i)
Case "image"
'Debug.Print(ListofLayers(i).Full_Path)
layers(i).Image = Image.FromFile(ListofLayers(i).Full_Path)
layers(i).Top = ListofLayers(i).X
picWatch.Controls.Add(layers(i))
Case "shape"
'Dim g As Graphics
'g.DrawRectangle()
Case "text"
Dim g As Graphics = layers(i).CreateGraphics
g.DrawString(ListofLayers(i).Text, New Font("Arial", 12), Brushes.White, ListofLayers(i).X, ListofLayers(i).Y)
Case Else
Debug.Print(ListBox1.Items(i))
End Select
Next
Me.Refresh()
End Sub
You never add the picture boxes to the form. Call Me.Controls.Add():
Me.Controls.Add(layers(i))
And as already pointed out by LarsTech:
You seem to have a typo here:
layers(i).Top = ListofLayers(i).X
X is the coordinate for the control's horizontal position and is the same as .Left.
Y however is the coordinate for the control's vertical position, which is the same as .Top.
Using CreateGraphics is a bad idea. For starters, what you draw with it will get removed when the control is redrawn. And since you're not disposing it you'll also have memory leaks.
Subscribe to the Paint event for each picture box instead and do all drawing in there.
Finally, just a little note: Array declarations in VB.NET does not specify how many items there are to be in the array, but to what index the array should end at. And since arrays are zero-based, this:
Dim layers(Me.ListBox1.Items.Count) As PictureBox
...is equal to this:
Dim layers(0 To Me.ListBox1.Items.Count) As PictureBox
Thus the array will contain ListBox1.Items.Count plus one since what's inside the parentheses merely specify the lower and/or upper bound.
To create an array with the "correct" amount of items you should always specify the size minus one:
Dim layers(Me.ListBox1.Items.Count - 1) As PictureBox

VB .NET Nested For Loops with DrawRectangle = Lag and Vanish? (Read)

I have been working on a project and to make sure everything is working, I created a piece of code that Would fill my form with pixels.
For X As Integer = 0 To Me.Size.Width
For Y As Integer = 0 To Me.Size.Height
DrawPixel(Pens.BlueViolet, X, Y)
Y += 1
Next
X += 1
Next
Like a few pixels (Very very few in the left corner) get printed, then lag (wait cursor) ... then all the drawn pixels dissapear. Like it finished the drawing it's like "Lag? Okay I'll just make it vanish :P". I tried inserting a System.Threading.Thread.Sleep(10)but it just makes the program lag even more.
Anyone have ideas on why it doesn't finish drawing, or how i could add a small timedelay without thread.sleep or A Timer?
Also DrawPixel is a subroutine of my own:
Friend Sub DrawPixel(clr As Pen, x As Integer, y As Integer)
g.DrawRectangle(clr, New Rectangle(New Point(x, y), New Size(1, 1)))
End Sub
Ty
Paint in the paint event that will persist the drawing when the system repaints. Use the e.Graphics object not Me.CreateGraphics.

Find total overlap percent of multiple rectangles overlapping the same rectangle?

I've got a list of System.Drawing.RectangleF objects that all overlap the same RectangleF object. In my picture below, the 3 overlapping rectangles would be the pink, yellow, and red rectangles. My main rectangle in question is the light blue rectangle.
Second Image:
I know that with RectangleF objects I can use the Intersect() method that will return me another RectangleF object representing the overlap. But as far as I can tell, this only really works when comparing two rectangles.
My question is: How could I determine the TOTAL area/percentage (i.e. the combined total overlap of the red, yellow, and pink rectangles when compared to the light blue rectangle - but it would need to be smart enough to not count the area in which the red and yellow overlaps twice, and same for the pink and yellow)?
NOTE: The green lines represent the area I'm looking for, just the total area of the blue rectangle that is not visible.
UPDATE: I've added a 2nd image to further demonstrate what I'm looking for. In the second image, the presence of the burgundy rectangle should have no affect on the total percent covered because that area is already covered by the yellow and green rectangles.
OK I think I found a solution using a Region that seems to be working for both of my example images above:
Private Function TotalCoveredAreaPercent(ByVal oRectToCheck As RectangleF, ByVal oOverlappingRects As List(Of RectangleF)) As Double
Dim oRegion As New Region(oRectToCheck)
Dim dTotalVisibleArea As Double = 0
Dim dTotalCoveredArea As Double = 0
'now we need to exclude the intersection of our
'overlapping rectangles with our main rectangle:
For Each oOverlappingRect As RectangleF In oOverlappingRects
oRegion.Exclude(RectangleF.Intersect(oRectToCheck, oOverlappingRect))
Next
'now we have access to the non-overlapping
'rectangles that make up the visible area of our main rectangle:
Dim oVisibleRects As RectangleF()
oVisibleRects = oRegion.GetRegionScans(New Drawing2D.Matrix())
'add the area of the visible rectangles together
'to find the total visible area of our main rectangle:
For Each oVisibleRect As RectangleF In oVisibleRects
dTotalVisibleArea += AreaOf(oVisibleRect)
Next
Dim dPercentVisible As Double = dTotalVisibleArea / AreaOf(oRectToCheck) * 100
'percent covered is 100 - the visible percentage:
Return (100 - dPercentVisible)
End Function
This seems to be working pretty well, and is quite simple.
Here is my algorithm. The key point is that we are subtracting out overlaps of overlaps.
Dim baseRect As New RectangleF(10, 10, 20, 20)
Dim otherRectList As New List(Of RectangleF)
otherRectList.Add(New RectangleF(5, 5, 10, 10))
otherRectList.Add(New RectangleF(20, 20, 10, 10))
otherRectList.Add(New RectangleF(10, 5, 10, 10))
Dim overlapRectList As New List(Of RectangleF)
For Each otherRect As RectangleF In otherRectList
If RectangleF.Intersect(otherRect, baseRect) <> RectangleF.Empty Then
overlapRectList.Add(RectangleF.Intersect(otherRect, baseRect))
End If
Next
Dim totalArea As Single = 0
For Each overlapRect As RectangleF In overlapRectList
totalArea += overlapRect.Width * overlapRect.Height
Next
'Subtract out any overlaps that overlap each other
For i = 0 To overlapRectList.Count - 2
For j = i+1 To overlapRectList.Count - 1
If i <> j Then
If RectangleF.Intersect(overlapRectList(i), overlapRectList(j)) <> RectangleF.Empty Then
Dim dupeRect As RectangleF = RectangleF.Intersect(overlapRectList(i), overlapRectList(j))
totalArea -= dupeRect.Width * dupeRect.Height
End If
End If
Next
Next
I amended the code to take into account tcarvin's note. However, I have not plotted out the results on graph paper to see if this is fully correct. I will look at it as soon as I have additional time. Also note that I have not included any code to handle a situation with less than 2 intersections.