Option Explicit
 
Private Sub Command1_Click()
  Picture1.Width = 644 * Screen.TwipsPerPixelX
  Picture1.Height = 484 * Screen.TwipsPerPixelY
  ResizePicture1
  Picture1.Picture = Picture1.Image
End Sub
 
Private Sub Form_Load()
  Picture1.ScaleMode = vbPixels
  Picture2.Visible = False
  Picture1.Picture = LoadPicture("Imagen.bmp")
End Sub
 
Sub ResizePicture1()
  Picture2.ScaleMode = vbTwips
  Picture2.AutoSize = True
  Picture2.Picture = Picture1.Picture
  Picture1.AutoRedraw = True
  Picture1.PaintPicture Picture2.Picture, 0, 0, Picture1.ScaleWidth * Screen.TwipsPerPixelX, Picture1.ScaleHeight * Screen.TwipsPerPixelY, _
  0, 0, Picture2.ScaleWidth, Picture2.ScaleHeight
End Sub
 

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

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

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