: Code-technically, it could (I think) use a couple of optimizations
: for speed but it looks like it'll work!
I would be happy to know you'r suggestions.
: Just out of interest... this Thread is 14 months old. How did you
: ever come across it? :P
I needed a 16^15 hex conversor in VB6. This thread was the 3rd result in googling "vb6 hex overflow". I though it could help someone with the same problem.
: Looks fairly ok to me, but it's a bit hard(er) to understand for us
: that don't speak spanish.
Here's a "translation".I think it's right (Find & Replace)... Haven't test it.
Public Function Myhex(input_value) As String
Dim value As String
Dim c As Integer
Dim result As String
Dim vc As String
Dim i As Integer
value = input_value
For i = 16 To 0 Step -1
vc = my_power(16, i)
c = divide(value, vc)
result = result & myhexchar(c)
If c > 0 Then
value = subtract(value, multiply(vc, Trim(Val(c))))
End If
Next i
While Left$(result, 1) = "0" And Len(result) > 1
result = Mid$(result, 2, Len(result) - 1)
Wend
Myhex = result
End Function
Public Function myhexchar(ent) As String
Dim res As String
Select Case ent
Case 0 To 9: res = Trim(Str(ent))
Case 10 To 15: res = UCase(Chr$(ent + 87))
End Select
myhexchar = res
End Function
Function divide(dividend As String, divisor As String) As Integer
Dim ress As Integer
Dim mult As String
ress = 0
Do
ress = ress + 1
mult = multiply(divisor, Trim(Val(ress)))
Loop While Not (greaterthan(mult, dividend))
divide = ress - 1
End Function
Function greaterthan(x1 As String, x2 As String) As Boolean
If Len(x1) > Len(x2) Then
greaterthan = True
Exit Function
End If
If Len(x2) > Len(x1) Or x1 = x2 Then
greaterthan = False
Exit Function
End If
For i = 1 To Len(x1)
If Asc(Mid$(x1, i, 1)) < Asc(Mid$(x2, i, 1)) Then
greaterthan = False
Exit Function
ElseIf Asc(Mid$(x1, i, 1)) > Asc(Mid$(x2, i, 1)) Then
greaterthan = True
Exit Function
End If
Next i
greaterthan = True
End Function
Function subtract(minuend As String, subtrahend As String) As String
Dim result As String
Dim carried As Integer
Dim x, y As Integer
Dim i As Integer
carried = 0
For i = 1 To Len(minuend)
x = position(minuend, i)
y = position(subtrahend, i) + carried
If y > x Then
carried = 1
x = x + 10
Else
carried = 0
End If
result = Trim(Val(x - y)) & result
Next i
While Left$(result, 1) = "0" And Len(result) > 1
result = Mid$(result, 2, Len(result) - 1)
Wend
subtract = result
End Function
Function my_power(base As Integer, exponent As Integer) As String
Dim base_string As String
Dim temp As String
base_string = Trim(Str(base))
temp = "1"
If exponent = 0 Then GoTo final
For i = 1 To exponent
temp = multiply(temp, base_string)
Next i
final:
my_power = temp
End Function
Function multiply(xxx As String, yyy As String) As String
Dim a As String
Dim b As String
Dim c As String
Dim line(100) As String
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim tmp As Integer
Dim carried As Integer
Dim result As String
a = xxx
b = yyy
If Len(b) > Len(a) Then
c = a
a = b
b = c
End If
For i = 1 To Len(b)
line(i) = String(i - 1, "0")
carried = 0
For j = 1 To Len(a)
tmp = position(b, i) * position(a, j) + carried
carried = tmp \ 10
line(i) = Trim(Str(tmp Mod 10)) & line(i)
Next j
If carried > 0 Then line(i) = Trim(Str(carried)) & line(i)
Next i
carried = 0
For i = 1 To Len(b) + Len(a)
tmp = carried
For j = 1 To Len(a)
tmp = tmp + position(line(j), i)
Next j
carried = tmp \ 10
result = Trim(Str(tmp Mod 10)) & result
Next i
If Left$(result, 1) = "0" Then
result = Mid$(result, 2, Len(result) - 1)
End If
multiply = result
End Function
Function position(z As String, x As Integer) As Integer
If x > Len(z) Then
position = 0
Else
position = Val(Mid$(z, Len(z) - x + 1, 1))
End If
End Function
