Tengo este código en un Button1Click que pretende convertir en número de octal a hexadecimal. El tema es que a partir del 16 en octal en adelante da resultado incorrecto y no se corregirlo. ¿Cómo se puede solventar el error?
Sub Button1Click(sender As Object, e As EventArgs)
'TXTOCT caja octal
'TXTHEX caja hexadecimal
Dim CANNUM, OCTBIN, BDIV, TextoBinario As String
Dim eTxt, TextoOctal As String
Dim Oct, t, OCTHEX As Long
Dim REVISAR, HOCT, HDIV As String
Dim p, Z, Y As Integer
BDIV = ""
HDIV = ""
Dim A(100) As Long
Oct = Clng(TXTOCT.text)
CANNUM = CStr(TXTOCT.text)
Z = 0
Do While Oct > 1
A(Z) = Oct Mod 2
BDIV = CStr(Oct \ 2)
Oct = Oct \ 2
Z = Z + 1
Loop
OCTBIN = CStr(A(0))
For p = 1 To Z - 1
OCTBIN = OCTBIN & A(p)
Next
TextoBinario = OCTBIN & BDIV
' Invierto el Texto de derecha a izquierda
eTxt = ""
For t = Len(TextoBinario) To 1 Step -1
If (Trim(TXTOCT.Text) = "1" And Len(TXTOCT.Text) = 1) Then
eTxt = "1"
Else
eTxt = eTxt & Mid(TextoBinario, CInt(t), 1)
End If
Next t
TXTHEX.Text = eTxt
Dim H(100) As Long
Dim K As Integer
Dim eHx(20) As String
eHx(12) = "A"
eHx(13) = "B"
eHx(14) = "C"
eHx(15) = "D"
eHx(16) = "E"
eHx(17) = "F"
OCTHEX = CLng(TXTOCT.text)
K = 0
Do While (OCTHEX > 17)
H(CInt(K)) = CLng(OCTHEX Mod 16)
HDIV = CStr(OCTHEX \ 16)
OCTHEX = OCTHEX \ 16
K = K + 1
Loop
HOCT = CStr(H(0))
Select Case HOCT
Case "12"
HOCT = "A"
Case "13"
HOCT = "B"
Case "14"
HOCT = "C"
Case "15"
HOCT = "D"
Case "16"
HOCT = "E"
Case "17"
HOCT = "F"
End Select
Select Case HDIV
Case "12"
HDIV = "A"
Case "13"
HDIV = "B"
Case "14"
HDIV = "C"
Case "15"
HDIV = "D"
Case "16"
HDIV = "E"
Case "17"
HDIV = "F"
End Select
For Y = 0 To K - 1
If Y > 0 Then
REVISAR = CStr(H(CInt(Y)))
Select Case CStr(REVISAR)
Case "12"
REVISAR = "A"
Case "13"
REVISAR = "B"
Case "14"
REVISAR = "C"
Case "15"
REVISAR = "D"
Case "16"
REVISAR = "E"
Case "17"
REVISAR = "F"
End Select
HOCT = HOCT & REVISAR
End If
Next
TextoOctal = HOCT & HDIV
' Invierto el Texto de derecha a izquierda
eTxt = ""
For t = Len(TextoOctal) To 1 Step -1
eTxt = eTxt & Mid(TextoOctal, CInt(t), 1)
If (CInt(Trim(TXTOCT.Text)) < 16) Then
eTxt = TXTOCT.Text
If (Len(TXTOCT.Text) = 2) Then eTxt = eHx(CInt(Trim(TXTOCT.Text)))
End If
Next t
TXTHEX.Text = eTxt
End Sub