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


 


Tema destacado: Servidor TeamSpeak 3: crea tu propio canal gratis


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

Desconectado Desconectado

Mensajes: 3.182


I'Love...!¡.


Ver Perfil WWW
Recopilacion de Funciones con operaciones Binarias.
« en: 5 Junio 2011, 08:07 »

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.

Código
  1.  
  2. '   //  Para valores tipo Long
  3. Private Sub lSwap(ByRef lVal1 As Long, ByRef lVal2 As Long)
  4.    '   //  Intercambia {lVal1} por {lVal2} y {lVal2} a {lVal1} sin variable temporal
  5.    lVal1 = lVal1 Xor lVal2
  6.    lVal2 = lVal2 Xor lVal1
  7.    lVal1 = lVal1 Xor lVal2
  8. End Sub
  9. Private Sub lIsNegative(ByRef lVal As Long)
  10.    '   //  Para cualquier valor que lVal pueda tomar.
  11.    '   //  Comprueba si lval es negativo.
  12.    lIsNegative = (lVal And &H80000000)
  13. End Sub
  14.  
  15. Private Function iIsNegative(ByRef iVal As Integer) As Boolean
  16.    '   //  Para cualquier valor que iVal pueda tomar.
  17.    '   //  Comprueba si lval es negativo.
  18.    iIsNegative = (iVal And 32768)
  19. End Function
  20.  
  21. Private Sub iSwap(ByRef iVal1 As Integer, ByRef iVal2 As Integer)
  22.    '   //  Intercambia {iVal1} por {iVal2} y {iVal2} a {iVal1} sin variable temporal
  23.    iVal1 = iVal1 Xor iVal2
  24.    iVal2 = iVal2 Xor iVal1
  25.    iVal1 = iVal1 Xor iVal2
  26. End Sub
  27.  
  28. Private Sub bSwap(ByRef iVal1 As byte, ByRef iVal2 As byte)
  29.    '   //  Intercambia {iVal1} por {iVal2} y {iVal2} a {iVal1} sin variable temporal
  30.    iVal1 = iVal1 Xor iVal2
  31.    iVal2 = iVal2 Xor iVal1
  32.    iVal1 = iVal1 Xor iVal2
  33. End Sub
  34.  
  35. Function max(ByVal val1 As Long, ByVal val2 As Long) As Long
  36.    If (val1 > val2) Then
  37.        max = val1
  38.    Else
  39.        max = val2
  40.    End If
  41. End Function
  42.  
  43. Function min(ByVal val1 As Long, ByVal val2 As Long) As Long
  44.    If (val1 > val2) Then
  45.        min = val2
  46.    Else
  47.        min = val1
  48.    End If
  49. End Function
  50.  
  51. Function bSwapBit(ByVal myLong As Long, ByVal bit1 As Byte, ByVal bit2 As Byte) As Long
  52. '   Los bits se CUENTAS DE DERECHA A IZQUIERDA es decir:    31, 30, ... , 3, 2, 1, 0
  53. '   Solo se admite rango 0 al 31.
  54. Dim aux As Long
  55. Dim mask As Long
  56.  
  57.    aux = max(bit1, bit2)
  58.    bit2 = min(bit1, bit2)
  59.    bit1 = aux  '   max
  60.    Debug.Assert (bit1 > 31)    '   No se permiten numero mayores a 32
  61.    Debug.Assert (bit2 < 0)     '   No se permiten valores negativos
  62.    mask = Not ((2 ^ bit1) Or (2 ^ bit2))
  63.    aux = (2 ^ (bit1 - bit2))
  64.    bSwapBit = (myLong And mask) Or _
  65.               (myLong And (2 ^ bit1)) / aux Or _
  66.               (myLong And (2 ^ bit2)) * aux
  67. End Function
  68.  
  69.  

Si alguien se sabe mas y quiere aportarlas están en el lugar indicado.

Temibles Lunas!¡.


« Última modificación: 11 Agosto 2012, 20:06 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
BlackZeroX (Astaroth)
Wiki

Desconectado Desconectado

Mensajes: 3.182


I'Love...!¡.


Ver Perfil WWW
Re: Recopilacion de Funciones con operaciones Binarias.
« Respuesta #1 en: 8 Junio 2011, 04:18 »

Código
  1.  
  2. Public Function LongToByte(ByVal lVal As Long) As Byte()
  3. Dim bRet(0 To 3)        As Byte
  4.    bRet(3) = (lVal And &HFF000000) \ &H1000000
  5.    bRet(2) = (lVal And &HFF0000) \ &H10000
  6.    bRet(1) = (lVal And &HFF00&) \ &H100
  7.    bRet(0) = (lVal And &HFF)
  8.    LongToByte = bRet
  9. End Function
  10.  
  11.  

Código
  1.  
  2. Private sub ColorLongToRGB(ByVal LngColor As Long, ByRef OutRed As Byte, ByRef OutGreen As Byte, ByRef OutBlue As Byte)
  3.   OutBlue = (LngColor And &HFF0000) \ &H10000
  4.   OutGreen = (LngColor And &HFF00&) \ &H100
  5.   OutRed = (LngColor And &HFF)
  6. End Function
  7.  
  8.  

Dulces Lunas!¡.


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
BlackZeroX (Astaroth)
Wiki

Desconectado Desconectado

Mensajes: 3.182


I'Love...!¡.


Ver Perfil WWW
Re: Recopilacion de Funciones con operaciones Binarias.
« Respuesta #2 en: 10 Junio 2011, 04:14 »


Cambio rapido del signo a un valor dado N ( habitualmente:  lval=(lval*(-1)) )

Código
  1.  
  2. Private Sub lChangeSign(ByRef lVal As Long)
  3.    '   //  Para cualquier valor que lVal pueda tomar.
  4.    '   //  Cambia de signo a un numero( + a - y de - a +).
  5.    lVal = ((Not lVal) + 1)
  6. End Sub
  7. '   //  Para valores tipo Integer
  8. Private Sub iChangeSign(ByRef iVal As Integer)
  9.    '   //  Para cualquier valor que iVal pueda tomar.
  10.    '   //  Cambia de signo a un numero( + a - y de - a +).
  11.    lVal = ((Not lVal) + 1)
  12. End Sub
  13.  
  14.  

Dulce sLunas!¡.
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
raul338
Moderador
***
Desconectado Desconectado

Mensajes: 2.633


La sonrisa es la mejor forma de afrontar las cosas


Ver Perfil WWW
Re: Recopilacion de Funciones con operaciones Binarias.
« Respuesta #3 en: 10 Junio 2011, 04:55 »

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&)
En línea

BlackZeroX (Astaroth)
Wiki

Desconectado Desconectado

Mensajes: 3.182


I'Love...!¡.


Ver Perfil WWW
Re: Recopilacion de Funciones con operaciones Binarias.
« Respuesta #4 en: 10 Junio 2011, 06:57 »

& = 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.

Código
  1.  
  2. msgbox typename(&HFF00&)
  3. msgbox typename(&HFF00)
  4.  
  5.  

Dulces Lunas!¡.
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
BlackZeroX (Astaroth)
Wiki

Desconectado Desconectado

Mensajes: 3.182


I'Love...!¡.


Ver Perfil WWW
Re: Recopilacion de Funciones con operaciones Binarias.
« Respuesta #5 en: 10 Junio 2011, 20:29 »

.
Alternativa a htons@Ws2_32 (API)

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

Código
  1.  
  2. Public Function SwapEndian08(ByVal dw As Long) As Long
  3. ' by Mike D Sutton, Mike.Sutton@btclick.com, 20040914
  4.  SwapEndian08 = _
  5.      (((dw And &HFF000000) \ &H1000000) And &HFF&) Or _
  6.      ((dw And &HFF0000) \ &H100&) Or _
  7.      ((dw And &HFF00&) * &H100&) Or _
  8.      ((dw And &H7F&) * &H1000000)
  9.  If (dw And &H80&) Then SwapEndian08 = SwapEndian08 Or &H80000000
  10. End Function
  11.  
  12.  

Código
  1.  
  2. Public Function htons(ByVal lPort As Long) As Integer
  3.    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
  4. End Function
  5.  
  6.  

Dulces Lunas!¡.
« Última modificación: 10 Junio 2011, 21:06 por BlackZeroX▓▓▒▒░░ » 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
BlackZeroX (Astaroth)
Wiki

Desconectado Desconectado

Mensajes: 3.182


I'Love...!¡.


Ver Perfil WWW
Re: Recopilacion de Funciones con operaciones Binarias.
« Respuesta #6 en: 13 Agosto 2011, 07:21 »

macro de C/C++ muy usada con el API SendMessage().

Código
  1.  
  2. Function makelParam(ByVal L As Integer, ByVal U As Integer) As Long
  3.   makelParam = L Or (U * &H10000)
  4. End Function
  5.  
  6.  

Dulces Lunas!¡.
« Última modificación: 2 Diciembre 2011, 09:15 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
BlackZeroX (Astaroth)
Wiki

Desconectado Desconectado

Mensajes: 3.182


I'Love...!¡.


Ver Perfil WWW
Re: Recopilacion de Funciones con operaciones Binarias.
« Respuesta #7 en: 14 Agosto 2011, 02:52 »

.
Recreacion de la funcion isNumeric(), empleando operaciones a nivel Bit
IsNumeric()

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:
Código
  1.  
  2. Const PUNTO_DECIMAL As Long = &H10000
  3. Const SIGNO_SRC     As Long = &H20000
  4. Const NUMBER_HEX    As Long = &H40000
  5. Const NUMBER_OK     As Long = &H80000
  6. Const NUMBER_POW    As Long = &H100000
  7. Const NUMBER_POWF   As Long = &H200000
  8. Const NUMBER_POWC   As Long = &H300000
  9. Const NUMBER_FINISH As Long = &H400000
  10.  
  11.  

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.

Código
  1.  
  2. lData = (lData + &H1)
  3.  
  4.  

Temibles Lunas!¡.
« Última modificación: 14 Agosto 2011, 06:37 por BlackZeroX▓▓▒▒░░ » 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
BlackZeroX (Astaroth)
Wiki

Desconectado Desconectado

Mensajes: 3.182


I'Love...!¡.


Ver Perfil WWW
Re: Recopilacion de Funciones con operaciones Binarias.
« Respuesta #8 en: 28 Septiembre 2011, 08:48 »

.
Sumar Dos colores... No trabaja aun muy bien que digamos... si desean discutir este algoritmo creen un nuevo tema, gracias!¡.

Código
  1.  
  2. Option Explicit
  3.  
  4. Private Function SumarColor(ByVal lColor As Long, ByVal AddColor As Long) As Long
  5. Dim lRetColor           As Long
  6.    If (lColor) Then
  7.        If ((lColor And &HFF&) = &H0) Then
  8.            lRetColor = (AddColor And &HFF&)
  9.        ElseIf ((AddColor And &HFF&) = &H0) Then
  10.            lRetColor = (lColor And &HFF&)
  11.        Else
  12.            lRetColor = (((lColor And &HFF&) + (AddColor And &HFF&)) \ 2)
  13.        End If
  14.  
  15.        If ((lColor And &HFF00&) = &H0) Then
  16.            lRetColor = (lRetColor Or (AddColor And &HFF00&))
  17.        ElseIf ((AddColor And &HFF00&) = &H0) Then
  18.            lRetColor = (lRetColor Or (lColor And &HFF00&))
  19.        Else
  20.            lRetColor = (lRetColor Or (((((lColor And &HFF00&) \ &H100&) + ((AddColor And &HFF00&) \ &H100&)) \ 2) * &H100&))
  21.        End If
  22.  
  23.        If ((lColor And &HFF0000) = &H0) Then
  24.            lRetColor = (lRetColor Or (AddColor And &HFF0000))
  25.        ElseIf ((AddColor And &HFF0000) = &H0) Then
  26.            lRetColor = (lRetColor Or (lColor And &HFF0000))
  27.        Else
  28.            lRetColor = (lRetColor Or (((((lColor And &HFF0000) \ &H10000) + ((AddColor And &HFF0000) \ &H10000)) \ 2) * &H10000))
  29.        End If
  30.  
  31.        If ((lColor And &HFF000000) = &H0) Then
  32.            lRetColor = (lRetColor Or (AddColor And &HFF000000))
  33.        ElseIf ((AddColor And &HFF000000) = &H0) Then
  34.            lRetColor = (lRetColor Or (lColor And &HFF000000))
  35.        Else
  36.            lRetColor = (lRetColor Or (((((lColor And &HFF000000) \ &H1000000) + ((AddColor And &HFF000000) \ &H1000000)) \ 2) * &H1000000))
  37.        End If
  38.    Else
  39.        lRetColor = AddColor
  40.    End If
  41.    SumarColor = lRetColor
  42. End Function
  43.  
  44.  

Código
  1.  
  2. Private Sub Form_Load()
  3.    Show
  4.    BackColor = SumarColor(RGB(255, 0, 0), RGB(0, 255, 0))
  5.    BackColor = SumarColor(BackColor, RGB(0, 0, 255))
  6.    BackColor = SumarColor(BackColor, RGB(0, 25, 0))
  7.    BackColor = SumarColor(BackColor, RGB(0, 25, 10))
  8.    BackColor = SumarColor(BackColor, RGB(0, 1, 4))
  9.    BackColor = SumarColor(BackColor, RGB(30, 0, 0))
  10. End Sub
  11.  
  12.  

Temibles Lunas!¡.
« Última modificación: 29 Septiembre 2011, 04:15 por BlackZeroX▓▓▒▒░░ » 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
BlackZeroX (Astaroth)
Wiki

Desconectado Desconectado

Mensajes: 3.182


I'Love...!¡.


Ver Perfil WWW
Re: Recopilacion de Funciones con operaciones Binarias.
« Respuesta #9 en: 21 Octubre 2011, 07:03 »

* Rotar Bits en distintas longitudes 8, 16, 32 y 64 bits

Dulces Lunas!¡.
« Última modificación: 29 Octubre 2011, 02:29 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
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.182


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.090


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*                                                          Resumenes Cs.Economicas
Psyke1
Wiki

Desconectado Desconectado

Mensajes: 1.087



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

Páginas: [1] Ir Arriba Respuesta Imprimir 

Ir a:  

Powered by SMF 1.1.19 | SMF © 2006-2008, Simple Machines