Hello everyone! Basic functions for translation and validation of numbers to strings (and back) is very uncomfortable in terms of the fact that there is a lot to write, and they have their "eat." We can write the numbers in the hexadecimal system or brackets in exponential notation, etc. On the one hand it is good, but on the other can be a challenge. I wrote two functions that convert decimal integers of unlimited dimension from one representation to another. Can be useful for example to display the (Setup) LARGE_INTEGER or any other large (very large scale) numbers. Can somehow make a module for arithmetic operations with such numbers.
Good luck!
Code:
Option Explicit
Private Declare Function GetMem2 Lib "msvbvm60" (Src As Any, Dst As Any) As Long
Private Sub Form_Load()
Dim Value() As Byte, Res As String
StrToUI "1234567891011121314151617181920", Value
Res = UIToStr(Value)
End Sub
' Convert unsigned integer from byte array to string (decimal system)
Private Function UIToStr(bValue() As Byte) As String
Dim i As Long, f As Boolean, loc() As Byte
loc = bValue
Do
i = Div10UI(loc)
UIToStr = CStr(i) & UIToStr
f = False
For i = UBound(loc) To 0 Step -1
If loc(i) Then f = True: Exit For
Next
Loop While f
End Function
' Convert unsigned integer (decimal system) from string to byte array.
Private Sub StrToUI(sValue As String, Out() As Byte)
Dim i As Long, lpStr As Long, v As Integer, b(0) As Byte
ReDim Out(0)
If Len(sValue) Then
lpStr = StrPtr(sValue)
For i = 0 To Len(sValue) - 1
GetMem2 ByVal lpStr, v
v = v - &H30
If v < 0 Or v > 9 Then Err.Raise 13: Exit Sub
b(0) = v
If i Then Mul10UI Out
AddUI Out, b()
lpStr = lpStr + 2
Next
Else: Err.Raise 5
End If
End Sub
Private Sub AddUI(Op1() As Byte, Op2() As Byte)
Dim i As Long, p As Long, o As Long, q As Long
If UBound(Op1) < UBound(Op2) Then ReDim Preserve Op1(UBound(Op2))
Do
If i <= UBound(Op2) Then o = Op2(i) Else o = 0
q = CLng(Op1(i)) + o + p
p = (q And &H100&) \ &H100
Op1(i) = q And &HFF
i = i + 1
Loop While CBool(o Or p) And i <= UBound(Op1)
If p Then ReDim Preserve Op1(i): Op1(i) = p
End Sub
Private Function Div10UI(Value() As Byte) As Long
Dim i1 As Long, i2 As Long, acc() As Byte, loc() As Byte, q As Long, p As Long
For i1 = 0 To (UBound(Value) + 1) * 8
Div10UI = (Div10UI * 2) Or p
If Div10UI < 10 Then p = 0 Else p = 1: Div10UI = Div10UI - 10
For i2 = 0 To UBound(Value)
q = (CLng(Value(i2)) * 2) Or p
p = (q And &H100) \ &H100
Value(i2) = q And &HFF&
Next
Next
End Function
Private Sub Mul10UI(Value() As Byte)
Dim i As Long, p As Long, q As Long
For i = 0 To UBound(Value)
q = (CLng(Value(i)) * 4 + Value(i)) * 2 + p
p = (q And &HFF00&) \ &H100
Value(i) = q And &HFF
Next
If p Then ReDim Preserve Value(i): Value(i) = p
End Sub