Public BCD(0 To 12) As String ' 10 dígitos más los '3' signos, positivo negatvo y sin signo
' asignamos la matriz BCD de una vez ...para sucesivos usos
Private Sub Form_Load()
Call AsignarMatriz_BitBCD
End Sub
' se invoca en el load del formulario...
' se toman como valores decimales de '0' ó '1'
Public Sub AsignarMatriz_BitBCD()
BCD = Split("0000\0001\0010\0011\0100\0101\0110\0111\1000\1001\1100\1101\1111", "\") ' 0-9, +, -
' ahora añadimos la parte alta de cada valor mirar tabla de conversión, valores 30-39 ASCII corresponden a valores F0-F9 en EBCDIC:
for k= 0 to 11
BCD(k)="1111" & BCD(k)
next
' NOTA: también puedes desactivar este bucle y probar ...
End Sub
' los datos tomados de fichero y convertidos a cadena
' la cadena debe recibirse en este formato : "+xxxxx..." ó "-xxxxx..." cuando tiene signo y "xxxx..." si es sin signo, es decir, si es preciso ' debe filtrarse por otra rutina para añadirse el '+' a las cadenas que lo requieran
Public Function Convertir_DecimalaComp3(cadena As String, optional CerosAañadir as integer =0) As String
' si la cadena es sin signo, añadimos ahora el signo * delante sólo para tratar la cadena en el paso posterior
dim digno as string
signo= Left$(cadena, 1)
If signo <> "-" and signo <>"+" Then cadena = "*" & cadena
' llamamos a la conversión
cadena = ConvertirDecBin_ASCIIaEBCDIC(cadena)
' si necesitamos añadir 'ceros' a la izquierda es el momento de hacerlo'
for k =0 to CerosaAñadir
cadena= BCD(0) & cadena
next
' y lo devolvemos
Convertir_DecimalaComp3 =cadena
End Function
' trabajamos desde números decimales a binario como srting, tanto de entrada como salida
Private Function ConvertirDecBin_ASCIIaEBCDIC(cadena As String) As String
' las cadenas ya en esta rutina se deben recibir con el siguiente formato:
' "+xxxxx..." ó "-xxxxx..." "*xxxx..." es decir con el signo '+' '-' o sin signo '*' que hemos colocado a discreción, si es preciso ' debe filtrarse por otra rutina para añadirse tras ser tomado de fichero a las cadenas que lo requieran
Dim salida As String
' anulado pasamos directamente a binario ' Const menos = "D": Const mas = "C" ' ó "F"
Dim x As Byte
For k = 2 To Len(cadena) ' empezamos por el 2 carácter... el signo lo dejamos para el final
x = Int(Mid&(cadena, k, 1))
salida = salida & BCD(x)
Next
' añadimos el signo a la parte correspondiente
dim signo as string
signo= Left$(cadena, 1)
if signo="+" then
x=10
elseif signo="-" then
x=11
else
x=12
end if
salida = salida & BCD(x))
' ya tenemos convertido la cifra en formato binario pero como valor de string.
ConvertirDecHex_ASCIIaEBCDIC = salida
End Function