taking average of 10 sample in vb2010 - vb.net

I have used below code to find average of 10 sample . But during first time it take sample and do the averaging . during next cycle counter not become Zero.and text box not updating
Static counter As Integer = 0
DIm average_sum As Double = 0
If counter < 10 Then
counter = counter + 1
Count_val.Text = counter
Dim array(10) As Double
For value As Integer = 0 To counter
array(counter) = k
average_sum = average_sum + array(counter)
Next
If counter = 10 Then
average_sum = average_sum / array.Count
System.Threading.Thread.Sleep(250)
Array_count.Text = average_sum
End If
If counter > 10 Then
average_sum = 0
counter = 0
End If
End If

If Avg_count < 10 Then
Dim array(10) As Double
For value As Double = 0 To Avg_count
array(Avg_count) = k
average_sum = average_sum + array(Avg_count)
Avg_count = Avg_count + 1
Next
If Avg_count = 10 Then
average_sum = average_sum / Avg_count
System.Threading.Thread.Sleep(250)
Average.Text = average_sum
Avg_count = 0
End If
End If
Here count value setting properly . But after 2 to3 cycle Average will done earlier itself same thing i writen in excel to compare averages but not matching with average and excel sheet data
Below is excel sheet code.Both code are in timer1 block.
If counter < 10 Then
'counter = 0
'average_sum = 0
Dim headerText = ""
Dim csvFile As String = IO.Path.Combine(My.Application.Info.DirectoryPath, "Current.csv")
If Not IO.File.Exists((csvFile)) Then
headerText = "Date,TIME ,Current, "
End If
Using outFile = My.Computer.FileSystem.OpenTextFileWriter(csvFile, True)
If headerText.Length > 0 Then
outFile.WriteLine(headerText)
End If
Dim date1 As String = "25-10-2014"
Dim time1 As String = TimeOfDay()
Dim x As String = date1 + "," + time1 + "," + distance
outFile.Write(x)
End Using
End If
If counter > 10 Then
counter = 0
End If

Related

Count lines not 0 found Textboxes

I want to calculate the amount in a multiline Textbox where the value 0 is not found.
If TxtListScanValue.Text = ("2") Then
TxtDrawR2.Text &= Environment.NewLine & lastDraw2
Dim ListScan = TxtNumberListScan.Lines.ToList.Select(Function(o, i) New With {.scan = o, .Index = i})
Dim DrawR2 = TxtDrawR2.Lines.ToList.Select(Function(o, i) New With {.draw = o, .Index = i})
Dim list2 = From a In ListScan From b In DrawR2 Where a.Index = b.Index Select LstScan = a.scan, DrwR2 = ("00" & b.draw).Substring(("00" & b.draw).Length - 2) Order By DrwR2 Descending
TxtListScanTxt.Text = String.Join(vbCrLf, list2)
End If
If TxtdrawR5 =
2
4
0
0
1
3
5
In output I want to display: 5 because:
I want to calculate the count lines where the value 0 is not found. Count lines no have 0 value :D (2+4+1+3+5 = 5) (5 lines no have 0 value).
You create function like this:
'For Counting
Private Function CountNonZero(ByVal TheCtrl As TextBox) As Integer
Dim myCnt As Integer = 0
For Each Content In TheCtrl.Lines
Dim ContentVal As Integer = 0
Integer.TryParse(Content, ContentVal)
If ContentVal <> 0 Then myCnt += 1
Next
Return myCnt
End Function
'For Counting
Private Function SummingNonZero(ByVal TheCtrl As TextBox) As Integer
Dim mySum As Integer = 0
For Each Content In TheCtrl.Lines
Dim ContentVal As Integer = 0
Integer.TryParse(Content, ContentVal)
If ContentVal <> 0 Then mySum += ContentVal
Next
Return mySum
End Function
And you can count or sum now:
dim TxtdrawR5Count as integer = CountNonZero(TxtdrawR5)
dim TxtdrawR5Sum as integer = SummingNonZero(TxtdrawR5)

Creating a Quick Sort in VB [duplicate]

Well, I have tried to complete a challenge that requires me to get all of the multiples of 5 or 3 from 0 to 1000 and then get the sum of them, I am new to vb.net so I thought that this would be a nice challenge for me to solve> I'm pretty sure I have the basics right, but I'm not quite sure why I'm getting this error :/.
Module Module1
Sub Main()
Dim Counter As Integer = 1
Dim Numbers() As Integer
Dim NumbersCounter As Integer = 0
Dim Total As Integer = 0
While (Counter <= 1000)
If (Counter Mod 3 = 0) Then
Numbers(NumbersCounter) = Counter '<--- The error is located on Numbers.
NumbersCounter = NumbersCounter + 1
Counter = Counter + 1
ElseIf (Counter Mod 5 = 0) Then
Numbers(NumbersCounter) = Counter
NumbersCounter = NumbersCounter + 1
Counter = Counter + 1
Else
Counter = Counter + 1
End If
End While
Counter = 0
While (Counter <= Numbers.Length)
If (Counter = 0) Then
Total = Numbers(Counter)
Counter = Counter + 1
Else
Total = Total * Numbers(Counter)
Counter = Counter + 1
End If
End While
PrintLine(Total)
End Sub
End Module
Any help or tips would be greatly appreciated! Thanks in advance.
You need to allocate memory to Numbers array and since the size is known initially you may allocate while declaring:
Dim Numbers(1000) As Integer
In looking over your code egghead is right in stating that you did not initialize your array. But after doing so I had to change a few other things in your code to get it to run.
Module Module1
Sub Main()
Dim Counter As Integer = 1
Dim Numbers(1000) As Integer 'Initialized the Array so it will be usable.
Dim NumbersCounter As Integer = 0
Dim Total As Integer = 0
While (Counter <= 1000)
If (Counter Mod 3 = 0) Then
Numbers(NumbersCounter) = Counter
NumbersCounter = NumbersCounter + 1
Counter = Counter + 1
ElseIf (Counter Mod 5 = 0) Then
Numbers(NumbersCounter) = Counter
NumbersCounter = NumbersCounter + 1
Counter = Counter + 1
Else
Counter = Counter + 1
End If
End While
Counter = 0
While (Counter <= Numbers.Length - 1) ' Arrays are zero based so you need to subtract 1 from the length or else you will overflow the bounds
If (Counter = 0) Then
Total = Numbers(Counter)
Counter = Counter + 1
Else
Total = Total + Numbers(Counter) 'You were multiplying here not adding creating a HUGE number
Counter = Counter + 1
End If
End While
Console.WriteLine(Total) 'Changed PrintLine which prints to a file to Console.WriteLine which writes to the screen
Console.ReadLine 'Added a Console.ReadLine so the Window doesn't close until you hit a key so you can see your answer
End Sub
End Module

Create BMP image with VBA

I tried to create a macro which converts value of cells into BMP file.
Code is based on existing topic, found here:
VBA manually create BMP
Type typHEADER
strType As String * 2 ' Signature of file = "BM"
lngSize As Long ' File size
intRes1 As Integer ' reserved = 0
intRes2 As Integer ' reserved = 0
lngOffset As Long ' offset to the bitmap data (bits)
End Type
Type typINFOHEADER
lngSize As Long ' Size
lngWidth As Long ' Height
lngHeight As Long ' Length
intPlanes As Integer ' Number of image planes in file
intBits As Integer ' Number of bits per pixel
lngCompression As Long ' Compression type (set to zero)
lngImageSize As Long ' Image size (bytes, set to zero)
lngxResolution As Long ' Device resolution (set to zero)
lngyResolution As Long ' Device resolution (set to zero)
lngColorCount As Long ' Number of colors (set to zero for 24 bits)
lngImportantColors As Long ' "Important" colors (set to zero)
End Type
Type typPIXEL
bytB As Byte ' Blue
bytG As Byte ' Green
bytR As Byte ' Red
End Type
Type typBITMAPFILE
bmfh As typHEADER
bmfi As typINFOHEADER
bmbits() As Byte
End Type
Sub testowy()
Dim bmpFile As typBITMAPFILE
Dim lngRowSize As Long
Dim lngPixelArraySize As Long
Dim lngFileSize As Long
Dim j, k, l, x As Integer
Dim bytRed, bytGreen, bytBlue As Integer
Dim lngRGBColoer() As Long
Dim strBMP As String
With bmpFile
With .bmfh
.strType = "BM"
.lngSize = 0
.intRes1 = 0
.intRes2 = 0
.lngOffset = 54
End With
With .bmfi
.lngSize = 40
.lngWidth = 21
.lngHeight = 21
.intPlanes = 1
.intBits = 24
.lngCompression = 0
.lngImageSize = 0
.lngxResolution = 0
.lngyResolution = 0
.lngColorCount = 0
.lngImportantColors = 0
End With
lngRowSize = Round(.bmfi.intBits * .bmfi.lngWidth / 32) * 4
lngPixelArraySize = lngRowSize * .bmfi.lngHeight
ReDim .bmbits(lngPixelArraySize)
ReDim lngRGBColor(21, 21)
For j = 1 To 21 ' For each row, starting at the bottom and working up...
'each column starting at the left
For x = 1 To 21
If Cells(j, x).Value = 1 Then
k = k + 1
.bmbits(k) = 0
k = k + 1
.bmbits(k) = 0
k = k + 1
.bmbits(k) = 0
Else
k = k + 1
.bmbits(k) = 255
k = k + 1
.bmbits(k) = 255
k = k + 1
.bmbits(k) = 255
End If
Next x
Next j
.bmfh.lngSize = 14 + 40 + lngPixelArraySize
End With ' Defining bmpFile
strBMP = "C:\Lab\xxx.BMP"
Open strBMP For Binary Access Write As 1 Len = 1
Put 1, 1, bmpFile.bmfh
Put 1, , bmpFile.bmfi
Put 1, , bmpFile.bmbits
Close
End Sub
The output differs significantly from my expectations (left - actual output, right - expected output).
There is a small error in code.
Colors at BMP file are saved as: [B,G,R] 1st pixel [B,G,R] 2nd pixel [0,0] padding (gap) for 4 byte alignment. To mirror the image the first loop should be reversed. The correct code (including loops) should be like:
k = -1
For j = 21 To 1 Step -1
' For each row, starting at the bottom and working up...
'each column starting at the left
For x = 1 To 21
If Cells(j, x).Value = 1 Then
k = k + 1
.bmbits(k) = 0
k = k + 1
.bmbits(k) = 0
k = k + 1
.bmbits(k) = 0
Else
k = k + 1
.bmbits(k) = 255
k = k + 1
.bmbits(k) = 255
k = k + 1
.bmbits(k) = 255
End If
Next x
If (21 * .bmfi.intBits / 8 < lngRowSize) Then ' Add padding if required
For l = 21 * .bmfi.intBits / 8 + 1 To lngRowSize
k = k + 1
.bmbits(k) = 0
Next l
End If
Next j

System.IndexOutOfRangeException in vb.net when using arrays

Well, I have tried to complete a challenge that requires me to get all of the multiples of 5 or 3 from 0 to 1000 and then get the sum of them, I am new to vb.net so I thought that this would be a nice challenge for me to solve> I'm pretty sure I have the basics right, but I'm not quite sure why I'm getting this error :/.
Module Module1
Sub Main()
Dim Counter As Integer = 1
Dim Numbers() As Integer
Dim NumbersCounter As Integer = 0
Dim Total As Integer = 0
While (Counter <= 1000)
If (Counter Mod 3 = 0) Then
Numbers(NumbersCounter) = Counter '<--- The error is located on Numbers.
NumbersCounter = NumbersCounter + 1
Counter = Counter + 1
ElseIf (Counter Mod 5 = 0) Then
Numbers(NumbersCounter) = Counter
NumbersCounter = NumbersCounter + 1
Counter = Counter + 1
Else
Counter = Counter + 1
End If
End While
Counter = 0
While (Counter <= Numbers.Length)
If (Counter = 0) Then
Total = Numbers(Counter)
Counter = Counter + 1
Else
Total = Total * Numbers(Counter)
Counter = Counter + 1
End If
End While
PrintLine(Total)
End Sub
End Module
Any help or tips would be greatly appreciated! Thanks in advance.
You need to allocate memory to Numbers array and since the size is known initially you may allocate while declaring:
Dim Numbers(1000) As Integer
In looking over your code egghead is right in stating that you did not initialize your array. But after doing so I had to change a few other things in your code to get it to run.
Module Module1
Sub Main()
Dim Counter As Integer = 1
Dim Numbers(1000) As Integer 'Initialized the Array so it will be usable.
Dim NumbersCounter As Integer = 0
Dim Total As Integer = 0
While (Counter <= 1000)
If (Counter Mod 3 = 0) Then
Numbers(NumbersCounter) = Counter
NumbersCounter = NumbersCounter + 1
Counter = Counter + 1
ElseIf (Counter Mod 5 = 0) Then
Numbers(NumbersCounter) = Counter
NumbersCounter = NumbersCounter + 1
Counter = Counter + 1
Else
Counter = Counter + 1
End If
End While
Counter = 0
While (Counter <= Numbers.Length - 1) ' Arrays are zero based so you need to subtract 1 from the length or else you will overflow the bounds
If (Counter = 0) Then
Total = Numbers(Counter)
Counter = Counter + 1
Else
Total = Total + Numbers(Counter) 'You were multiplying here not adding creating a HUGE number
Counter = Counter + 1
End If
End While
Console.WriteLine(Total) 'Changed PrintLine which prints to a file to Console.WriteLine which writes to the screen
Console.ReadLine 'Added a Console.ReadLine so the Window doesn't close until you hit a key so you can see your answer
End Sub
End Module

InvalidArgument=Value of '2' is not valid for 'index'

Dim group11_0_count = 0
Dim group11_1_count = 0
Dim group11_2_count = 0
Dim m As Integer = 0
Dim n As Integer = 0
Dim increment2 As Integer
For m = 0 To machings2.Items.Count - 1
For n = 0 To 3
If machings2.Items(m).ToString.Chars(n) = "1" Then
increment2 = increment2 + 1
End If
Next
If (increment2 = 0) Then
group11_0_count = group11_0_count + 1
group11_1_0.Items.Add(machings2.Items(m))
End If
If (increment2 = 1) Then
group11_1_count = group1_1_count + 1
group11_1_1.Items.Add(machings2.Items(m))
End If
If (increment2 = 2) Then
group11_2_count = group1_2_count + 1
group11_1_2.Items.Add(machings2.Items(m))
End If
increment2 = 0
Next
If (group11_0_count > 0 AndAlso group11_1_count > 0) Then
Dim result = ""
Dim index As Integer = 0
Dim gg As Integer = 0
Dim hh As Integer = 0
Dim i As Integer = 0
For hh = 0 To group11_1_count - 1
For gg = 0 To group11_0_count - 1
result = ""
index = 0
For i = 0 To 3
If group11_1_0.Items(gg).ToString.Chars(i) <> group11_1_1.Items(hh).ToString.Chars(i) Then
result &= "-"
index = index + 1
Else
result &= group11_1_0.Items(gg).ToString.Chars(i)
End If
Next
If (index = 1) Then
machings3.Items.Add(result)
End If
Next
Next
End If
I am comparing the items of two combobox items like that
combobox1 items
0000
combobox items
0001
0010
the result will be like that in machings3 combobox
000-
00-0
Here the differnce between two items indicated by - sign
But i am getting InvalidArgument=Value of '2' is not valid for 'index'.
I Can't make sense out of your source and where the IndexOutOfRangeException occurs. But you know that you need 3 Items in a Combobox to access Item with Index 2?! Every collection starts with 0.