elhacker.net cabecera Bienvenido(a), Visitante. Por favor Ingresar o Registrarse
¿Perdiste tu email de activación?.


 


Tema destacado: [Encuesta] ¿Qué editor de código utilizas? (2014)    


+  Foro de elhacker.net
|-+  Programación
| |-+  Programación Visual Basic (Moderadores: LeandroA, seba123neo)
| | |-+  Recopilacion de Funciones con operaciones Binarias.
0 Usuarios y 1 Visitante están viendo este tema.
Páginas: 1 [2] Ir Abajo Respuesta Imprimir
Autor Tema: Recopilacion de Funciones con operaciones Binarias.  (Leído 11,853 veces)
arfgh

Desconectado Desconectado

Mensajes: 28


Ver Perfil
Re: Recopilacion de Funciones con operaciones Binarias.
« Respuesta #10 en: 20 Febrero 2012, 14:21 »

Este tópico es genial, no obstante estaría bien que pusieseis también las operaciones con bits tipo shr y shl.


En línea

BlackZeroX (Astaroth)
Wiki

Desconectado Desconectado

Mensajes: 3.204


I'Love...!¡.


Ver Perfil WWW
Re: Recopilacion de Funciones con operaciones Binarias.
« Respuesta #11 en: 4 Junio 2012, 09:34 »

Alternativa a la función Xor...

Código
  1.  
  2. Option Explicit
  3.  
  4. Private Sub Form_Load()
  5. Const a As Long = 0
  6. Const b As Long = 1
  7.    MsgBox Xor_alt(a, b) & vbCrLf & (a Xor b)
  8. End Sub
  9.  
  10. Public Function Xor_alt(ByVal n1 As Long, ByVal n2 As Long) As Long
  11.    Xor_alt = (Not n1) And n2 Or (Not n2) And n1
  12. End Function
  13.  
  14.  
  15.  

P.D.: Necesito crearle un Indice a este tema... cuando tenga tiempo libre lo haré...

Dulces Lunas!¡.


« Última modificación: 4 Junio 2012, 09:37 por BlackZeroX (Astaroth) » En línea




CScript (Actualizado 26/06/2013).

FileX <-- Re-modelando...
Web Principal-->[ Blog(VB6/C/C++) | Host File | Scan Port) ]

The Dark Shadow is my passion.
El infierno es mi Hogar, mi novia es Lilit y el metal mi relig
79137913


Desconectado Desconectado

Mensajes: 1.151


4 Esquinas


Ver Perfil WWW
Re: Recopilacion de Funciones con operaciones Binarias.
« Respuesta #12 en: 4 Junio 2012, 15:57 »

HOLA!!!

Deberias agregar el reto de reemplazo de operadores binarios:


And, Not, Xor y Or reemplazados:
Código
  1. Private Function AndAlt(Byte1 As Long, Byte2 As Long) As Long
  2. Dim bit1() As Boolean
  3. Dim bit2() As Boolean
  4. Dim bit3() As Boolean
  5. Dim CT     As Long
  6. Dim Tam    As Long
  7. Dim b1     As Long
  8. Dim b2     As Long
  9. b1 = Byte1
  10. b2 = Byte2
  11.   Do
  12.       ReDim Preserve bit1(CT)
  13.       If b1 = 1 Then ReDim Preserve bit1(CT): bit1(CT) = True: Exit Do
  14.       If b1 = 0 Then ReDim Preserve bit1(CT): Exit Do
  15.       bit1(CT) = CBool(b1 Mod 2)
  16.       b1 = Fix(b1 / 2)
  17.       CT = CT + 1
  18.   Loop
  19.   CT = 0
  20.   Do
  21.       If b2 = 1 Then ReDim Preserve bit2(CT): bit2(CT) = True: Exit Do
  22.       If b2 = 0 Then ReDim Preserve bit2(CT): Exit Do
  23.       ReDim Preserve bit2(CT)
  24.       bit2(CT) = CBool(b2 Mod 2)
  25.       b2 = Fix(b2 / 2)
  26.       CT = CT + 1
  27.   Loop
  28.   If UBound(bit1) > UBound(bit2) Then ReDim Preserve bit2(UBound(bit1))
  29.   If UBound(bit1) < UBound(bit2) Then ReDim Preserve bit1(UBound(bit2))
  30.   Tam = UBound(bit1)
  31.   ReDim bit3(Tam)
  32.   For X = 0 To Tam
  33.       If bit1(X) Then If bit2(X) Then bit3(X) = True
  34.   Next
  35.   For X = 0 To Tam
  36.       If bit3(X) Then AndAlt = AndAlt + 2 ^ (X)
  37.   Next
  38.  
  39. End Function
  40.  
  41. Private Function OrAlt(Byte1 As Long, Byte2 As Long) As Long
  42. Dim bit1() As Boolean
  43. Dim bit2() As Boolean
  44. Dim bit3() As Boolean
  45. Dim CT     As Long
  46. Dim Tam    As Long
  47. Dim b1     As Long
  48. Dim b2     As Long
  49. b1 = Byte1
  50. b2 = Byte2
  51.   Do
  52.       ReDim Preserve bit1(CT)
  53.       If b1 = 1 Then ReDim Preserve bit1(CT): bit1(CT) = True: Exit Do
  54.       If b1 = 0 Then ReDim Preserve bit1(CT): Exit Do
  55.       bit1(CT) = CBool(b1 Mod 2)
  56.       b1 = Fix(b1 / 2)
  57.       CT = CT + 1
  58.   Loop
  59.   CT = 0
  60.   Do
  61.       If b2 = 1 Then ReDim Preserve bit2(CT): bit2(CT) = True: Exit Do
  62.       If b2 = 0 Then ReDim Preserve bit2(CT): Exit Do
  63.       ReDim Preserve bit2(CT)
  64.       bit2(CT) = CBool(b2 Mod 2)
  65.       b2 = Fix(b2 / 2)
  66.       CT = CT + 1
  67.   Loop
  68.   If UBound(bit1) > UBound(bit2) Then ReDim Preserve bit2(UBound(bit1))
  69.   If UBound(bit1) < UBound(bit2) Then ReDim Preserve bit1(UBound(bit2))
  70.   Tam = UBound(bit1)
  71.   ReDim bit3(Tam)
  72.   For X = 0 To Tam
  73.       If bit1(X) Then bit3(X) = True
  74.       If bit2(X) Then bit3(X) = True
  75.   Next
  76.   For X = 0 To Tam
  77.       If bit3(X) Then OrAlt = OrAlt + 2 ^ (X)
  78.   Next
  79.  
  80. End Function
  81.  
  82. Private Function XorAlt(Byte1 As Long, Byte2 As Long) As Long
  83. Dim bit1() As Boolean
  84. Dim bit2() As Boolean
  85. Dim bit3() As Boolean
  86. Dim CT     As Long
  87. Dim Tam    As Long
  88. Dim b1     As Long
  89. Dim b2     As Long
  90. b1 = Byte1
  91. b2 = Byte2
  92.   Do
  93.       ReDim Preserve bit1(CT)
  94.       If b1 = 1 Then ReDim Preserve bit1(CT): bit1(CT) = True: Exit Do
  95.       If b1 = 0 Then ReDim Preserve bit1(CT): Exit Do
  96.       bit1(CT) = CBool(b1 Mod 2)
  97.       b1 = Fix(b1 / 2)
  98.       CT = CT + 1
  99.   Loop
  100.   CT = 0
  101.   Do
  102.       If b2 = 1 Then ReDim Preserve bit2(CT): bit2(CT) = True: Exit Do
  103.       If b2 = 0 Then ReDim Preserve bit2(CT): Exit Do
  104.       ReDim Preserve bit2(CT)
  105.       bit2(CT) = CBool(b2 Mod 2)
  106.       b2 = Fix(b2 / 2)
  107.       CT = CT + 1
  108.   Loop
  109.   If UBound(bit1) > UBound(bit2) Then ReDim Preserve bit2(UBound(bit1))
  110.   If UBound(bit1) < UBound(bit2) Then ReDim Preserve bit1(UBound(bit2))
  111.   Tam = UBound(bit1)
  112.   ReDim bit3(Tam)
  113.   For X = 0 To Tam
  114.       If bit1(X) Then If bit2(X) = False Then bit3(X) = True
  115.       If bit2(X) Then If bit1(X) = False Then bit3(X) = True
  116.   Next
  117.   For X = 0 To Tam
  118.       If bit3(X) Then XorAlt = XorAlt + 2 ^ (X)
  119.   Next
  120.  
  121. End Function
  122.  
  123. Private Function NotAlt(Byte1 As Long) As Long
  124.   NotAlt = -(Byte1 + 1)
  125. End Function

GRACIAS POR LEER!!!
« Última modificación: 17 Febrero 2014, 19:42 por 79137913 » En línea

"Como no se puede igualar a Dios, ya he decidido que hacer, ¡SUPERARLO!"
"La peor de las ignorancias es no saber corregirlas"

 79137913                          *Shadow Scouts Team*
Psyke1
Wiki

Desconectado Desconectado

Mensajes: 1.089



Ver Perfil WWW
Re: Recopilacion de Funciones con operaciones Binarias.
« Respuesta #13 en: 19 Enero 2013, 01:23 »

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.

Código
  1. Public Function ColorDiff(ByVal lC1 As Long, ByVal lC2 As Long) As Single
  2.    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
  3. End Function

DoEvents! :P
En línea

pkj

Desconectado Desconectado

Mensajes: 47



Ver Perfil
Re: Recopilacion de Funciones con operaciones Binarias.
« Respuesta #14 en: 17 Mayo 2015, 12:14 »

Es una buena idea, pero podriais corregir los fallos gordos, que aqui dejan editar :P

Una sub? mas bien no
Código:
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?
Código:
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...

Código
  1. Private Function OrAlt(ByVal Valor1 As Long, ByVal Valor2 As Long) As Long
  2.  Dim V1 As String
  3.  Dim V2 As String
  4.  V1 = Dec2Bin(Valor1)
  5.  V2 = Dec2Bin(Valor2)
  6.  
  7.  Dim UnBit As String
  8.  Dim Res As String
  9.  Dim F As Integer
  10.  For F = 1 To Len(V1)
  11.    UnBit = "0"
  12.    If Mid(V1, F, 1) = 1 Then UnBit = "1"
  13.    If Mid(V2, F, 1) = 1 Then UnBit = "1"
  14.    Res = Res & UnBit
  15.  Next F
  16.  
  17.  OrAlt = Bin2Dec(Res)
  18.  
  19. End Function
  20.  
  21. Private Function AndAlt(ByVal Valor1 As Long, ByVal Valor2 As Long) As Long
  22.  Dim V1 As String
  23.  Dim V2 As String
  24.  V1 = Dec2Bin(Valor1)
  25.  V2 = Dec2Bin(Valor2)
  26.  
  27.  Dim UnBit As String
  28.  Dim CuentaOK As Integer
  29.  Dim Res As String
  30.  Dim F As Integer
  31.  For F = 1 To Len(V1)
  32.    CuentaOK = 0
  33.    UnBit = "0"
  34.    If Mid(V1, F, 1) = 1 Then CuentaOK = CuentaOK + 1
  35.    If Mid(V2, F, 1) = 1 Then CuentaOK = CuentaOK + 1
  36.    If CuentaOK = 2 Then UnBit = "1"
  37.    Res = Res & UnBit
  38.  Next F
  39.  
  40.  AndAlt = Bin2Dec(Res)
  41.  
  42. End Function
  43.  
  44. Private Function XorAlt(ByVal Valor1 As Long, ByVal Valor2 As Long) As Long
  45.  Dim V1 As String
  46.  Dim V2 As String
  47.  V1 = Dec2Bin(Valor1)
  48.  V2 = Dec2Bin(Valor2)
  49.  
  50.  Dim UnBit As String
  51.  Dim CuentaOK As Integer
  52.  Dim Res As String
  53.  Dim F As Integer
  54.  For F = 1 To Len(V1)
  55.    CuentaOK = 0
  56.    UnBit = "0"
  57.    If Mid(V1, F, 1) = 1 Then CuentaOK = CuentaOK + 1
  58.    If Mid(V2, F, 1) = 1 Then CuentaOK = CuentaOK + 1
  59.    If CuentaOK = 1 Then UnBit = "1"
  60.    Res = Res & UnBit
  61.  Next F
  62.  
  63.  XorAlt = Bin2Dec(Res)
  64.  
  65. End Function
  66.  
  67. Private Function NotAlt(ByVal Valor1 As Long) As Long
  68.  Dim V1 As String
  69.  Dim V2 As String
  70.  V1 = Dec2Bin(Valor1)
  71.  
  72.  Dim UnBit As String
  73.  Dim Res As String
  74.  Dim F As Integer
  75.  For F = 1 To Len(V1)
  76.    If Mid(V1, F, 1) = "1" Then
  77.      UnBit = "0"
  78.    Else
  79.      UnBit = "1"
  80.    End If
  81.    Res = Res & UnBit
  82.  Next F
  83.  
  84.  NotAlt = Bin2Dec(Res)
  85.  
  86. End Function
  87.  
  88. Function Bin2Dec(ByVal sBinario As String) As Long
  89.  'Bin2Dec = CDec("&H" & Bin2Hex(sBinario)) 'no hace falta el cdec :O
  90.  Bin2Dec = "&H" & Bin2Hex(sBinario)
  91. End Function
  92.  
  93. Public Function Dec2Bin(ByVal Valor As Long, Optional MinBits As Integer = 32) As String
  94.  Dec2Bin = Hex2Bin(Hex$(Valor))
  95.  Do Until Len(Dec2Bin) >= MinBits
  96.    Dec2Bin = "0" & Dec2Bin
  97.  Loop
  98. End Function
  99.  
  100. Function Bin2Hex(ByVal StrBin As String) As String
  101.  Dim F As Long
  102.  
  103.  Do Until Len(StrBin) / 4 = Len(StrBin) \ 4
  104.    StrBin = "0" & StrBin
  105.  Loop
  106.  For F = Len(StrBin) - 3 To 1 Step -4
  107.  
  108.    Select Case Mid$(StrBin, F, 4)
  109.      Case "0000"
  110.        Bin2Hex = "0" & Bin2Hex
  111.      Case "0001"
  112.        Bin2Hex = "1" & Bin2Hex
  113.      Case "0010"
  114.        Bin2Hex = "2" & Bin2Hex
  115.      Case "0011"
  116.        Bin2Hex = "3" & Bin2Hex
  117.      Case "0100"
  118.        Bin2Hex = "4" & Bin2Hex
  119.      Case "0101"
  120.        Bin2Hex = "5" & Bin2Hex
  121.      Case "0110"
  122.        Bin2Hex = "6" & Bin2Hex
  123.      Case "0111"
  124.        Bin2Hex = "7" & Bin2Hex
  125.      Case "1000"
  126.        Bin2Hex = "8" & Bin2Hex
  127.      Case "1001"
  128.        Bin2Hex = "9" & Bin2Hex
  129.      Case "1010"
  130.        Bin2Hex = "A" & Bin2Hex
  131.      Case "1011"
  132.        Bin2Hex = "B" & Bin2Hex
  133.      Case "1100"
  134.        Bin2Hex = "C" & Bin2Hex
  135.      Case "1101"
  136.        Bin2Hex = "D" & Bin2Hex
  137.      Case "1110"
  138.        Bin2Hex = "E" & Bin2Hex
  139.      Case "1111"
  140.        Bin2Hex = "F" & Bin2Hex
  141.  
  142.    End Select
  143.  Next F
  144.  
  145. End Function
  146.  
  147. Function Hex2Bin(ByVal CadenaHexadecimal As String) As String
  148.  Dim F As Long
  149.  
  150.  CadenaHexadecimal = UCase(CadenaHexadecimal)
  151.  
  152.  If Len(CadenaHexadecimal) > 0 Then
  153.    For F = Len(CadenaHexadecimal) To 1 Step -1
  154.      Select Case Mid$(CadenaHexadecimal, F, 1)
  155.        Case "0":
  156.          Hex2Bin = "0000" & Hex2Bin
  157.        Case "1":
  158.          Hex2Bin = "0001" & Hex2Bin
  159.        Case "2":
  160.          Hex2Bin = "0010" & Hex2Bin
  161.        Case "3":
  162.          Hex2Bin = "0011" & Hex2Bin
  163.        Case "4":
  164.          Hex2Bin = "0100" & Hex2Bin
  165.        Case "5":
  166.          Hex2Bin = "0101" & Hex2Bin
  167.        Case "6":
  168.          Hex2Bin = "0110" & Hex2Bin
  169.        Case "7":
  170.          Hex2Bin = "0111" & Hex2Bin
  171.        Case "8":
  172.          Hex2Bin = "1000" & Hex2Bin
  173.        Case "9":
  174.          Hex2Bin = "1001" & Hex2Bin
  175.        Case "A":
  176.          Hex2Bin = "1010" & Hex2Bin
  177.        Case "B":
  178.          Hex2Bin = "1011" & Hex2Bin
  179.        Case "C":
  180.          Hex2Bin = "1100" & Hex2Bin
  181.        Case "D":
  182.          Hex2Bin = "1101" & Hex2Bin
  183.        Case "E":
  184.          Hex2Bin = "1110" & Hex2Bin
  185.        Case "F":
  186.          Hex2Bin = "1111" & Hex2Bin
  187.      End Select
  188.  
  189.    Next F
  190.  End If
  191.  On Local Error GoTo 0
  192. End Function
  193.  

Saludos.

« Última modificación: 23 Mayo 2015, 10:24 por pkj » En línea

Páginas: 1 [2] Ir Arriba Respuesta Imprimir 

Ir a:  

Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines