Es una buena idea, pero podriais corregir los fallos gordos, que aqui dejan editar
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.
Autor
En línea
