Форум: "Основная";
Текущий архив: 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