Contents Guide Contents

Home Page DigitalDan Home Page

---

This page explores the unusual functions in the blurred boundary bewtten numbers and text. The examples include - shuffling text, Roman Numerals and using words instead of numbers.
 
Private Function MeasureText(Testtext As String, TestFont As Font) As Size
Dim siz As New Size(10, 10)
If Testtext = "" Then Return siz
' add a bit for borders and variations in char widths
siz = TextRenderer.MeasureText(Testtext & " ", TestFont)
' Force the label to be a square
If siz.Width > siz.Height Then
siz.Height = siz.Width
Else
siz.Width = siz.Height
End If
Return siz
End Function

 
There is no equivilent to the number zero in Roman Numerals. A combination of inconsistent symbols and non-alphabetic symbols make Romans Numerals unsuitable for integers larger than 3999
 
Private Shared Function NumberToRoman(number As Integer, Optional lowercase As Boolean = False) As String
Dim arabic() As String = Split("1000,900,500,400,100,90,50,40,10,9,5,4,1", ",", 13)
Dim roman() As String = Split("M,CM,D,CD,C,XC,L,XL,X,IX,V,IV,I", ",", 13)
Dim i As Integer, result As String
result = ""
For i = 0 To 12
Do While number >= Val(arabic(i))
result += roman(i)
number -= CInt(Val(arabic(i)))
Loop
Next i
If lowercase Then result = result.ToLower
Return result
End Function
'
Private Shared Function RomanToNumber(roman As String) As Integer
' this tolerates most malformed roman variations and Roman Numerals are often malformed
' there is a speed penalty for tolerance but this is adequate for small sets of numerals
roman = roman.Replace(" ", "").ToUpper
If roman = "" Then Return 0
Dim ret As Integer = 0
Dim test As String
For i As Integer = 1 To Len(roman) - 1
test = Mid(roman, i, 2)
Select Case test
Case "IV", "IX", "IL", "IC", "ID", "IM" : ret -= 2 ' deduct 2 not 1 because 1 is added when next step also sees the I
Case "VX", "VL", "VC", "VD", "VM" : ret -= 10 ' only seen in malformed numerals
Case "XL", "XC", "XD", "XM" : ret -= 20 ' Often seen but often considered as malformed
Case "LC", "LD", "LM" : ret -= 100' only seen in malformed numerals
Case "CD", "CM" : ret -= 200' Often seen but often considered as malformed
Case "DM" : ret -= 1000 ' only seen in malformed numerals
End Select
Next
For Each c As Char In roman
Select Case c
Case "I"c : ret += 1
Case "V"c : ret += 5
Case "X"c : ret += 10
Case "L"c : ret += 50
Case "C"c : ret += 100
Case "D"c : ret += 500
Case "M"c : ret += 1000
End Select
Next
Return ret
End Function

 
British English and American English are not always identical. When expressing numbers as words, British-English will often include the word "and" but American-English does not use "and"
If you set theoptional Usa pearameter to true, this function will swicth from British-English to American-English
The NumberToWords fucntion requires the ThousandToText function provided at the end of this example.
 
Public Shared Function NumberToWords(num As Integer, Optional Usa As Boolean = False) As String
Dim unit, thousand, million As Integer
Dim answer As String = ""
If num > 999999999 Then num = 0
million = CInt(Int(num / 1000000))
thousand = CInt((Int(num / 1000) Mod 1000))
unit = num Mod 1000
If million > 0 Then answer &= Thousand2text(million, Usa) & " million"
If thousand > 0 Then answer &= ","
answer &= " "
If thousand > 0 Then answer &= Thousand2text(thousand, Usa) & " thousand"
If unit > 0 Then answer &= ","
answer &= " "
If unit > 0 Then answer &= Thousand2text(unit)
If num = 0 Then answer &= " zero"
answer = Replace(answer, " ", " ")
answer = Trim(answer)
Return answer
End Function
Private Shared Function Thousand2text(n As Integer, Optional Usa As Boolean = False) As String
Dim hundred As Integer = CInt(Int(n / 100))
Dim tens As Integer = n Mod 100
Dim words(20) As String
Dim ans As String = ""
Dim wordunits() As String = {"zero", "one", "two", "three", "four", "five", "six", "seven", "eight", "nine", "ten", "eleven", "twelve", "thirteen", "fourteen", "fifteen", "sixteen", "seventeen", "eighteen", "nineteen", "twenty"}
Dim wordtens() As String = {"zero", "ten", "twenty", "thirty", "fourty", "fifty", "sixty", "seventy", "eighty", "ninety", "hundred"}
If hundred > 0 Then ans = " " & wordunits(hundred) & " "
ans &= " hundred "
If tens > 0 Then
If Usa Then ans = " " Else ans = " and "
If tens < 20 Then
ans &= wordunits(tens)
Else
ans = wordtens(CInt(Int(tens / 10))) & " "
If tens Mod 10 > 0 Then
ans = wordunits(tens Mod 10) & " "
End If
End If
End If
Return ans
End Function

 
This uses the structure IntegerString which is included at the end of this example
 
Private Shared Function Shuffle(ListString As List(Of String)) As List(Of String)
Dim ListTemp As New List(Of IntegerString)
Dim temp As IntegerString
Dim rand As New Random(CInt(Date.Now.Ticks And Integer.MaxValue))
ListTemp.Clear()
For Each tmpString As String In ListString
temp.s1 = tmpString
temp.i1 = rand.Next(0, Integer.MaxValue)
ListTemp.Add(temp)
Next
ListTemp.Sort(Function(x, y) x.i1.CompareTo(y.i1))
ListString.Clear()
For Each temp In ListTemp
ListString.Add(temp.s1)
Next
Return ListString
End Function
'
Public Structure IntegerString
Dim i1 As Integer
Dim s1 As String
End Structure


---