цвет пикселя

[Skarobey]

беру цвет в точке, как мне узнать оттенок?
например точного цвета нет, но идут оттенки красного, и черного(серого)... как отследить это изменение? может какая таблица цветов есть?

[Amed]

Еще раз. Как нет точного цвета? Получаешь же 3 байта: R,G,B.

[A.A.Z.]

Такое ощущение, что у чела неправильное представление о представлении цвета в компе

[Amed]

Чел. Это правда!? Как ты мог?

[Skarobey]

получаю цвет 5922138
мне надо определить входит ли он в диапазон красного... или желтое или черное и т.д. ... причем этот цвет не стабилен в данной точке... т.е. он может быть разный... и мне надо проверять когда он станет зеленого или другого цвета, т.е. if х=5922138 тут не катит, т.к. вэтой точке может 5922139 и уже невыйдет...

вот я и спрашиваю, мож какая функция или таблица есть?

[Amed]

Код: Выделить всё

Public Sub GetRGB(ByVal Color As Long, Red As Byte, Green As Byte, Blue As Byte)
    Dim c As Long
   
    c = (Color And &HFF&)
    Red = CByte(c)
   
    c = ((Color And &HFF00&) / &H100&)
    Green = CByte(c)
   
    c = ((Color And &HFF0000) / &H10000)
    Blue = CByte(c)     
End Sub

Использование:

Код: Выделить всё

Dim R as Byte, G as Byte, B as Byte

GetRGB 5922138,R,G,B

Msgbox R & " " & G & " " &  B


На выходе получаешь 90 93 90.
Первое 90 - это значит, что в пикселе доля красного - 90/255.
Второе - что доля зеленого 93/255.
Третье - что доля синего 90/255.

Исходя из этого и анализируй оттенок.[/code]

[A.A.Z.]

Ну... Таблицу найти сложновато, проще самому написать
Кинь на форму кнопку

Код: Выделить всё

Private Sub CommandButton_Click()
Dim Color&, R&, G&, B&, S$, Flags(5) As Boolean
Color = CLng(InputBox("Введите цвет"))
R = Color And &HFF&
G = (Color And &HFF00&) / &H100&
B = (Color And &HFF0000) / &H10000
Me.BackColor = Color
If (Abs(R - G) <= 20 Or Abs(G - B) <= 20 Or Abs(R - B) <= 20) And _
   (R / G) < 1.5 And (R / B) < 1.5 And (G / B) < 1.5 And (G / R) < 1.5 And (B / R) < 1.5 And (B / G) < 1.5 Then S = S & "Оттенок серого" & vbCrLf
If (R / G) > 1.625 And (R / B) > 1.625 Then S = S & "Оттенок красного" & vbCrLf: Flags(0) = True
If (R / G) < 1.625 And (R / B) > 1.625 Then S = S & "Оттенок желтого" & vbCrLf: Flags(1) = True
If (R / G) > 1.625 And (R / B) < 1.625 Then S = S & "Оттенок фиолетового" & vbCrLf: Flags(2) = True
If (G / R) > 1.625 And (G / B) > 1.625 Then S = S & "Оттенок зеленого" & vbCrLf: Flags(3) = True
If (G / R) > 1.625 And (G / B) < 1.625 Then S = S & "Оттенок цвета морской волны" & vbCrLf: Flags(4) = True
If (B / R) > 1.625 And (B / G) > 1.625 Then S = S & "Оттенок синего" & vbCrLf: Flags(5) = True
If (R / G) > 1.425 And (R / B) > 1.425 And Not Flags(0) Then S = S & "Возможно, оттенок красного" & vbCrLf
If (R / G) < 1.425 And (R / B) > 1.425 And Not Flags(1) Then S = S & "Возможно, оттенок желтого" & vbCrLf
If (R / G) > 1.425 And (R / B) < 1.425 And Not Flags(2) Then S = S & "Возможно, оттенок фиолетового" & vbCrLf
If (G / R) > 1.425 And (G / B) > 1.425 And Not Flags(3) Then S = S & "Возможно, оттенок зеленого" & vbCrLf
If (G / R) > 1.425 And (G / B) < 1.425 And Not Flags(4) Then S = S & "Возможно, оттенок цвета морской волны" & vbCrLf
If (B / R) > 1.425 And (B / G) > 1.425 And Not Flags(5) Then S = S & "Возможно, оттенок синего" & vbCrLf
MsgBox Color & vbCrLf & S
End Sub

Способ ламерский, накатан как макрос в ворде за 2 минуты. Но вроде работает

[A.A.Z.]

Гм, если бы опера обновила страницу, я бы не стал писать второй раз написанное Amed'ом Видимо, судьба у меня такая %)

[Skarobey]

Спасибо... выручили...

[Amed]

A.A.Z.! Ну почему всегда ты!?