En el editor de codigo pega el siguiente codigo
Option Explicit
Dim r, v, a As String
Dim val1, val2, val3 As String
Dim inversa As Boolean
Const Num_Hexa = "0123456789ABCDEFabcdef"
'procedimiento que muestra el valor RGB en el control picture
Sub MostrarValor()
picColor.BackColor = RGB(sRojo.Value, sVerde.Value, sAzul.Value)
End Sub
'procedimiento que transforma los valores de los Slider a valores Hexadecimales
Sub Valores()
r = HEX$(sRojo.Value)
v = HEX$(sVerde.Value)
a = HEX$(sAzul.Value)
If sRojo.Value = 255 Then val1 = "0" Else val1 = r
If sVerde.Value = 255 Then val2 = "0" Else val2 = v
If sAzul.Value = 255 Then val3 = "0" Else val3 = a
Valor.Text = "#" + val1 + val2 + val3
End Sub
Private Sub cmd_converter_Click()
Convertir
End Sub
' procedimiento que convierte valores hexadecimales introducidos por teclado
' a valores hexadecimales y los muestra en el control picture
Sub Convertir()
Dim s As String
s = Valor.Text
If (Mid(s, 1, 1)) = "#" Then
If verifica(s) = True Then
r = Val("&H" & (Mid(s, 2, 2)))
v = Val("&H" & (Mid(s, 4, 2)))
a = Val("&H" & (Mid(s, 6, 2)))
inversa = True
sRojo.Value = CInt(r)
inversa = True
sVerde.Value = CInt(v)
inversa = True
sAzul.Value = CInt(a)
picRojo.BackColor = RGB(CInt(r), 0, 0)
picVerde.BackColor = RGB(0, CInt(v), 0)
picAzul.BackColor = RGB(0, 0, CInt(a))
picColor.BackColor = RGB(CInt(r), CInt(v), CInt(a))
Else
MsgBox "No es un color valido", vbInformation, "Importante"
End If
Else
MsgBox "El formato de entrada es incorrecto", vbInformation, "Importante"
End If
End Sub
' funciona auxiliar que verifica si la cadena de texto introducida
' corresponde a una cadena valida hexadecimal
Function verifica(cadena) As Boolean
Dim i As Integer
Dim valido As Boolean
valido = False
For i = 2 To Len(cadena)
If InStr(1, Num_Hexa, Mid(cadena, i, 1)) <> 0 Then
valido = True
Else
valido = False
Exit For
End If
Next
verifica = valido
End Function
Private Sub Form_Load()
'inicio a valores
Valor.Text = "#FFFFFF"
Valor.MaxLength = 7
r = "FF"
v = "FF"
a = "FF"
inversa = False
Convertir
MostrarValor
End Sub
Private Sub sAzul_Change()
If inversa = False Then
Valores
picAzul.BackColor = RGB(0, 0, sAzul.Value)
MostrarValor
End If
inversa = False
End Sub
Private Sub sRojo_Change()
If inversa = False Then
Valores
picRojo.BackColor = RGB(sRojo.Value, 0, 0)
MostrarValor
End If
inversa = False
End Sub
Private Sub sVerde_Change()
If inversa = False Then
Valores
picVerde.BackColor = RGB(0, sVerde.Value, 0)
MostrarValor
End If
inversa = False
End Sub
para compilar el codigo presiona CTRL + F5 si todo esta bien, crea el ejecutableEl codigo fuente consta con sus respectivos comentarios asi que no hay pierde
0 comentarios:
Publicar un comentario