Runtime error message Index was outside the bounds of the array. for Visual Basic 2010 - vb.net

I am computing the ROI with a moving rectangle and extracting the ROI to compute the standard deviation, mean, area and Pixel value coordinates X and Y in a seperate form2 by clicking the mouse. At this juncture I am trying to pass a function from the main Form that loads the Image and displays the rectangle to another Form that has the displayed properties of the mean and standard deviation etc. However, I'm receiving errors in runtime in the function that contains the standard deviation. The error displayed is
Index was outside the bounds of the array.
It is displayed at the end of this portion of the code in the function StD, i.e at the end of the mean part'
SD(count) = Double.Parse(pixelcolor.R) + Double.Parse(pixelcolor.G) + Double.Parse(pixelcolor.B) - mean
what is this actually saying and how can I fix this situation. Any tips and ideas, thanks.
My code is at the bottom
enterPublic Function StD(ByVal image As Bitmap, ByVal mean As Double, ByVal meancount As Integer) As Double
Dim SD(SquareHeight * SquareWidth) As Double
Dim count As Integer = 0
For i = 0 To SquareWidth
For j = 0 To SquareHeight
Dim pixelcolor As Color = image.GetPixel(i, j)
SD(count) = Double.Parse(pixelcolor.R) + Double.Parse(pixelcolor.G) + Double.Parse(pixelcolor.B) - mean
count += 1
Next
Next
Dim SDsum As Double = 0
For i = 0 To count
SDsum = SDsum + SD(i)
Next
SDsum = SDsum / (SquareHeight * SquareWidth)
SDsum = ((SDsum) ^ (1 / 2))
Return SDsum
End Function code here
I would like to pass this using the code below
enterPrivate Sub PictureBox1_MouseDown(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseDown
Dim mean As Double = 0
Dim meancount As Integer = 0
Dim bmap As New Bitmap(400, 400)
bmap = PictureBox1.Image
Dim colorpixel As Color = bmap.GetPixel(e.X, e.Y)
' Dim pixels As Double = colorpixel.R + colorpixel.G + colorpixel.B
If e.Button = Windows.Forms.MouseButtons.Left AndAlso Rect.Contains(e.Location) Then
If (PictureBox1.Image Is Nothing) Or (PictureBox1.Height - (e.Y + SquareHeight) < 0) Or (PictureBox1.Width - (e.X + SquareWidth) < 0) Then
Else
Dim ROI As New Bitmap(400, 400)
Dim x As Integer = 0
Dim countx As Integer = 0
Dim county As Integer = 0
For i = e.X To (e.X + SquareWidth)
For j = (e.Y + x) To (e.Y + SquareHeight)
Dim pixelcolor As Color = bmap.GetPixel(i, j)
ROI.SetPixel(countx, county, pixelcolor)
mean = mean + pixelcolor.R + pixelcolor.G + pixelcolor.B
county += 1
meancount += 1
Next
county = 0
countx += 1
x = x + 1
Next
mean = mean / (meancount * 3)
Dim SD = mean - 75
Dim area As Integer = (SquareHeight * SquareWidth)
Dim anotherForm As Form2
anotherForm = New Form2(mean, StD(bmap, mean, meancount), area, 34)
anotherForm.Show()
End If
End If
' Catch ex As Exception
' MessageBox.Show(ex.Message())
' End Try
End Sub code here
To be displayed with this code
enter Public Sub New(ByVal mean As Double, ByVal StD As Double, ByVal Area As Integer, ByVal pixel As Double)
MyBase.New()
InitializeComponent()
TextBox1.Text = mean.ToString()
TextBox2.Text = StD.ToString()
TextBox3.Text = Area.ToString()
TextBox4.Text = pixel.ToString()
End Sub code here

The problem probably is because of these lines:
For i = 0 To SquareWidth
For j = 0 To SquareHeight
Try using this instead:
For i = 0 To SquareWidth - 1
For j = 0 To SquareHeight - 1

Related

I need to increase the CPU usage of my program in VB.net

I have a program that take an image and changes it to 1 bit B&W. It uses Lockbyte software to make it faster. BUT, when running it, it takes over a minute to process one image. When looking at the CPU usage it is only 5% at most once it is running. Is there a way to get the computer to use more CPU time? The indicator is showing that the computer is running below 50%, as low as 25%.
I just had one DUH thought, I forgot to add the resizing function into my program. It should help but I know I need to make the conversion faster yet. The program will be used to do 100 to 300 images per batch.
Most other programs I have seen do a conversion within a few seconds per image. I would like to get to something like this too.
This is the program. Mostly cobbled together from samples. I only half understand it but can read it. Sorry to the contributors that I cannot give credit to them. I didn't keep track of them.
Public Class Form1
Public Shared Function ConvertTo1Bit(ByVal input As Bitmap) As Bitmap
Dim masks = New Byte() {&H80, &H40, &H20, &H10, &H8, &H4, &H2, &H1}
Dim output = New Bitmap(input.Width, input.Height, PixelFormat.Format1bppIndexed)
Dim data = New SByte(input.Width - 1, input.Height - 1) {}
Dim inputData = input.LockBits(New Rectangle(0, 0, input.Width, input.Height), ImageLockMode.[ReadOnly], PixelFormat.Format24bppRgb)
Try
Dim scanLine = inputData.Scan0
Dim line = New Byte(inputData.Stride - 1) {}
Dim y = 0
While y < inputData.Height
Marshal.Copy(scanLine, line, 0, line.Length)
For x = 0 To input.Width - 1
data(x, y) = CSByte((64 * (GetGreyLevel(line(x * 3 + 2), line(x * 3 + 1), line(x * 3 + 0)) - 0.5)))
Next
y += 1
scanLine += inputData.Stride
End While
Finally
input.UnlockBits(inputData)
End Try
Dim outputData = output.LockBits(New Rectangle(0, 0, output.Width, output.Height), ImageLockMode.[WriteOnly], PixelFormat.Format1bppIndexed)
Try
Dim scanLine = outputData.Scan0
Dim y = 0
While y < outputData.Height
Dim line = New Byte(outputData.Stride - 1) {}
For x = 0 To input.Width - 1
Dim j = data(x, y) > 0
Try
If j Then
line(x / 8) = line(x / 8) Or masks(x Mod 8)
End If
Catch ex As Exception
End Try
Dim [error] = CSByte((data(x, y) - (If(j, 32, -32))))
If x < input.Width - 1 Then data(x + 1, y) += CSByte((7 * [error] / 16))
If y < input.Height - 1 Then
If x > 0 Then data(x - 1, y + 1) += CSByte((3 * [error] / 16))
data(x, y + 1) += CSByte((5 * [error] / 16))
If x < input.Width - 1 Then data(x + 1, y + 1) += CSByte((1 * [error] / 16))
End If
Next
Marshal.Copy(line, 0, scanLine, outputData.Stride)
y += 1
scanLine += outputData.Stride
End While
Finally
output.UnlockBits(outputData)
End Try
Return output
End Function
Public Shared Function GetGreyLevel(ByVal r As Byte, ByVal g As Byte, ByVal b As Byte) As Double
Return (r * 0.299 + g * 0.587 + b * 0.114) / 255
End Function
Private Sub btBrowesIn_Click(sender As Object, e As EventArgs) Handles btBrowesIn.Click
FolderBrowserDialog1.ShowDialog()
tbInPic.Text = FolderBrowserDialog1.SelectedPath
End Sub
Private Sub btBrowesOut_Click(sender As Object, e As EventArgs) Handles btBrowesOut.Click
FolderBrowserDialog2.ShowDialog()
tbInPic.Text = FolderBrowserDialog2.SelectedPath
End Sub
Private Sub btGo_Click(sender As Object, e As EventArgs) Handles btGo.Click
Dim Infiles As Array
Dim opf As New OpenFileDialog
opf.Filter = "Choose Image(*.jpg;*.png;*.gif)|*.jpg;*.png;*.gif"
If opf.ShowDialog = DialogResult.OK Then
PictureBox1.Image = Image.FromFile(opf.FileName)
Dim MyBitmap As New Bitmap(PictureBox1.Image)
PictureBox2.Image = ConvertTo1Bit(MyBitmap)
End If
End Sub
End Class
The program will be used to do 100 to 300 images per batch.
You can process the images asynchronously. .Net provides several ways to do this: Async/Await, raw Tasks, ThreadPool, raw Threads, BackgroundWorker, probably more. Which is most appropriate here depends on the context of the application.

Is there a way to convert Pixel coordinates to Cartesian Coordinates in VB.net

I have a PictureBox that is sized 1096 x 1004 with the SizeMode set to StretchImage. I am able to get the coordinates of each pixel correctly(see code below) by factoring in the StrechImage effect on the pixel coordinates.
Now what I am trying to accomplish is converting those pixel coordinates to a Cartesian Coordinate to be able to graph. In the long run, I am going to take the Cartesian Coordinates and convert them to Polar Coordinates.
I have tried to convert the pixel coordinates to cartesian by using this method.
cartesianx = scalefactor*screenx - screenwidth / 2;
cartesiany = -scalefactor*screeny + screenheight / 2;
This method is not putting the origin at (0,0) in the center of the PictureBox. It seems to be setting the origin closer to the Upper Left of the PictureBox. Is there any idea as to what I am missing?
Below is my code to convert the image to BitMap and get those coordinates and scale them correctly.
Imports System.IO
Public Class HomePanel
Dim realX As Int32
Dim realY As Int32
Private Sub HomePanel_Load(sender As Object, e As EventArgs) Handles MyBase.Load
chartImageDisplay_box.Image = Image.FromFile("C:\Users\UserB\Desktop\test.jpg")
End Sub
Private Sub chartImageDisplay_box_MouseMove(sender As Object, e As MouseEventArgs) Handles chartImageDisplay_box.MouseMove
If (e.Button = MouseButtons.Left) Then
ShowCoords(e.X, e.Y)
End If
End Sub
Private Sub chartImageDisplay_box_MouseDown(sender As Object, e As MouseEventArgs) Handles chartImageDisplay_box.MouseDown
If (e.Button = MouseButtons.Left) Then
ShowCoords(e.X, e.Y)
Dim MyBitmap As Bitmap
MyBitmap = CType(chartImageDisplay_box.Image, Bitmap)
'Me.BackColor = MyBitmap.GetPixel(realX, realY)
rgbValue.Text = "RGB Value: " & MyBitmap.GetPixel(realX, realY).ToString()
End If
'printAllPixels()
End Sub
Private Sub ShowCoords(ByVal mouseX As Int32, ByVal mouseY As Int32)
Dim realW As Int32 = chartImageDisplay_box.Image.Width
Dim realH As Int32 = chartImageDisplay_box.Image.Height
Dim currentW As Int32 = chartImageDisplay_box.ClientRectangle.Width
Dim currentH As Int32 = chartImageDisplay_box.ClientRectangle.Height
Dim zoomW As Double = (currentW / CType(realW, Double))
Dim zoomH As Double = (currentH / CType(realH, Double))
Dim zoomActual As Double = Math.Min(zoomW, zoomH)
Dim padX As Double = If(zoomActual = zoomW, 0, (currentW - (zoomActual * realW)) / 2)
Dim padY As Double = If(zoomActual = zoomH, 0, (currentH - (zoomActual * realH)) / 2)
realX = CType(((mouseX - padX) / zoomActual), Int32)
realY = CType(((mouseY - padY) / zoomActual), Int32)
lblPosXval.Text = "X: " & If(realX < 0 OrElse realX > realW, "-", realX.ToString())
lblPosYVal.Text = "Y: " & If(realY < 0 OrElse realY > realH, "-", realY.ToString())
cartX.Text = "X: " 'Where to add the cart conversion for X
cartY.Text = "Y: " 'Where to add the cart conversion for Y
End Sub
'Writes all the pixels to a text file along with RGB values for each pixel
Public Sub printAllPixels()
Using writer As StreamWriter =
New StreamWriter("C:\Users\UserB\Desktop\Pixels.txt")
Dim MyBitmap As Bitmap
MyBitmap = CType(chartImageDisplay_box.Image, Bitmap)
For y = 0 To MyBitmap.Height - 1
For x = 0 To MyBitmap.Width - 1
writer.WriteLine("XY Coord: " & x & ", " & y & "; " & MyBitmap.GetPixel(x, y).ToString)
Next
Next
End Using
End Sub
End Class
I don't know if the content of the variable contains the right value but the formula should look more like this:
cartesianx = scalefactor * (screenx - (screenwidth / 2))
cartesiany = -scalefactor* (screeny - (screenheight / 2))
Translate to 0,0 add the scale factor then flip the y.
I believe I figured my question out. I was using the wrong value for my screenx and screeny. I was using the calculated scale value but I needed to just use the mouse event X and Y values.

Snake Game... Adding snake body function malfunctioning

I am writing a snake game in visual studio in visual basic.
The playing field is a 2D Array of PictureBoxes. My Snake is a 1D array as type Point. The snake array is called 'Snake'.
When the form loads, Snake(0) is set as New Point(1, 1). I have created a sub routine that moves the snake depending on the arrow key the user presses. This is under a timer. Snake(0) (The snake head) is set to equal Snake(0) + direction (direction is a variable altered by the arrow key that the user presses, eg. when up is pressed direction is set to x: 0 and y: -1)
When snake(0) hits a piece of food, the amount of elements in the snake array is set to the length of the array. EG(If snake(0) = foodPosition Then ReDim Preserve snake(snake.Length) End If)
I have created a loop, also under the timer, to make the body of the snake follow the head (eg. snake(2) = snake(1) and snake(1) = snake(0) but can't get it to work)
Code:
Public Class frmPlayfield
'Food Creating and Grow Snake Variables
Dim randF As New Random
Dim foodPointX As Integer = randF.Next(0, 32)
Dim foodPointY As Integer = randF.Next(0, 32)
'Play Field Variables
Dim playMaxWidth As Integer = 32
Dim playMaxHeight As Integer = 32
Dim boxSize As Integer = 16 'Size of PictureBox
Dim boxArray(,) As PictureBox 'PictureBox Array
'Snake Stuff Variable
Dim snake(1) As Point 'Snake array
Dim direction As New Point(1, 0) 'Direction for snake movement
Private Sub frmPlayfield_Load(sender As Object, e As EventArgs) Handles MyBase.Load
ReDim boxArray(playMaxWidth, playMaxHeight)
For x As Integer = 0 To playMaxWidth
For y As Integer = 0 To playMaxHeight
boxArray(x, y) = New PictureBox
boxArray(x, y).Width = boxSize
boxArray(x, y).Height = boxSize
boxArray(x, y).Top = y * boxSize
boxArray(x, y).Left = x * boxSize
boxArray(x, y).Visible = True
boxArray(x, y).BackColor = Color.White
boxArray(x, y).BorderStyle = BorderStyle.FixedSingle
Me.Controls.Add(boxArray(x, y))
Next
Next
Me.ClientSize = New Size((playMaxWidth + 1) * boxSize, (playMaxHeight + 1) * boxSize)
snake(0) = New Point(1, 1) 'Creates snake head
boxArray(foodPointX, foodPointY).BackColor = Color.Red
End Sub
Private Function createBox(x As Integer, y As Integer, bSize As Integer) As PictureBox
Dim tempBox As New PictureBox
tempBox.Width = bSize
tempBox.Height = bSize
tempBox.Top = y * bSize
tempBox.Left = x * bSize
tempBox.Visible = True
tempBox.BackColor = Color.White
tempBox.BorderStyle = BorderStyle.FixedSingle
Me.Controls.Add(tempBox)
Return tempBox
End Function
Private Sub Food()
If snake(0).X = foodPointX And snake(0).Y = foodPointY Then
ReDim Preserve snake(snake.Length) 'Increases the amount of elements in the snake array.
For j As Integer = 0 To 0
foodPointX = randF.Next(0, 32)
foodPointY = randF.Next(0, 32)
boxArray(foodPointX, foodPointY).BackColor = Color.Red
Next
End If
For h As Integer = snake.Length - 1 To snake.GetUpperBound(0)
snake(h) = snake(snake.Length - 2)
Next
End Sub
Private Sub CheckBoundsAndMovement()
For i As Integer = 0 To snake.GetUpperBound(0)
boxArray(snake(i).X, snake(i).Y).BackColor = Color.White 'Loop to change the whole snake black
Next
snake(1) = snake(0)
snake(0) = snake(0) + direction
If snake(0).X > playMaxWidth Then
snake(0).X -= (playMaxWidth + 1)
End If
If snake(0).X < 0 Then
snake(0).X += (playMaxWidth + 1)
End If 'Four If statements to check if the snake has gone outside the play area.
If snake(0).Y > playMaxWidth Then
snake(0).Y -= (playMaxWidth + 1)
End If
If snake(0).Y < 0 Then
snake(0).Y += (playMaxWidth + 1)
End If
For k As Integer = 0 To snake.GetUpperBound(0)
boxArray(snake(k).X, snake(k).Y).BackColor = Color.Black 'Loop to make the whole snake black
Next
End Sub
Private Sub timGameTick_Tick(sender As Object, e As EventArgs) Handles timGameTick.Tick
Food()
CheckBoundsAndMovement()
End Sub
Private Sub frmPlayfield_KeyDown(sender As Object, e As KeyEventArgs) Handles MyBase.KeyDown 'Subroutine for direction
Select Case (e.KeyCode)
Case Keys.Up
direction = New Point(0, -1)
Case Keys.Down
direction = New Point(0, 1)
Case Keys.Left
direction = New Point(-1, 0)
Case Keys.Right
direction = New Point(1, 0)
End Select
End Sub
End Class
This works fine after I eat the first piece of food. The snake of length 2 is increased to length 3. But when I eat another piece of food the end of the snake is left behind at the spot where the food was eaten.
Ok - It looks like I found the problems -
First off - you defined the snake array as Dim snake (1) As Point this created the array with two elements instead of 1
Next, in your Food sub, the loop to roll the pixels back along the snake should be done every time the snake moves, not just when food is eaten. So I moved it into the CheckBoundsAndMovement sub to replace line 4 of that sub which only copied the location of the head to the next point back rather than the whole snake. But of course trying to execute the loop when the length of the snake was only one pixel would result in an out of range exception on the array, so added an If statement to only execute the loop if the length of snake is more than 1.
Also the direction of the loop in your code was in increasing order. To do it properly it should be in decreasing order. This way, the loop overwrites the point representing the end of the tail with the next point forward and so on. Finally, the new location for the head is entered into snake(0)
So - here it is -
Public Class frmPlayfield
'Food Creating and Grow Snake Variables
Dim randF As New Random
Dim foodPointX As Integer = randF.Next(0, 32)
Dim foodPointY As Integer = randF.Next(0, 32)
'Play Field Variables
Dim playMaxWidth As Integer = 32
Dim playMaxHeight As Integer = 32
Dim boxSize As Integer = 16 'Size of PictureBox
Dim boxArray(,) As PictureBox 'PictureBox Array
'Snake Stuff Variable
Dim snake(0) As Point 'Snake array
Dim direction As New Point(1, 0) 'Direction for snake movement
Private Sub frmPlayfield_Load(sender As Object, e As EventArgs) Handles MyBase.Load
ReDim boxArray(playMaxWidth, playMaxHeight)
For x As Integer = 0 To playMaxWidth
For y As Integer = 0 To playMaxHeight
boxArray(x, y) = New PictureBox
boxArray(x, y).Width = boxSize
boxArray(x, y).Height = boxSize
boxArray(x, y).Top = y * boxSize
boxArray(x, y).Left = x * boxSize
boxArray(x, y).Visible = True
boxArray(x, y).BackColor = Color.White
boxArray(x, y).BorderStyle = BorderStyle.FixedSingle
Me.Controls.Add(boxArray(x, y))
Next
Next
Me.ClientSize = New Size((playMaxWidth + 1) * boxSize, (playMaxHeight + 1) * boxSize)
snake(0) = New Point(1, 1) 'Creates snake head
boxArray(foodPointX, foodPointY).BackColor = Color.Red
End Sub
Private Function createBox(x As Integer, y As Integer, bSize As Integer) As PictureBox
Dim tempBox As New PictureBox
tempBox.Width = bSize
tempBox.Height = bSize
tempBox.Top = y * bSize
tempBox.Left = x * bSize
tempBox.Visible = True
tempBox.BackColor = Color.White
tempBox.BorderStyle = BorderStyle.FixedSingle
Me.Controls.Add(tempBox)
Return tempBox
End Function
Private Sub Food()
If snake(0).X = foodPointX And snake(0).Y = foodPointY Then
ReDim Preserve snake(snake.Length)
foodPointX = randF.Next(0, 32)
foodPointY = randF.Next(0, 32)
boxArray(foodPointX, foodPointY).BackColor = Color.Red
End If
End Sub
Private Sub CheckBoundsAndMovement()
For i As Integer = 0 To snake.GetUpperBound(0)
boxArray(snake(i).X, snake(i).Y).BackColor = Color.White 'Loop to change the whole snake white
boxArray(snake(i).X, snake(i).Y).Update()
Next
If snake.Length > 1 Then
For i As Integer = snake.GetUpperBound(0) To 1 Step -1
snake(i) = snake(i - 1)
Next
End If
snake(0) = snake(0) + direction
If snake(0).X > playMaxWidth Then
snake(0).X -= (playMaxWidth + 1)
End If
If snake(0).X < 0 Then
snake(0).X += (playMaxWidth + 1)
End If 'Four If statements to check if the snake has gone outside the play area.
If snake(0).Y > playMaxWidth Then
snake(0).Y -= (playMaxWidth + 1)
End If
If snake(0).Y < 0 Then
snake(0).Y += (playMaxWidth + 1)
End If
For k As Integer = 0 To snake.GetUpperBound(0)
boxArray(snake(k).X, snake(k).Y).BackColor = Color.Black 'Loop to make the whole snake black
Next
End Sub
Private Sub timGameTick_Tick(sender As Object, e As EventArgs) Handles timGameTick.Tick
Food()
CheckBoundsAndMovement()
End Sub
Private Sub frmPlayfield_KeyDown(sender As Object, e As KeyEventArgs) Handles MyBase.KeyDown 'Subroutine for direction
Select Case (e.KeyCode)
Case Keys.Up
direction = New Point(0, -1)
Case Keys.Down
direction = New Point(0, 1)
Case Keys.Left
direction = New Point(-1, 0)
Case Keys.Right
direction = New Point(1, 0)
End Select
End Sub
End Class

Convert 1DPointArray into 2DPointArray

I started a new project which loads and saves tilesets in style of ini-datas.
The problem is now, that it loads the tiles into a 1d- list, which got copied sorted into a 1d-array.
Now I am trying to convert this sorted 1d-array into a 2d-array.
My try:
LoadedTiles.Sort(Function(p1, p2) (p1.Position.X.CompareTo(p2.Position.X)))
LoadedTiles.Sort(Function(p1, p2) (p1.Position.Y.CompareTo(p2.Position.Y)))
Dim currentArray(AmountTiles) As Tile
currentArray = LoadedTiles.ToArray
Dim lengthX, lengthY As Integer
Dim yAxis As Integer = currentArray(0).Position.Y
For Each p In currentArray
If Not p.Position.Y = yAxis Then
lengthX = (p.Position.X / p.Size.Width)
lengthY = (currentArray(currentArray.Length - 1).Position.Y / p.Size.Width)
Else
lengthX = (currentArray(currentArray.Length - 1).Position.X / p.Size.Width)
lengthY = 0
End If
Next
MapTiles = New Tile(lengthX, lengthY) {}
Dim ii As Integer
For x = 0 To lengthX
For y = 0 To lengthY
MapTiles(x, y) = currentArray(ii)
If Not ii >= currentArray.Length - 1 Then
ii += 1
End If
Next
Next
This gives a wrong output.
See picture below:
http://www.directupload.net/file/d/3690/pz8x98jr_png.htm
Is it possible to do it right?
Thanks alot!
The k-th element in a 1D array can correspond to row i=k/N and column j=k%N where N is the number of columns. The reverse is k=i*N+j
Ok guys, I got it ( =
Public Class Form1
Dim List As New List(Of Point)
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
List.Add(New Point(180, 360))
List.Add(New Point(180, 180))
List.Add(New Point(180, 540))
'Convert 1d to 2d
Dim count As Point = countXYAxis(List, 180)
MsgBox(count.ToString)
Dim p(count.X - 1, List.Count - 1) As Point
MsgBox(p.Length)
Dim rofl As Integer
For i = 0 To p.GetUpperBound(0)
For j = 0 To p.GetUpperBound(1)
p(i, j) = List(rofl)
If Not rofl >= List.Count - 1 Then
rofl += 1
End If
Next
Next
For Each t In p
MsgBox(t.ToString)
Next
End Sub
Private Function countXYAxis(ByVal pt As List(Of Point), ByVal size As Integer) As Point
Dim bufferY As New List(Of Integer)
Dim cP As New Point
For Each pts In pt
If Not bufferY.Contains(pts.Y) Then
bufferY.Add(pts.Y)
End If
Next
For i = 0 To pt.Count - 1
If pt(i).Y = bufferY(0) Then
Else
cP = New Point(pt(i).X / size, bufferY.Count)
End If
Next
Return cP
End Function
End Class

How can I go about adding a ProgressBar to this code which calculates CRC32 checksum in VB.NET?

Thanks for reading - I am using the class below to calculate the CRC32 checksum of a specified file.
My question is how would I go about reporting the progress of file completion (in %) to a progressbar on a different form. I have tried (i / count) * 100 under the New() sub but I am not having any luck, or setting the progress bar with it for that matter. Can anyone help?
Thanks in advance
Steve
Public Class CRC32
Private crc32Table() As Integer
Private Const BUFFER_SIZE As Integer = 1024
Public Function GetCrc32(ByRef stream As System.IO.Stream) As Integer
Dim crc32Result As Integer
crc32Result = &HFFFFFFFF
Dim buffer(BUFFER_SIZE) As Byte
Dim readSize As Integer = BUFFER_SIZE
Dim count As Integer = stream.Read(buffer, 0, readSize)
Dim i As Integer
Dim iLookup As Integer
Do While (count > 0)
For i = 0 To count - 1
iLookup = (crc32Result And &HFF) Xor buffer(i)
crc32Result = ((crc32Result And &HFFFFFF00) \ &H100) And &HFFFFFF
crc32Result = crc32Result Xor crc32Table(iLookup)
Next i
count = stream.Read(buffer, 0, readSize)
Loop
GetCrc32 = Not (crc32Result)
End Function
Public Sub New()
Dim dwPolynomial As Integer = &HEDB88320
Dim i As Integer, j As Integer
ReDim crc32Table(256)
Dim dwCrc As Integer
For i = 0 To 255
Form1.CRCWorker.ReportProgress((i / 255) * 100) 'Report Progress
dwCrc = i
For j = 8 To 1 Step -1
If (dwCrc And 1) Then
dwCrc = ((dwCrc And &HFFFFFFFE) \ 2&) And &H7FFFFFFF
dwCrc = dwCrc Xor dwPolynomial
Else
dwCrc = ((dwCrc And &HFFFFFFFE) \ 2&) And &H7FFFFFFF
End If
Next j
crc32Table(i) = dwCrc
Next i
'file complete
End Sub
End Class
'------------- END CRC32 CLASS--------------
'-------------- START FORM1 --------------------------
Private Sub CRCWorker_DoWork(ByVal sender As System.Object, ByVal e As System.ComponentModel.DoWorkEventArgs) Handles CRCWorker.DoWork
For i = CurrentInt To dgv.Rows.Count - 1
CRCWorker.ReportProgress(0, i & "/" & Total_Files)
Current_File_Num = (i + 1)
SetControlText(lblCurrentFile, Str(Current_File_Num) & "/" & Total_Files)
result = CheckFile(SFV_Parent_Directory & "\" & dgv.Rows(i).Cells(0).Value, dgv.Rows(i).Cells(1).Value)
Select Case result
Case 0 ' missing file
UpdateRow(i, 2, "MISSING")
'dgv.Rows(i).Cells(2).Value = "MISSING"
Missing_Files = Missing_Files + 1
SetControlText(lblMissingFiles, Str(Missing_Files))
Case 1 ' crc match
UpdateRow(i, 2, "OK")
' dgv.Rows(i).Cells(2).Value = "OK"
Good_Files = Good_Files + 1
SetControlText(lblGoodFiles, Str(Good_Files))
Case 2 'crc bad
UpdateRow(i, 2, "BAD")
' dgv.Rows(i).Cells(2).Value = "BAD"
Bad_Files = Bad_Files + 1
SetControlText(lblBadFiles, Str(Bad_Files))
End Select
If CRCWorker.CancellationPending = True Then
e.Cancel = True
Exit Sub
End If
Next
End Sub
Private Sub CRCWorker_ProgressChanged(ByVal sender As Object, ByVal e As System.ComponentModel.ProgressChangedEventArgs) Handles CRCWorker.ProgressChanged
Dim val As Integer = e.ProgressPercentage
ProgressBar2.Maximum = 100
ProgressBar2.Value = e.ProgressPercentage
Debug.Print(val)
End Sub
Function CheckFile(ByVal tocheck_filepath As String, ByVal expected_crc As String) As Integer 'returns result of a file check 0 = missing 1 = good 2 = bad
If File.Exists(tocheck_filepath) = False Then
Return 0 'return file missing
End If
Dim f As FileStream = New FileStream(tocheck_filepath, FileMode.Open, FileAccess.Read, FileShare.Read, 8192)
Dim c As New CRC32()
crc = c.GetCrc32(f)
Dim crcResult As String = "00000000"
crcResult = String.Format("{0:X8}", crc)
f.Close()
End Function
It appears your .ReportProgress() call is in the New() subroutine, which is the part that makes the lookup table for the CRC calculation. The New() subroutine is called once, before the main CRC routine. The main CRC routine is the one that takes up all the time and needs the progress bar.
Shouldn't the progress bar updating be in the GetCrc32() function? Something like this:
Public Function GetCrc32(ByRef stream As System.IO.Stream, _
Optional prbr As ProgressBar = Nothing) As UInteger
Dim crc As UInteger = Not CUInt(0)
Dim buffer(BUFFER_SIZE) As Byte
Dim readSize As Integer = BUFFER_SIZE
Dim left As Long = stream.Length
If Not (prbr Is Nothing) Then ' ProgressBar setup for counting down amount left.
prbr.Maximum = 100
prbr.Minimum = 0
prbr.Value = 100
End If
Dim count As Integer : Do
count = stream.Read(buffer, 0, readSize)
For i As Integer = 0 To count - 1
crc = (crc >> 8) Xor tbl((crc And 255) Xor buffer(i))
Next
If Not (prbr Is Nothing) Then ' ProgressBar updated here
left -= count
prbr.Value = CInt(left * 100 \ stream.Length)
prbr.Refresh()
End If
Loop While count > 0
Return Not crc
End Function
In Windows Forms BackgroundWorker Class is often used to run intensive tasks in another thread and update progress bar without blocking the interface.
Example of using BackgroundWorker in VB.Net
The problem is when you use use the form in your code without instantiating it Form1.CRCWorker.ReportProgress((i / 255) * 100) there is a kind of hidden "auto-instantiation" happening and new instance of Form1 is created each time.