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

Вниз

Где взять модуль HSLUtils?   Найти похожие ветки 

← →
Arazel ©   (2005-10-25 21:57) [0]

Вот скачал пример из Kladovki ownerdrawmenu
а  он просит  этот модуль... Не подскажите где
его взять?

---

← →
ssk ©   (2005-10-26 09:03) [1]

ну так и обратись к автору - Игорю Шевченко

---

← →
Игорь Шевченко ©   (2005-10-26 09:46) [2]

Извиняюсь, наверное пропустил.
Вот текст:
//------------------------------------------------------------------------------
//
// HSL - RGB colour model conversions
//
// These four functions can be used to convert between the RGB and HSL colour
// models.  RGB values are represented using the 0-255 Windows convention and
// always encapsulated in a TColor 32 bit value.  HSL values are available as
// either 0 to 1 floating point (double) values or as a 0 to a defined integer
// value.  The colour common dialog box uses 0 to 240 by example.
//
// The code is based on that found (in C) on:
//
//   http:/www.r2m.com/win-developer-faq/graphics/8.html
//
// Grahame Marsh 12 October 1997
//
// Freeware - you get it for free, I take nothing, I make no promises!
//
// Please feel free to contact me: grahame.s.marsh@corp.courtaulds.co.uk
//
// Revison History:
//    Version 1.00 - initial release  12-10-1997
//
//------------------------------------------------------------------------------

unit HSLUtils;

interface

uses
 Windows, Graphics;

var
 HSLRange: integer = 240;

// convert a HSL value into a RGB in a TColor
// HSL values are 0.0 to 1.0 double
function HSLtoRGB (H, S, L: double): TColor;

// convert a HSL value into a RGB in a TColor
// SL values are 0 to the HSLRange variable
// H value is to HSLRange-1
function HSLRangeToRGB (H, S, L : integer): TColor;

// convert a RGB value (as TColor) into HSL
// HSL values are 0.0 to 1.0 double
procedure RGBtoHSL (RGB: TColor; var H, S, L : double);

// convert a RGB value (as TColor) into HSL
// SL values are 0 to the HSLRange variable
// H value is to HSLRange-1
procedure RGBtoHSLRange (RGB: TColor; var H, S, L : integer);

implementation

function HSLtoRGB (H, S, L: double): TColor;
var
 M1, M2: double;

 function HueToColourValue (Hue: double) : byte;
 var
   V : double;
 begin
   if Hue < 0 then
     Hue := Hue + 1
   else
     if Hue > 1 then
       Hue := Hue - 1;

   if 6 * Hue < 1 then
     V := M1 + (M2 - M1) * Hue * 6
   else
     if 2 * Hue < 1 then
       V := M2
     else
       if 3 * Hue < 2 then
         V := M1 + (M2 - M1) * (2/3 - Hue) * 6
       else
         V := M1;
   Result := round (255 * V)
 end;

var
 R, G, B: byte;
begin
 if S = 0 then
 begin
   R := round (255 * L);
   G := R;
   B := R
 end else begin
   if L <= 0.5 then
     M2 := L * (1 + S)
   else
     M2 := L + S - L * S;
   M1 := 2 * L - M2;
   R := HueToColourValue (H + 1/3);
   G := HueToColourValue (H);
   B := HueToColourValue (H - 1/3)
 end;

 Result := RGB (R, G, B)
end;

function HSLRangeToRGB (H, S, L : integer): TColor;
begin
 Result := HSLToRGB (H / (HSLRange-1), S / HSLRange, L / HSLRange)
end;

// Convert RGB value (0-255 range) into HSL value (0-1 values)

procedure RGBtoHSL (RGB: TColor; var H, S, L : double);

 function Max (a, b : double): double;
 begin
   if a > b then
     Result := a
   else
     Result := b
 end;

 function Min (a, b : double): double;
 begin
   if a < b then
     Result := a
   else
     Result := b
 end;

var
 R, G, B, D, Cmax, Cmin: double;
begin
 R := GetRValue (RGB) / 255;
 G := GetGValue (RGB) / 255;
 B := GetBValue (RGB) / 255;
 Cmax := Max (R, Max (G, B));
 Cmin := Min (R, Min (G, B));

// calculate luminosity
 L := (Cmax + Cmin) / 2;

 if Cmax = Cmin then  // it"s grey
 begin
   H := 0; // it"s actually undefined
   S := 0
 end else begin
   D := Cmax - Cmin;

// calculate Saturation
   if L < 0.5 then
     S := D / (Cmax + Cmin)
   else
     S := D / (2 - Cmax - Cmin);

// calculate Hue
   if R = Cmax then
     H := (G - B) / D
   else
     if G = Cmax then
       H  := 2 + (B - R) /D
     else
       H := 4 + (R - G) / D;

   H := H / 6;
   if H < 0 then
     H := H + 1
 end
end;

procedure RGBtoHSLRange (RGB: TColor; var H, S, L : integer);
var
 Hd, Sd, Ld: double;
begin
 RGBtoHSL (RGB, Hd, Sd, Ld);
 H := round (Hd * (HSLRange-1));
 S := round (Sd * HSLRange);
 L := round (Ld * HSLRange);
end;

end.

---

← →
Arazel ©   (2005-10-26 11:38) [3]

Игорь Шевченко ©   (26.10.05 09:46) [2]
Я его уже нашол! Он у тебя в OwnerListBox был ну что-то подобное... =)

Меню класное! Лист Бокс тоже! а вот нащет Ownercaption надо пороботать
он у тебя с мерцанием... вобщем все класно кроме этой =)

---

← →
Игорь Шевченко ©   (2005-10-26 11:50) [4]

>  вот нащет Ownercaption надо пороботать


поработай. я не запрещаю.

---

← →
Умник   (2005-10-26 13:24) [5]

Добрый, добрый дядя Игорь...

---

← →
Kerk ©   (2005-10-26 18:22) [6]

> Игорь Шевченко

Давай чтоли как-нибудь это поправим. Ато и яндексом сабжевый файл уже ищут :)
Перезакачай как время будет :)

---

← →
Игорь Шевченко ©   (2005-10-26 21:09) [7]

Kerk ©   (26.10.05 18:22) [6]

Хорошо, на следующей неделе :)

---

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

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

Наверх

Память: 0.47 MB
Время: 0.039 c