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


Оставить комментарий

Я не робот.


Предлагаем Вашему вниманию проекты коттеджей и домов.