Título: Recopilacion de Funciones con operaciones Binarias.
Publicado por: BlackZeroX en 5 Junio 2011, 08:07 am
Bueno ya sabemos que las funciones con operaciones binarias son mas rápidas y mas practicas a la hora de ejecutarse. La intención de este tema es que se creen una sola publicacion donde se pueden encontrar estas funciones de manera amena. ' // Para valores tipo Long Private Sub lSwap(ByRef lVal1 As Long, ByRef lVal2 As Long) ' // Intercambia {lVal1} por {lVal2} y {lVal2} a {lVal1} sin variable temporal lVal1 = lVal1 Xor lVal2 lVal2 = lVal2 Xor lVal1 lVal1 = lVal1 Xor lVal2 End Sub Private Function lIsNegative(ByRef lVal As Long) ' // Para cualquier valor que lVal pueda tomar. ' // Comprueba si lval es negativo. lIsNegative = (lVal And &H80000000) End Function Private Function iIsNegative(ByRef iVal As Integer) As Boolean ' // Para cualquier valor que iVal pueda tomar. ' // Comprueba si lval es negativo. iIsNegative = (iVal And 32768) End Function Private Sub iSwap(ByRef iVal1 As Integer, ByRef iVal2 As Integer) ' // Intercambia {iVal1} por {iVal2} y {iVal2} a {iVal1} sin variable temporal iVal1 = iVal1 Xor iVal2 iVal2 = iVal2 Xor iVal1 iVal1 = iVal1 Xor iVal2 End Sub Private Sub bSwap(ByRef iVal1 As byte, ByRef iVal2 As byte) ' // Intercambia {iVal1} por {iVal2} y {iVal2} a {iVal1} sin variable temporal iVal1 = iVal1 Xor iVal2 iVal2 = iVal2 Xor iVal1 iVal1 = iVal1 Xor iVal2 End Sub Function max(ByVal val1 As Long, ByVal val2 As Long) As Long If (val1 > val2) Then max = val1 Else max = val2 End If End Function Function min(ByVal val1 As Long, ByVal val2 As Long) As Long If (val1 > val2) Then min = val2 Else min = val1 End If End Function Function bSwapBit(ByVal myLong As Long, ByVal bit1 As Byte, ByVal bit2 As Byte) As Long ' Los bits se CUENTAS DE DERECHA A IZQUIERDA es decir: 31, 30, ... , 3, 2, 1, 0 ' Solo se admite rango 0 al 31. Dim aux As Long Dim mask As Long aux = max(bit1, bit2) bit2 = min(bit1, bit2) bit1 = aux ' max Debug.Assert (bit1 > 31) ' No se permiten numero mayores a 32 Debug.Assert (bit2 < 0) ' No se permiten valores negativos mask = Not ((2 ^ bit1) Or (2 ^ bit2)) aux = (2 ^ (bit1 - bit2)) bSwapBit = (myLong And mask) Or _ (myLong And (2 ^ bit1)) / aux Or _ (myLong And (2 ^ bit2)) * aux End Function
Si alguien se sabe mas y quiere aportarlas están en el lugar indicado. Temibles Lunas!¡.
Título: Re: Recopilacion de Funciones con operaciones Binarias.
Publicado por: BlackZeroX en 8 Junio 2011, 04:18 am
Public Function LongToByte(ByVal lVal As Long) As Byte() Dim bRet(0 To 3) As Byte bRet(3) = (lVal And &HFF000000) \ &H1000000 bRet(2) = (lVal And &HFF0000) \ &H10000 bRet(1) = (lVal And &HFF00&) \ &H100 bRet(0) = (lVal And &HFF) LongToByte = bRet End Function
Private sub ColorLongToRGB(ByVal LngColor As Long, ByRef OutRed As Byte, ByRef OutGreen As Byte, ByRef OutBlue As Byte) OutBlue = (LngColor And &HFF0000) \ &H10000 OutGreen = (LngColor And &HFF00&) \ &H100 OutRed = (LngColor And &HFF) End sub
Dulces Lunas!¡.
Título: Re: Recopilacion de Funciones con operaciones Binarias.
Publicado por: BlackZeroX en 10 Junio 2011, 04:14 am
Cambio rapido del signo a un valor dado N ( habitualmente: lval=(lval*(-1)) ) Private Sub lChangeSign(ByRef lVal As Long) ' // Para cualquier valor que lVal pueda tomar. ' // Cambia de signo a un numero( + a - y de - a +). lVal = ((Not lVal) + 1) End Sub ' // Para valores tipo Integer Private Sub iChangeSign(ByRef iVal As Integer) ' // Para cualquier valor que iVal pueda tomar. ' // Cambia de signo a un numero( + a - y de - a +). lVal = ((Not lVal) + 1) End Sub
Dulce sLunas!¡.
Título: Re: Recopilacion de Funciones con operaciones Binarias.
Publicado por: raul338 en 10 Junio 2011, 04:55 am
Le puse chincheta :P
No seria lo mismo (despreciando la velocidad) si en lugar de tener 2 firmas, una para long y otra para integer. Usar & en su lugar? (Mr Frog habria usado eso alguna vez)
Ej Sub xxx(ByRef val1&, ByRef val2&)
Título: Re: Recopilacion de Funciones con operaciones Binarias.
Publicado por: BlackZeroX en 10 Junio 2011, 06:57 am
& = as long, es lo mismo... http://wiki.elhacker.net/programacion/vb/4---principios-basicos Spyke1 - (Alias Mr. Frogs) me copio eso; pero ya entendí que mejor declaro bien y uso la técnica de declaración Hugara (o alguna nomenclatura simple pero concreta) en lugar de los signos al final de una variable, con excepciones por ejemplo en las funciones LongToByte y ColorLongToRGB la Mascara que se efectúa con &HFF00& para obtener los Bits deseados, tendría que ser una mascara tipo Long por ello se le pone el signo & ya que si no se le pone pasa a tratarse como un valor integer, solo para casos como estos se usa dicho signo. msgbox typename(&HFF00&) msgbox typename(&HFF00)
Dulces Lunas!¡.
Título: Re: Recopilacion de Funciones con operaciones Binarias.
Publicado por: BlackZeroX en 10 Junio 2011, 20:29 pm
. Alternativa a htons@Ws2_32 (API) (http://msdn.microsoft.com/en-us/library/ms738557(VS.85).aspx) http://foro.elhacker.net/programacion_visual_basic/vbsnippet_htons_replacement-t297824.0.html PAra quienes no lo entiendan o lo vean demasiado Revuelto el codigo original esta en esta web: http://www.xbeat.net/vbspeed/c_SwapEndian.htm ' by Mike D Sutton, Mike.Sutton@btclick.com, 20040914 Public Function SwapEndian08(ByVal dw As Long) As Long ' by Mike D Sutton, Mike.Sutton@btclick.com, 20040914 SwapEndian08 = _ (((dw And &HFF000000) \ &H1000000) And &HFF&) Or _ ((dw And &HFF0000) \ &H100&) Or _ ((dw And &HFF00&) * &H100&) Or _ ((dw And &H7F&) * &H1000000) If (dw And &H80&) Then SwapEndian08 = SwapEndian08 Or &H80000000 End Function
Public Function htons(ByVal lPort As Long) As Integer htons = ((((lPort And &HFF000000) \ &H1000000) And &HFF&) Or ((lPort And &HFF0000) \ &H100&) Or ((lPort And &HFF00&) * &H100&) Or ((lPort And &H7F&) * &H1000000) Or (IIf((lPort And &H80&), &H80000000, &H0)) And &HFFFF0000) \ &H10000 End Function
Dulces Lunas!¡.
Título: Re: Recopilacion de Funciones con operaciones Binarias.
Publicado por: BlackZeroX en 13 Agosto 2011, 07:21 am
macro de C/C++ muy usada con el API SendMessage(). Function makelParam(ByVal L As Integer, ByVal U As Integer) As Long makelParam = L Or (U * &H10000) End Function
Dulces Lunas!¡.
Título: Re: Recopilacion de Funciones con operaciones Binarias.
Publicado por: BlackZeroX en 14 Agosto 2011, 02:52 am
. Recreacion de la funcion isNumeric(), empleando operaciones a nivel Bit IsNumeric() (http://foro.elhacker.net/programacion_visual_basic/reto_reemplazo_de_funcion_isnumeric-t336067.0.html;msg1651317#msg1651317) Variable lData.. Por que no usar Dim byData(3) as byte y quitar las mascaras de bytes? R: Es mas lento, ¿por que?, me parece que es por que se involucra una multiplicacion aparentemente, o eso quiero creer, aun asi ya lo probe y si es mas leeeento. Por que no usar otras 2 variables para que sea mas legible? R: Es un ejemplo de como usar una variable tipo long para que la misma tenga distintos usos, no solo uno, ademas las mascaras son tan rapidas que no influyen en la velocidad. Extructura de la variable lData Para la explicacion veremos la variable de manera binaria: 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 => sección de 1 Byte donde se guarda el caracterleido con el API RtlMoveMemory(). 0000 0000 => sección Flags de 1 Byte, se usa para guardar los Flags siguientes: Const PUNTO_DECIMAL As Long = &H10000 Const SIGNO_SRC As Long = &H20000 Const NUMBER_HEX As Long = &H40000 Const NUMBER_OK As Long = &H80000 Const NUMBER_POW As Long = &H100000 Const NUMBER_POWF As Long = &H200000 Const NUMBER_POWC As Long = &H300000 Const NUMBER_FINISH As Long = &H400000
0000 0000 => sección 1 Byte (No tiene uso pero puede servir para continuar el conteo de la siguiente sección 0000 0000). 0000 0000 => sección 1 Byte, Se usa como contador sin signo con limite 2 potencia 8 es decir de 0 a 255 ( gracias a que el siguiente bloque 0000 0000 no se usa se puede expandir a 2 potencia 16 es decir 0 a 65535), se púso el contador en esta sección ya que la suma seria directa sin mascara alguna o algun tipo de dezplazamiento de bits y de esta manera NO MODIFICARIA los siguientes bloques de bytes. lData = (lData + &H1)
Temibles Lunas!¡.
Título: Re: Recopilacion de Funciones con operaciones Binarias.
Publicado por: BlackZeroX en 28 Septiembre 2011, 08:48 am
. Sumar Dos colores... No trabaja aun muy bien que digamos... si desean discutir este algoritmo creen un nuevo tema, gracias!¡. Option Explicit Private Function SumarColor(ByVal lColor As Long, ByVal AddColor As Long) As Long Dim lRetColor As Long If (lColor) Then If ((lColor And &HFF&) = &H0) Then lRetColor = (AddColor And &HFF&) ElseIf ((AddColor And &HFF&) = &H0) Then lRetColor = (lColor And &HFF&) Else lRetColor = (((lColor And &HFF&) + (AddColor And &HFF&)) \ 2) End If If ((lColor And &HFF00&) = &H0) Then lRetColor = (lRetColor Or (AddColor And &HFF00&)) ElseIf ((AddColor And &HFF00&) = &H0) Then lRetColor = (lRetColor Or (lColor And &HFF00&)) Else lRetColor = (lRetColor Or (((((lColor And &HFF00&) \ &H100&) + ((AddColor And &HFF00&) \ &H100&)) \ 2) * &H100&)) End If If ((lColor And &HFF0000) = &H0) Then lRetColor = (lRetColor Or (AddColor And &HFF0000)) ElseIf ((AddColor And &HFF0000) = &H0) Then lRetColor = (lRetColor Or (lColor And &HFF0000)) Else lRetColor = (lRetColor Or (((((lColor And &HFF0000) \ &H10000) + ((AddColor And &HFF0000) \ &H10000)) \ 2) * &H10000)) End If If ((lColor And &HFF000000) = &H0) Then lRetColor = (lRetColor Or (AddColor And &HFF000000)) ElseIf ((AddColor And &HFF000000) = &H0) Then lRetColor = (lRetColor Or (lColor And &HFF000000)) Else lRetColor = (lRetColor Or (((((lColor And &HFF000000) \ &H1000000) + ((AddColor And &HFF000000) \ &H1000000)) \ 2) * &H1000000)) End If Else lRetColor = AddColor End If SumarColor = lRetColor End Function
Private Sub Form_Load() Show BackColor = SumarColor(RGB(255, 0, 0), RGB(0, 255, 0)) BackColor = SumarColor(BackColor, RGB(0, 0, 255)) BackColor = SumarColor(BackColor, RGB(0, 25, 0)) BackColor = SumarColor(BackColor, RGB(0, 25, 10)) BackColor = SumarColor(BackColor, RGB(0, 1, 4)) BackColor = SumarColor(BackColor, RGB(30, 0, 0)) End Sub
Temibles Lunas!¡.
Título: Re: Recopilacion de Funciones con operaciones Binarias.
Publicado por: BlackZeroX en 21 Octubre 2011, 07:03 am
* Rotar Bits en distintas longitudes 8, 16, 32 y 64 bits (http://foro.elhacker.net/programacion_visual_basic/sources_code_rotbits_byte_to_byte-t342467.0.html;msg1676295#msg1676295)
Dulces Lunas!¡.
Título: Re: Recopilacion de Funciones con operaciones Binarias.
Publicado por: arfgh en 20 Febrero 2012, 14:21 pm
Este tópico es genial, no obstante estaría bien que pusieseis también las operaciones con bits tipo shr y shl.
Título: Re: Recopilacion de Funciones con operaciones Binarias.
Publicado por: BlackZeroX en 4 Junio 2012, 09:34 am
Alternativa a la función Xor... Option Explicit Private Sub Form_Load() Const a As Long = 0 Const b As Long = 1 MsgBox Xor_alt(a, b) & vbCrLf & (a Xor b) End Sub Public Function Xor_alt(ByVal n1 As Long, ByVal n2 As Long) As Long Xor_alt = (Not n1) And n2 Or (Not n2) And n1 End Function
P.D.: Necesito crearle un Indice a este tema... cuando tenga tiempo libre lo haré... Dulces Lunas!¡.
Título: Re: Recopilacion de Funciones con operaciones Binarias.
Publicado por: 79137913 en 4 Junio 2012, 15:57 pm
HOLA!!! Deberias agregar el reto de reemplazo de operadores binarios: And, Not, Xor y Or reemplazados: Private Function AndAlt(Byte1 As Long, Byte2 As Long) As Long Dim bit1() As Boolean Dim bit2() As Boolean Dim bit3() As Boolean Dim CT As Long Dim Tam As Long Dim b1 As Long Dim b2 As Long b1 = Byte1 b2 = Byte2 Do ReDim Preserve bit1(CT) If b1 = 1 Then ReDim Preserve bit1(CT): bit1(CT) = True: Exit Do If b1 = 0 Then ReDim Preserve bit1(CT): Exit Do bit1(CT) = CBool(b1 Mod 2) b1 = Fix(b1 / 2) CT = CT + 1 Loop CT = 0 Do If b2 = 1 Then ReDim Preserve bit2(CT): bit2(CT) = True: Exit Do If b2 = 0 Then ReDim Preserve bit2(CT): Exit Do ReDim Preserve bit2(CT) bit2(CT) = CBool(b2 Mod 2) b2 = Fix(b2 / 2) CT = CT + 1 Loop If UBound(bit1) > UBound(bit2) Then ReDim Preserve bit2(UBound(bit1)) If UBound(bit1) < UBound(bit2) Then ReDim Preserve bit1(UBound(bit2)) Tam = UBound(bit1) ReDim bit3(Tam) For X = 0 To Tam If bit1(X) Then If bit2(X) Then bit3(X) = True Next For X = 0 To Tam If bit3(X) Then AndAlt = AndAlt + 2 ^ (X) Next End Function Private Function OrAlt(Byte1 As Long, Byte2 As Long) As Long Dim bit1() As Boolean Dim bit2() As Boolean Dim bit3() As Boolean Dim CT As Long Dim Tam As Long Dim b1 As Long Dim b2 As Long b1 = Byte1 b2 = Byte2 Do ReDim Preserve bit1(CT) If b1 = 1 Then ReDim Preserve bit1(CT): bit1(CT) = True: Exit Do If b1 = 0 Then ReDim Preserve bit1(CT): Exit Do bit1(CT) = CBool(b1 Mod 2) b1 = Fix(b1 / 2) CT = CT + 1 Loop CT = 0 Do If b2 = 1 Then ReDim Preserve bit2(CT): bit2(CT) = True: Exit Do If b2 = 0 Then ReDim Preserve bit2(CT): Exit Do ReDim Preserve bit2(CT) bit2(CT) = CBool(b2 Mod 2) b2 = Fix(b2 / 2) CT = CT + 1 Loop If UBound(bit1) > UBound(bit2) Then ReDim Preserve bit2(UBound(bit1)) If UBound(bit1) < UBound(bit2) Then ReDim Preserve bit1(UBound(bit2)) Tam = UBound(bit1) ReDim bit3(Tam) For X = 0 To Tam If bit1(X) Then bit3(X) = True If bit2(X) Then bit3(X) = True Next For X = 0 To Tam If bit3(X) Then OrAlt = OrAlt + 2 ^ (X) Next End Function Private Function XorAlt(Byte1 As Long, Byte2 As Long) As Long Dim bit1() As Boolean Dim bit2() As Boolean Dim bit3() As Boolean Dim CT As Long Dim Tam As Long Dim b1 As Long Dim b2 As Long b1 = Byte1 b2 = Byte2 Do ReDim Preserve bit1(CT) If b1 = 1 Then ReDim Preserve bit1(CT): bit1(CT) = True: Exit Do If b1 = 0 Then ReDim Preserve bit1(CT): Exit Do bit1(CT) = CBool(b1 Mod 2) b1 = Fix(b1 / 2) CT = CT + 1 Loop CT = 0 Do If b2 = 1 Then ReDim Preserve bit2(CT): bit2(CT) = True: Exit Do If b2 = 0 Then ReDim Preserve bit2(CT): Exit Do ReDim Preserve bit2(CT) bit2(CT) = CBool(b2 Mod 2) b2 = Fix(b2 / 2) CT = CT + 1 Loop If UBound(bit1) > UBound(bit2) Then ReDim Preserve bit2(UBound(bit1)) If UBound(bit1) < UBound(bit2) Then ReDim Preserve bit1(UBound(bit2)) Tam = UBound(bit1) ReDim bit3(Tam) For X = 0 To Tam If bit1(X) Then If bit2(X) = False Then bit3(X) = True If bit2(X) Then If bit1(X) = False Then bit3(X) = True Next For X = 0 To Tam If bit3(X) Then XorAlt = XorAlt + 2 ^ (X) Next End Function Private Function NotAlt(Byte1 As Long) As Long NotAlt = -(Byte1 + 1) End Function
GRACIAS POR LEER!!!
Título: Re: Recopilacion de Funciones con operaciones Binarias.
Publicado por: Psyke1 en 19 Enero 2013, 01:23 am
Un oneliner que he tenido que crear para un proyecto en curso. Devuelve la diferencia entre dos colores con un número del 0 al 100 según el porcentaje. Public Function ColorDiff(ByVal lC1 As Long, ByVal lC2 As Long) As Single ColorDiff = &H64 - &H64 * (Abs((lC1 And &HFF) - (lC2 And &HFF)) + Abs(((lC1 \ &H100) And &HFF) - ((lC2 \ &H100) And &HFF)) + Abs(((lC1 \ &H10000) And &HFF) - ((lC2 \ &H10000) And &HFF))) / &H2FD End Function
DoEvents! :P
Título: Re: Recopilacion de Funciones con operaciones Binarias.
Publicado por: pkj en 17 Mayo 2015, 12:14 pm
Es una buena idea, pero podriais corregir los fallos gordos, que aqui dejan editar :P Una sub? mas bien no Private Sub lIsNegative(ByRef lVal As Long)
' // Para cualquier valor que lVal pueda tomar.
' // Comprueba si lval es negativo.
lIsNegative = (lVal And &H80000000)
End Sub
Una Sub con End Function? Private sub ColorLongToRGB(ByVal LngColor As Long, ByRef OutRed As Byte, ByRef OutGreen As Byte, ByRef OutBlue As Byte)
OutBlue = (LngColor And &HFF0000) \ &H10000
OutGreen = (LngColor And &HFF00&) \ &H100
OutRed = (LngColor And &HFF)
End Function
Saludos EDIT: Para que veais que no solo me gusta criticar, aprovecho para dejaros mi version super cutre de los operadores And, Or, Xor y Not. Es muy rustica pero no contiene ni un And, Or, Xor, Not y parece funcionar con positivos, negativos y mezclas y ya de paso incluye las conversiones Bin2Hex, Hex2Bin, etc... Private Function OrAlt(ByVal Valor1 As Long, ByVal Valor2 As Long) As Long Dim V1 As String Dim V2 As String V1 = Dec2Bin(Valor1) V2 = Dec2Bin(Valor2) Dim UnBit As String Dim Res As String Dim F As Integer For F = 1 To Len(V1) UnBit = "0" If Mid(V1, F, 1) = 1 Then UnBit = "1" If Mid(V2, F, 1) = 1 Then UnBit = "1" Res = Res & UnBit Next F OrAlt = Bin2Dec(Res) End Function Private Function AndAlt(ByVal Valor1 As Long, ByVal Valor2 As Long) As Long Dim V1 As String Dim V2 As String V1 = Dec2Bin(Valor1) V2 = Dec2Bin(Valor2) Dim UnBit As String Dim CuentaOK As Integer Dim Res As String Dim F As Integer For F = 1 To Len(V1) CuentaOK = 0 UnBit = "0" If Mid(V1, F, 1) = 1 Then CuentaOK = CuentaOK + 1 If Mid(V2, F, 1) = 1 Then CuentaOK = CuentaOK + 1 If CuentaOK = 2 Then UnBit = "1" Res = Res & UnBit Next F AndAlt = Bin2Dec(Res) End Function Private Function XorAlt(ByVal Valor1 As Long, ByVal Valor2 As Long) As Long Dim V1 As String Dim V2 As String V1 = Dec2Bin(Valor1) V2 = Dec2Bin(Valor2) Dim UnBit As String Dim CuentaOK As Integer Dim Res As String Dim F As Integer For F = 1 To Len(V1) CuentaOK = 0 UnBit = "0" If Mid(V1, F, 1) = 1 Then CuentaOK = CuentaOK + 1 If Mid(V2, F, 1) = 1 Then CuentaOK = CuentaOK + 1 If CuentaOK = 1 Then UnBit = "1" Res = Res & UnBit Next F XorAlt = Bin2Dec(Res) End Function Private Function NotAlt(ByVal Valor1 As Long) As Long Dim V1 As String Dim V2 As String V1 = Dec2Bin(Valor1) Dim UnBit As String Dim Res As String Dim F As Integer For F = 1 To Len(V1) If Mid(V1, F, 1) = "1" Then UnBit = "0" Else UnBit = "1" End If Res = Res & UnBit Next F NotAlt = Bin2Dec(Res) End Function Function Bin2Dec(ByVal sBinario As String) As Long 'Bin2Dec = CDec("&H" & Bin2Hex(sBinario)) 'no hace falta el cdec :O Bin2Dec = "&H" & Bin2Hex(sBinario) End Function Public Function Dec2Bin(ByVal Valor As Long, Optional MinBits As Integer = 32) As String Dec2Bin = Hex2Bin(Hex$(Valor)) Do Until Len(Dec2Bin) >= MinBits Dec2Bin = "0" & Dec2Bin Loop End Function Function Bin2Hex(ByVal StrBin As String) As String Dim F As Long Do Until Len(StrBin) / 4 = Len(StrBin) \ 4 StrBin = "0" & StrBin Loop For F = Len(StrBin) - 3 To 1 Step -4 Select Case Mid$(StrBin, F, 4) Case "0000" Bin2Hex = "0" & Bin2Hex Case "0001" Bin2Hex = "1" & Bin2Hex Case "0010" Bin2Hex = "2" & Bin2Hex Case "0011" Bin2Hex = "3" & Bin2Hex Case "0100" Bin2Hex = "4" & Bin2Hex Case "0101" Bin2Hex = "5" & Bin2Hex Case "0110" Bin2Hex = "6" & Bin2Hex Case "0111" Bin2Hex = "7" & Bin2Hex Case "1000" Bin2Hex = "8" & Bin2Hex Case "1001" Bin2Hex = "9" & Bin2Hex Case "1010" Bin2Hex = "A" & Bin2Hex Case "1011" Bin2Hex = "B" & Bin2Hex Case "1100" Bin2Hex = "C" & Bin2Hex Case "1101" Bin2Hex = "D" & Bin2Hex Case "1110" Bin2Hex = "E" & Bin2Hex Case "1111" Bin2Hex = "F" & Bin2Hex End Select Next F End Function Function Hex2Bin(ByVal CadenaHexadecimal As String) As String Dim F As Long CadenaHexadecimal = UCase(CadenaHexadecimal) If Len(CadenaHexadecimal) > 0 Then For F = Len(CadenaHexadecimal) To 1 Step -1 Select Case Mid$(CadenaHexadecimal, F, 1) Case "0": Hex2Bin = "0000" & Hex2Bin Case "1": Hex2Bin = "0001" & Hex2Bin Case "2": Hex2Bin = "0010" & Hex2Bin Case "3": Hex2Bin = "0011" & Hex2Bin Case "4": Hex2Bin = "0100" & Hex2Bin Case "5": Hex2Bin = "0101" & Hex2Bin Case "6": Hex2Bin = "0110" & Hex2Bin Case "7": Hex2Bin = "0111" & Hex2Bin Case "8": Hex2Bin = "1000" & Hex2Bin Case "9": Hex2Bin = "1001" & Hex2Bin Case "A": Hex2Bin = "1010" & Hex2Bin Case "B": Hex2Bin = "1011" & Hex2Bin Case "C": Hex2Bin = "1100" & Hex2Bin Case "D": Hex2Bin = "1101" & Hex2Bin Case "E": Hex2Bin = "1110" & Hex2Bin Case "F": Hex2Bin = "1111" & Hex2Bin End Select Next F End If On Local Error GoTo 0 End Function
Saludos.
|