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




Reply With Quote
