Recopilacion de Funciones con operaciones Binarias.
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
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
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
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
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
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
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
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!¡.
Navegación
[#] Página Siguiente
[*] Página Anterior