Recopilacion de Funciones con operaciones Binarias.

[BlackZeroX]

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 (vb) [Seleccionar] Expandir



'   //  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!¡.

[BlackZeroX]

Código (Vb) [Seleccionar] Expandir



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



Código (Vb) [Seleccionar] Expandir



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!¡.

[BlackZeroX]

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

Código (Vb) [Seleccionar] Expandir



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!¡.

[raul338]

Le puse chincheta

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&)

[BlackZeroX]

& = 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 (vb) [Seleccionar] Expandir



msgbox typename(&HFF00&)
msgbox typename(&HFF00)



Dulces Lunas!¡.

[BlackZeroX]

.
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 (Vb) [Seleccionar] Expandir



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



Código (Vb) [Seleccionar] Expandir



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!¡.

[BlackZeroX]

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

Código (vb) [Seleccionar] Expandir



Function makelParam(ByVal L As Integer, ByVal U As Integer) As Long
  makelParam = L Or (U * &H10000)
End Function



Dulces Lunas!¡.

[BlackZeroX]

.
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 (Vb) [Seleccionar] Expandir



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.

Código (Vb) [Seleccionar] Expandir



lData = (lData + &H1)



Temibles Lunas!¡.

[BlackZeroX]

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

Código (vb) [Seleccionar] Expandir



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



Código (Vb) [Seleccionar] Expandir



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!¡.

[BlackZeroX]

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

Dulces Lunas!¡.