[Resolvido] Converte cores RGB e hexadecimal.

[xanburzum 169]

Esta classe tem valores RGB e transforma-os em hexadecimals, ele também converte hexadecimals para RGB.

 

 

sintaxe:

 

Set object = New ColorConversion

 

exemplo:

 

'''''''''''''''''''''''''''''''''''
'converter hexadecimal para rgb
'''''''''''''''''''''''''''''''''''
Set CCores = New ColorConversion
CCores .HEXadecimal = "#CC3300"
CCores .HEXtoRGB
Response.Write "R=" & CCores .RGBRed & " G=" & _
	CCores .RGBGreen & " B=" & CCores .RGBBlue
Set CCores = Nothing



'''''''''''''''''''''''''''''''''''
'converter rgb para hexadecimal
'''''''''''''''''''''''''''''''''''
Set CCores = New ColorConversion
CCores .RGBRed = 123
CCores .RGBGreen = 15
CCores .RGBBlue = 0
CCores .RGBtoHEX
Response.write  CCores .HEXadecimal
Set CCores = Nothing

 

code:

<%
Class Convertercores
	
	Private s1, s2, s3, s4

	Public Property Let RGBRed(byVal sIn)
		s1 = sIn
	End Property

	Public Property Let RGBGreen(byVal sIn)
		s2 = sIn
	End Property

	Public Property Let RGBBlue(byVal sIn)
		s3 = sIn
	End Property

	Public Property Let HEXadecimal(byVal sIn)
		s4 = sIn
	End Property

	Public Property Get RGBRed()
		RGBRed = s1
	End Property

	Public Property Get RGBGreen()
		RGBGreen = s2
	End Property

	Public Property Get RGBBlue()
		RGBBlue = s3
	End Property

	Public Property Get HEXadecimal()
		HEXadecimal = s4
	End Property

	Public Sub RGBtoHEX()
		HEXadecimal = ""
		If RGBRed = "" Or RGBGreen = "" Or RGBBlue = "" Then
			ConversionError 5
			Exit Sub
		End If
		HEXadecimal = RGBtoHexaDecimal(RGBRed, RGBGreen, RGBBlue)
	End Sub

	Public Sub HEXtoRGB()
		RGBRed = ""
		RGBGreen = ""
		RGBBlue = ""
		If HEXadecimal = "" Then
			ConversionError 4
			Exit Sub
		End If
		HexaDecimaltoRGB HEXadecimal
	End Sub

	Private Function RGBtoHexaDecimal(byval Red, byval Green, byval Blue)
		 ' Traduz valores de cores RGB para  
		 ' Valores hexadecimais para uso na web
		Dim strRed, strGreen, strBlue

		 ' valores RGB devem ser inteiros entre 0 e 255
		if isnumeric(Red) = False then ConversionError 1
		if isnumeric(Green) = False then ConversionError 1
		if isnumeric(Blue) = False then ConversionError 1
		if Red < 0 OR Red > 255 then ConversionError 1
		if Green < 0 OR Green > 255 then ConversionError 1
		if Blue < 0 OR Blue > 255 then ConversionError 1
		 ' uma função construída em hex 
'Portanto, vamos usá-lo para criar um hexadecimais para a 
'Input cores.
		strRed = CSTR(Hex(Red))
		strGreen = CSTR(Hex(Green))
		strBlue = CSTR(Hex(Blue))
		 ' cada cor tem de ter 2 caracteres  por isso, se houver 
'falta colocar primeiro um zero, assim a função 
'Irá produzir uma string hexadecimal válido.
		if Len(Hex(Red)) = 1 then strRed = "0" & strRed
		if Len(Hex(Green)) = 1 then strGreen = "0" & strGreen
		if Len(Hex(Blue)) = 1 then strBlue = "0" & strBlue
		 ' combinar valores e iniciar a seqüência com um sinal de #
		RGBtoHexaDecimal = "#" & strRed & strGreen & strBlue
	End Function

	Private Sub HexaDecimaltoRGB(byval strInput)
		 ' Traduz cores hexadecimais para valores RGB 
'Hexadecimals são sete caracteres 
' Incluindo o sinal de número
		if NOT Left(strInput, 1) = "#" then ConversionError 2
		if NOT Len(strInput) = 7 then ConversionError 3
		 ' sinal # 
		strInput = Right(strInput, Len(strInput)-1)

		 ' em seguida, analisar valores para vermelho, verde e azul  e executar 
'A função da ParseHexaDecimal valores RGB 
		RGBRed = ParseHexaDecimal(Left(strInput, 2))
		RGBGreen = ParseHexaDecimal(Mid(strInput, 3, 2))
		RGBBlue = ParseHexaDecimal(Right(strInput, 2))
	End Sub

	Private Function ParseHexaDecimal(byval strInput)
		'analisa dois caráter um valor hexadecimal 
'Em dois individuais diferentes valores hexadecimais
		Dim strTemp
		
		'TranslateHex executa a função de cada um dos dois 
'caracteres introduzido . após a função executada, 
'Multiplica o primeiro caracter por 16 e 
'Adiciona o resultado para o segundo caracter e obtem um 
'Valor de 0-255.
		strTemp = Int(TranslateHex(Left(strInput, 1)) * 16)
		strTemp = Int(strTemp + _
			TranslateHex(Right(strInput, 1)))
		ParseHexaDecimal = Int(strTemp)
	End Function

	Private Sub ConversionError(byval iErrVal)
		'erro personalizada baseada em  
'critérios simples
		Select Case iErrVal
			 ' encontrar um erro
			Case 1
				x = "RGB valores devem ser inteiros " & _
					"entre 0 e 255"
			Case 2
				x = "Hexadecimal inicia com " & _
					"o character # "
			Case 3
				x = "Um hexadecimal é escrito no " & _
					"formato de #xxxxxx onde " & _
					"cada x tem um hexadecimal " & _
					"valores de 0-9 or A-F"
			Case 4
				x = "Chamou o metodo HEXtoRGB ()  " & _
					"sem a primeira definição " & _
					"da propriedade Hexadecimal ."
			Case 5
				x = "Chamou método RGBtoHEX () sem " & _
					"a primeira definição RGBRed, RGBGreen " & _
					"e propriedade RGBBlue."
		End Select
		 ' levantar um erro personalizado para esse aplicativo.
		Err.Raise iErrVal, "Convertercores v2.0", x
	End Sub

	Private Function TranslateHex(byval strInput)
		 ' decifra um hexadecimal (0-F) em um valor numérico
		Dim x, i

		if ISNUMERIC(strInput) then
			 'se a entrada é um número que não fazem 
'Tratamento nesta função
			TranslateHex = CINT(strInput)
			Exit Function
		else
			 'fazer uma matriz de todos os possíveis hexadecimais Valores
			x = Array("0", "1", "2", "3", "4", "5", "6", _
				"7", "8", "9", "A", "B", "C", "D", "E", "F")
			 'Fixar um subscrito fora do intervalo de erro que 
'Ocorre quando alguém digita uma letra inválida 

«Hexadecimals acima:
			If UCASE(strInput) = "A" OR UCASE(strInput) = "B" OR _
			   UCASE(strInput) = "C" OR UCASE(strInput) = "D" OR _
			   UCASE(strInput) = "E" OR UCASE(strInput) = "F" Then
				for i = 10 to 16  
					' apenas 10 .-16. correspondem às letras
					' 'Em nossa matriz acima. Encontre o array 
					' Valor que corresponde à entrada, obter 
					'O número de inscrição no array 
					'E forçar o valor inteiro só para 
					'segurança
					If CSTR(strInput) = CSTR(x(i)) then 
						TranslateHex = CINT(i)
						 ' Fechar  função
						 ' Obter  valor correspondente 
						Exit Function
					End If
				next
			Else
				 ' 
				ConversionError 3
			End If
		end if
	End Function
End Class

%>