18
Октябрь
2009
Перевод цвета в RGB
Перевод цвета в RGB.
Private Sub cmd_Click()
txtDClr.Text = RGB(Val(txtInR.Text), Val(txtInG.Text), Val(txtInB.Text))
txtHClr.Text = Hex(Val(txtDClr.Text))
RGBT txtDClr.Text
'Функция RGBT возвращает в массив DRGB значения цветов в следующем порядке
'DRGB(1) - Red
'DRGB(2) - Green
'DRGB(3) - Blue
txtOutR.Text = DRGB(1)
txtOutG.Text = DRGB(2)
txtOutB.Text = DRGB(3)
End Sub
Public DRGB() As Integer
Public Function RGBT(Sense As String)
ReDim DRGB(1 To 3)
Dim DRGB1(1 To 3) As String
Dim HClr As String
HClr = Hex(Sense)
Select Case Len(HClr)
Case 1
DRGB(1) = DEC(HClr)
Case 2
DRGB(1) = DEC(HClr)
Case 3
DRGB1(1) = Right(HClr, 2)
DRGB1(2) = Left(HClr, 1)
DRGB(1) = DEC(DRGB1(1))
DRGB(2) = DEC(DRGB1(2))
Case 4
DRGB1(1) = Right(HClr, 2)
DRGB1(2) = Left(HClr, 2)
DRGB(1) = DEC(DRGB1(1))
DRGB(2) = DEC(DRGB1(2))
Case 5
DRGB1(1) = Right(HClr, 2)
DRGB1(2) = Mid(HClr, 2, 2)
DRGB1(3) = Left(HClr, 1)
DRGB(1) = DEC(DRGB1(1))
DRGB(2) = DEC(DRGB1(2))
DRGB(3) = DEC(DRGB1(3))
Case 6
DRGB1(1) = Right(HClr, 2)
DRGB1(2) = Mid(HClr, 3, 2)
DRGB1(3) = Left(HClr, 2)
DRGB(1) = DEC(DRGB1(1))
DRGB(2) = DEC(DRGB1(2))
DRGB(3) = DEC(DRGB1(3))
End Select
End Function
'Переводим число из шеснадцатеричной системы в десятичную
Function DEC(Sense As String)
Sense = "&H" & Sense
DEC = Val(Sense)
End Function