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