Quantcast
Channel: VBForums - CodeBank - Visual Basic 6 and earlier
Viewing all articles
Browse latest Browse all 1449

[VB6] - Translation of the string to a number and vice versa.

$
0
0
VB6 functions for translation and verification 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.
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
' Перевод беззнакового целого числа из байтового представления в строку
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
' Перевод беззнакового целого числа из строкового представления в массив байт
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


Viewing all articles
Browse latest Browse all 1449

Trending Articles



<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>