when i inpot Decimal numbers to textbox, the output will be one word
EX:
input:
textbox.text = 11311711511597105
output:
textbox.text = qussai
You should show us what you had tried.
The full code should be like this:
Module VBModule
Sub Main()
Dim output As String = DecimalToASCII("113117115115097105")
Console.WriteLine(output)
End Sub
Function DecimalToASCII(ByVal input As String) As String
Dim current As String = ""
Dim temp As Integer = 0
If input.Length Mod 3 <> 0 Then
Return "Wrong Input"
End If
For i As Integer = 0 To input.Length - 1 Step 3
temp = 0
For j As Integer = i To i + 2
temp *= 10
temp += CType(input(j).ToString(), Integer)
Next
current &= Chr(temp).ToString()
Next
Return current
End Function
End Module
Related
I making matrix calculator. so, Textbox_A contains vbCrLf and tries to put it in Array_A.
and I would like to put Array_A in Result Matrix.
It's like
Textbox_a:
(1 2 3)
(4 5 6)
[Matrix to Array]
Array_a(0)(0) = 1
Array_a(0)(1) = 2
Array_a(0)(2) = 3
Array_a(1)(0) = 4
...
I have done string splits through several articles, but changing them to integers causes many problems.
This picture is Matrix_A and result Matrix
I don't know if the size of your initial matrix, formatted as text, is fixed, but here is some code to help you get started. The code tries to calculate the number of columns and rows.
The actual code is in the TextToArray function, that takes as input as string formatted as you described:
(1 2 3) (cr/lf)
(4 5 6)
and outputs a two dimensional array. The Main sub is just used to call TextToArray and display results.
So, in your example, you should pass TextBox_A.Text to TextToArray
There is minimal error checking here - you should add more to validate that data entered are numbers (check the Integer.TryParse function) and that the number of columns is the same across lines.
Sub Main(args As String())
Dim myInput As String = "(1 2 3)" & vbCrLf & "(4 5 6)"
Dim ret As Integer(,) = TextToArray(myInput)
If ret IsNot Nothing Then
For i As Integer = 0 To ret.GetUpperBound(0) - 1
For n As Integer = 0 To ret.GetUpperBound(1) - 1
Console.WriteLine(i & "," & n & "=" & ret(i, n))
Next
Next
Else
Console.WriteLine("No results - wrong input format")
End If
Console.ReadLine()
End Sub
Private Function TextToArray(matrix As String) As Integer(,)
Dim noOfRows As Integer = matrix.Split(vbCrLf).Count
Dim noOfColumns As Integer = 0
If noOfRows > 0 Then
noOfColumns = matrix.Split(vbCrLf)(0).Split(" ").Count
End If
If noOfColumns > 0 And noOfRows > 0 Then
Dim ret(noOfRows, noOfColumns) As Integer
Dim lines As String() = matrix.Split(vbCrLf)
Dim row As Integer = 0
For Each line As String In lines
Dim col As Integer = 0
line = line.Replace("(", "")
line = line.Replace(")", "")
For Each s As String In line.Split(" ")
ret(row, col) = Integer.Parse(s)
col += 1
Next
row += 1
Next
Return ret
Else
Return Nothing
End If
End Function
This outputs:
0,0=1
0,1=2
0,2=3
1,0=4
1,1=5
1,2=6
my code is working i tried it separately but the problem here is that when i'm putting them together , the readkey or readline don't stop the program and the do loop is not working too, can someone take a look please thank in advance
Dim count As Integer
Dim first(5) As Integer
Dim temp As Integer
Dim answer As String
Sub Main()
Do
Console.WriteLine("Please enter your first number")
first(0) = Console.ReadLine
Console.WriteLine("Please enter your second number")
first(1) = Console.ReadLine
Console.WriteLine("Please enter your third number")
first(2) = Console.ReadLine
Console.WriteLine("Please enter your fourth number")
first(3) = Console.ReadLine
Console.WriteLine("Please enter your fifth number")
first(4) = Console.ReadLine
Console.WriteLine("Please enter your sixth number")
first(5) = Console.ReadLine
randomnumber()
Console.WriteLine("do you want to continue?")
answer = Console.ReadLine
Loop Until (answer = "n" Or answer = "No")
Console.ReadKey()
End Sub
Sub randomnumber()
Dim r As New List(Of Integer)
Dim rg As New Random
Dim rn As Integer
Dim arraywinner(5) As Integer
Do
rn = rg.Next(1, 40)
If Not r.Contains(rn) Then
r.Add(rn)
End If
Loop Until r.Count = 6
'store bane random value in array'
arraywinner(0) = r(0)
arraywinner(1) = r(1)
arraywinner(2) = r(2)
arraywinner(3) = r(3)
arraywinner(4) = r(4)
arraywinner(5) = r(5)
'print random numbers
count = 0
While count <= 5
Console.WriteLine("the randoms numbers are : " & arraywinner(count))
count = count + 1
End While
'look for the amount of number
temp = 0
For count1 As Integer = 0 To 5
For count2 As Integer = 0 To 5
If arraywinner(count1) = first(count2) Then
temp = temp + 1
End If
Next
Next
If temp = 1 Or temp = 0 Then
Console.WriteLine("You have got " & temp & " number")
Else
Console.WriteLine("You have got " & temp & " numbers")
End If
money(temp)
End Sub
Sub money(ByVal t1 As Integer)
'prend cash'
If temp = 6 Then
Console.WriteLine("Jackpot $$$$$$$$$$$$$")
ElseIf temp = 3 Then
Console.WriteLine(" money = 120")
ElseIf temp = 4 Then
Console.WriteLine("money = 500")
ElseIf temp = 5 Then
Console.WriteLine("money= 10,000")
Else
Console.WriteLine(" try next time")
End
End If
End Sub
You have two problems in money():
Sub money(ByVal t1 As Integer)
'prend cash'
If temp = 6 Then
Console.WriteLine("Jackpot $$$$$$$$$$$$$")
ElseIf temp = 3 Then
Console.WriteLine(" money = 120")
ElseIf temp = 4 Then
Console.WriteLine("money = 500")
ElseIf temp = 5 Then
Console.WriteLine("money= 10,000")
Else
Console.WriteLine(" try next time")
End
End If
End Sub
Your parameter is t1, but you're using temp in all of your code. As written, it will still work since temp is global, but you should either change the code to use t1, or not pass in that parameter at all.
Secondly, you have End in the block for 0, 1, or 2 matches. The End statement Terminates execution immediately., which means the program just stops. Get rid of that line.
There are so many other things you could change, but that should fix your immediate problem...
I moved all the display code to Sub Main. This way your Functions with your business rules code can easily be moved if you were to change platforms. For example a Windows Forms application. Then all you would have to change is the display code which is all in one place.
Module Module1
Private rg As New Random
Public Sub Main()
'keep variables with as narrow a scope as possible
Dim answer As String = Nothing
'This line initializes and array of strings called words
Dim words = {"first", "second", "third", "fourth", "fifth", "sixth"}
Dim WinnersChosen(5) As Integer
Do
'To shorten your code use a For loop
For index = 0 To 5
Console.WriteLine($"Please enter your {words(index)} number")
WinnersChosen(index) = CInt(Console.ReadLine)
Next
Dim RandomWinners = GetRandomWinners()
Console.WriteLine("The random winners are:")
For Each i As Integer In RandomWinners
Console.WriteLine(i)
Next
Dim WinnersCount = FindWinnersCount(RandomWinners, WinnersChosen)
If WinnersCount = 1 Then
Console.WriteLine($"You have guessed {WinnersCount} number")
Else
Console.WriteLine($"You have guessed {WinnersCount} numbers")
End If
Dim Winnings = Money(WinnersCount)
'The formatting :N0 will add the commas to the number
Console.WriteLine($"Your winnings are {Winnings:N0}")
Console.WriteLine("do you want to continue? y/n")
answer = Console.ReadLine.ToLower
Loop Until answer = "n"
Console.ReadKey()
End Sub
'Too much happening in the Sub
'Try to have a Sub or Function do only one job
'Name the Sub accordingly
Private Function GetRandomWinners() As List(Of Integer)
Dim RandomWinners As New List(Of Integer)
Dim rn As Integer
'Good use of .Contains and good logic in Loop Until
Do
rn = rg.Next(1, 40)
If Not RandomWinners.Contains(rn) Then
RandomWinners.Add(rn)
End If
Loop Until RandomWinners.Count = 6
Return RandomWinners
End Function
Private Function FindWinnersCount(r As List(Of Integer), WinnersChosen() As Integer) As Integer
Dim temp As Integer
For count1 As Integer = 0 To 5
For count2 As Integer = 0 To 5
If r(count1) = WinnersChosen(count2) Then
temp = temp + 1
End If
Next
Next
Return temp
End Function
Private Function Money(Count As Integer) As Integer
'A Select Case reads a little cleaner
Select Case Count
Case 3
Return 120
Case 4
Return 500
Case 5
Return 10000
Case 6
Return 1000000
Case Else
Return 0
End Select
End Function
End Module
This is my code to get right side of string specifying char separator and either to keep separator within string or not. Possibility also to specify if just last occurence of char separator or manually define it. My question is how to make same version but this time to get right side of string instead of left?
Public Shared Function GetLetSideStringByChar(splitterChar As String, searchingWord As String, keepCharAsWell As Boolean, lastindexof As Boolean, splitterCharPosition As Integer) As String
Dim index As Integer
Select Case lastindexof
Case False
index = GetNthIndex(searchingWord, splitterChar, splitterCharPosition)
Case True
index = searchingWord.LastIndexOf(splitterChar)
End Select
If index > 0 Then
If keepCharAsWell Then
searchingWord = searchingWord.Substring(0, index + splitterChar.Length)
Else
searchingWord = searchingWord.Substring(0, index)
End If
Else
searchingWord = String.Empty
End If
Return searchingWord
End Function
'jesli n separator nie odnalzeiony bedzie return -1, np jesli charseparator = . i damy n = 2 a word bedzie mial tlko jedna . to -1
Public Shared Function GetNthIndex(searchingWord As String, charseparator As Char, n As Integer) As Integer
Dim count As Integer = 0
For i As Integer = 0 To searchingWord.Length - 1
If searchingWord(i) = charseparator Then
count += 1
If count = n Then
Return i
End If
End If
Next
Return -1
End Function
I had written a code for your previous problem that you deleted.
To make the code more understandable I used an Enum to specify right or left:
Public Enum Direction
Left = 0
Right = 1
End Enum
then you can call the function like this:
Console.WriteLine(StringExtract("5345.342.323.323#$%", Direction.Right, 2, False))
Here the Seperator Index represents the dot number (starting at 1)
For Example:
648674.2327.12 first dot is 1 second is 2
And here is the function, I'm sure it could be shortened:
Public Function StringExtract(ByVal MyStr As String, ByVal Side As Direction, ByVal SeperatorIndex As Integer, ByVal SeperatorKeep As Boolean) As String
Dim MySubs() As String = MyStr.Split(".".ToCharArray, StringSplitOptions.RemoveEmptyEntries)
Dim IndexOfSplit As Integer
Dim MyResult As String = ""
If Side = Direction.Left Then
IndexOfSplit = SeperatorIndex - 1
For i As Integer = IndexOfSplit To 0 Step -1
MyResult = MyResult.Insert(0, MySubs(i) & ".")
Next
If SeperatorKeep = False Then
MyResult = MyResult.Remove(MyResult.LastIndexOf("."), 1)
End If
Else
IndexOfSplit = SeperatorIndex
For i As Integer = IndexOfSplit To MySubs.Length - 1
MyResult = MyResult & MySubs(i) & "."
Next
If SeperatorKeep = False Then
MyResult = MyResult.Remove(MyResult.LastIndexOf("."), 1)
Else
MyResult = "." & MyResult.Remove(MyResult.LastIndexOf("."), 1)
End If
End If
Return MyResult
End Function
Output example:
Input 1:
StringExtract("5345.342.323.323#$%", Direction.Right, 2, False)
Output 1:
323.323#$%
Input 2:
StringExtract("5345.342.323.323#$%", Direction.Right, 3, True)
Output 2:
.323#$%
Input 3:
StringExtract("4.34!2.3323.", Direction.Left, 2, True)
Output 3:
4.34!2.
PS: If anyone has any suggestions to shorten the function let me know I'm happy to learn.
I am trying to write an encryption program. The problem I am facing is that I am converting the text to ascii and then adding on the offset. However when it goes past the letter 'z' I want it to warp back to 'a' and go from there.
Sub enc()
Text = TextBox1.Text
finalmessage = ""
letters = Text.ToCharArray
offset = ComboBox1.SelectedItem
For x = LBound(letters) To UBound(letters)
finalmessage = finalmessage + Chr(Asc(letters(x)) + offset)
Next
TextBox2.Text = finalmessage
End Sub
I guess to make it easy to decode afterwards, you should to it somewhat in the line of base64 encoding, first encoding everything to a normalized binary string, then encode in the range you want (since using binary, it has to be something that fits with 2^X).
To match your range, i used a baseset of 32, and a simple encoding decoding example (a bit more verbose that it should be, perhaps)
Module Module1
Dim encodeChars As String = "abcdefghijklmnopqrstuvwxyzABCDEF" ' use 32 as a base
Function Encode(text As String) As String
Dim bitEncoded As String = ""
Dim outputMessage As String = ""
For Each ch As Char In text.ToCharArray()
Dim i As Integer = Convert.ToByte(ch)
bitEncoded &= Convert.ToString(i, 2).PadLeft(8, "0"c)
Next
While bitEncoded.Length Mod 5 <> 0
bitEncoded &= "0"
End While
For position As Integer = 0 To bitEncoded.Length - 1 Step 5
Dim range As String = bitEncoded.Substring(position, 5)
Dim index As Integer = Convert.ToInt32(range, 2)
outputMessage &= encodeChars(index).ToString()
Next
Return outputMessage
End Function
Function Decode(encodedText As String) As String
Dim bitEncoded As String = ""
Dim outputMessage As String = ""
For Each ch In encodedText
Dim index As Integer = encodeChars.IndexOf(ch)
If index < 0 Then
Throw New FormatException("Invalid character in encodedText!")
End If
bitEncoded &= Convert.ToString(index, 2).PadLeft(5, "0"c)
Next
' strip the extra 0's
While bitEncoded.Length Mod 8 <> 0
bitEncoded = bitEncoded.Substring(0, bitEncoded.Length - 1)
End While
For position As Integer = 0 To bitEncoded.Length - 1 Step 8
Dim range As String = bitEncoded.Substring(position, 8)
Dim index As Integer = Convert.ToInt32(range, 2)
outputMessage &= Chr(index).ToString()
Next
Return outputMessage
End Function
Sub Main()
Dim textToEncode As String = "This is a small test, with some special characters! Just testing..."
Dim encodedText As String = Encode(textToEncode)
Dim decodedText As String = Decode(encodedText)
Console.WriteLine(textToEncode)
Console.WriteLine(encodedText)
Console.WriteLine(decodedText)
If Not String.Equals(decodedText, textToEncode) Then
Console.WriteLine("Encoding / decoding failed!")
Else
Console.WriteLine("Encoding / decoding completed succesfully!")
End If
Console.ReadLine()
End Sub
End Module
this then gives the following output?
This is a small test, with some special characters! Just testing...
krugsCzanfzsayjaonwwcBdmebAgkCBufqqhoAlunaqhgBBnmuqhgCdfmnuwcBbamnugcCtbmnAgkCtteeqeuDltoqqhizltoruwCzzofyxa
This is a small test, with some special characters! Just testing...
Encoding / decoding completed succesfully!
I'm asking my users to enter a 4 - 6 digit numberic PIN. And I'd like to make sure users can't enter 0000 or 11111 or 333333. How can I check a string for 4 consecutive identical digits? I'm using vb.net.
See code snippet below:
Sub Main()
Dim a As String = "001111"
Dim b As String = "1123134"
Dim c As String = "1111"
Console.WriteLine(CheckConsecutiveChars(a, 4)) 'True => Invalid Pin
Console.WriteLine(CheckConsecutiveChars(b, 4)) 'False => Valid Pin
Console.WriteLine(CheckConsecutiveChars(c, 4)) 'True => Invalid Pin
Console.ReadLine()
End Sub
'maxnumber = maximum number of identical consecutive characters in a string
Public Function CheckConsecutiveChars(ByVal j As String, ByVal maxNumber As Integer) As Boolean
Dim index As Integer = 0
While ((index + maxNumber) <= j.Length)
If (j.Substring(index, maxNumber).Distinct.Count = 1) Then
Return True
End If
index = index + 1
End While
Return False
End Function
The method String.Distinct.Count() counts the number of distinct characters in a string. You cast your digit to a String and test for the number of different characters. If the result is 1 then the user has entered the same number.
Note: If you're using the Substring, you must check the length of the string first (is it long enough) to avoid exceptions.
This answer is similar to the accepted answer, but does not create lots of temporary strings in memory.
'maxnumber = maximum number of identical consecutive characters in a string
Public Function HasConsecutiveChars(ByVal j As String, ByVal maxNumber As Integer) As Boolean
Dim result As Boolean = False
Dim consecutiveChars As Integer = 1
Dim prevChar As Char = "x"c
For Each c in j
If c = prevChar Then
consecutiveChars += 1
If consecutiveChars >= maxNumber Then
result = True
Exit For
End If
Else
consecutiveChars = 1
End If
prevChar = c
Next
Return result
End Function