Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 2007.07.15;
Скачать: [xml.tar.bz2];

Вниз

Поделитесь функцией HSV to RGB на Паскале ?   Найти похожие ветки 

 
Драйвер   (2007-05-06 01:56) [0]

А то описаний много, а самой функции не найду никак.


 
Fredy314 ©   (2007-05-06 02:14) [1]

вот тебе куски кода из одной моей очень старой проги, разберёшся?

Procedure TAppForm.RGBtoHLS;
Var
 mn, mx, j: Integer;
 RR, GG, BB: Integer;
 LL, S1, HH: Real;
Begin
 RR := R.Position;
 GG := G.Position;
 BB := B.Position;
 If RR < GG Then
   Begin mn := RR;
     mx := GG;
     j := GG;
   End
 Else
   Begin mn := GG;
     mx := RR;
     j := RR;
   End;
 If BB < mn Then
   mn := BB
 Else
   If BB > mx Then
     Begin mx := BB;
       j := BB;
     End;
 If mn = mx Then
   Begin LL := mn / 255;
     S1 := 0;
     HH := 0;
   End
 Else
   Begin
     LL := (mn + mx) / 510;
     If LL <= 0.5 Then
       S1 := (mx - mn) / (mn + mx)
     Else
       S1 := (mx - mn) / (510 - mn - mx);
     If J = RR Then HH := (GG - BB) * 60 / (mx - mn) + 360;
     If J = GG Then HH := (BB - RR) * 60 / (mx - mn) + 120;
     If J = BB Then HH := (RR - GG) * 60 / (mx - mn) + 240;
     While HH >= 360 Do
       HH := HH - 360;
   End;
 H.Position := Round(HH);
 S.Position := Round(S1 * 255);
 V.Position := Round(LL * 255);
 {V.Position:=Round((0.30 * R.Position) +
                   (0.59 * G.Position) +
                   (0.11 * B.Position));}
 sR.Caption := "R:$" + IntToHex(R.Position, 2) + "(" + IntToStr(R.Position) + ")";
 sG.Caption := "G:$" + IntToHex(G.Position, 2) + "(" + IntToStr(G.Position) + ")";
 sB.Caption := "B:$" + IntToHex(B.Position, 2) + "(" + IntToStr(B.Position) + ")";
 sV.Caption := "L:$" + IntToHex(V.Position, 2) + "(" + IntToStr(V.Position) + ")";
 sH.Caption := "H:$" + IntToHex(H.Position, 2) + "(" + IntToStr(H.Position) + ")";
 sS.Caption := "S:$" + IntToHex(S.Position, 2) + "(" + IntToStr(S.Position) + ")";
 P.Color := RGB(R.Position, G.Position, B.Position);
End;

Procedure TAppForm.HLStoRGB;

Function VL(m1, m2, H: Real): Byte;
 Var
   m: Real;
 Begin
   If H >= 360 Then H := H - 360;
   If H < 0 Then H := H + 360;
   If H < 60 Then
     m := m1 + (m2 - m1) * H / 60
   Else
     If H < 180 Then
       m := m2
     Else
       If H < 240 Then m := m1 + (m2 - m1) * (240 - H) / 60;
   VL := Round(m * 255);
 End;
Var
 S1, HH, LL, m1, m2: Real;
Begin
 LL := V.Position / 255;
 S1 := S.Position / 255;
 HH := H.Position;
 If S.Position = 0 Then
   Begin
     R.Position := V.Position;
     G.Position := V.Position;
     B.Position := V.Position;
   End
 Else
   Begin
     If LL <= 0.5 Then
       m2 := LL + LL * S1
     Else
       m2 := LL + S1 - LL * S1;
     m1 := 2 * LL - m2;
     R.Position := VL(m1, m2, HH + 120);
     G.Position := VL(m1, m2, HH);
     B.Position := VL(m1, m2, HH - 120);
   End;

 {R.Position:=Round(V.Position/0.30);
 G.Position:=Round(V.Position/0.59);
 B.Position:=Round(V.Position/0.11);}
 sR.Caption := "R:$" + IntToHex(R.Position, 2) + "(" + IntToStr(R.Position) + ")";
 sG.Caption := "G:$" + IntToHex(G.Position, 2) + "(" + IntToStr(G.Position) + ")";
 sB.Caption := "B:$" + IntToHex(B.Position, 2) + "(" + IntToStr(B.Position) + ")";
 sV.Caption := "L:$" + IntToHex(V.Position, 2) + "(" + IntToStr(V.Position) + ")";
 sH.Caption := "H:$" + IntToHex(H.Position, 2) + "(" + IntToStr(H.Position) + ")";
 sS.Caption := "S:$" + IntToHex(S.Position, 2) + "(" + IntToStr(S.Position) + ")";
 P.Color := RGB(R.Position, G.Position, B.Position);
End;


 
Драйвер   (2007-05-06 02:22) [2]

Мне нужно не RGBtoHLS, а наоборот.


 
MBo ©   (2007-05-06 07:37) [3]

В модуль GraphUtil заглядывал?


 
Fredy314 ©   (2007-05-06 19:02) [4]

> Мне нужно не RGBtoHLS, а наоборот.

Так здесь обе


 
Vovan # 2   (2007-05-07 00:35) [5]

Так вы ж дали код для HSL, а просили для HSV.
http://www.efg2.com/Lab/Graphics/Colors/HSV.htm


 
Драйвер   (2007-05-07 01:24) [6]


> Vovan # 2   (07.05.07 00:35) [5]
>
> Так вы ж дали код для HSL, а просили для HSV.


Точно! А то смотрю, что-то не то. :)

Ссылку посмотрю.


 
Fredy314 ©   (2007-05-07 09:41) [7]

а ето разве не одно и тоже?


 
TStas ©   (2007-05-07 18:39) [8]

Я как-то делал через тип вспомогательный
type THelpType = Array[1..4] of byte; PHelpType = ^THelpType;
PColor = ^TColor;
Ну и указатели присваивал. Они, вроде и получалить 1 - красный, 2-зеленый, 3 - синий //Но вроде


 
Макс2   (2007-05-12 02:55) [9]

Чем эти два цвета отличаются?
HSV и HLS?


 
Belorus ©   (2007-05-13 20:30) [10]

HSV и HLS - не цвета.


 
Макс2   (2007-05-14 03:12) [11]

Это и без тебя знают.
Если не знаешь ответа - так и скажи.



Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2007.07.15;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.47 MB
Время: 0.047 c
15-1181744140
VID
2007-06-13 18:15
2007.07.15
Где я могу прочитать про существующие сервера приложений ?


15-1181625712
boriskb
2007-06-12 09:21
2007.07.15
Коллекция книг по компьютерной тематике,


2-1181996130
WhiteCat
2007-06-16 16:15
2007.07.15
Добавление записи в DBGrid


2-1182176439
kyro
2007-06-18 18:20
2007.07.15
Заголовки mp3


2-1182344492
Mishenka
2007-06-20 17:01
2007.07.15
Не удаляется компонент





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский