// Neben dem RGB-Modell, das eine Farbe über die
// Rot-Grün-Blau Anteile charakterisiert, gibt es noch
// eine ganze Reihe andere Prinzipien um eine Farbe zu
// definieren. Wenn man in Delphi einen Colordialog
// öffnet und auch noch "Farbe definieren >>" anklickt,
// werden neben den RGB-Werten auch noch die HSL-Werte
// (Hue, Saturation, Luminosity) angezeigt (zu deutsch:
// Farbe, Sättigung, Helligkeit). Mit dem nachfolgenden
// Code kann man den Typ TColor in die entsprechenden
// H, S, L Werte umrechnen. Weiter unten steht, wie der
// umgekehrte Weg funktioniert.
// Hinweis:
// Nicht jedem konkreten RGB-Wert ist ein konkreter
// HSL-Wert zugeordnet. So entspricht ein RGB-Wert von
// 0,0,0 (clblack) in der Regel dem HSL-Wert 160,0,0
// aber auch allen anderen Werten, bei denen die
// Helligkeit = 0 ist. Abgedunkeltes Weiss ist halt
// das Gleiche wie aufgehelltes Grau.

// Getestet mit D4 unter WinME

uses math;

procedure ColorToHSL(RGBC: TColor; var Farbe, Saettigung, Helligkeit:Byte);
var
R, G, B, cMax, cMin: Byte;
Rdelta, Gdelta, Bdelta, H, S, L: Integer;
const
HLSMAX = 240;
RGBMAX = 255;
function rechne(rb: Byte): Integer;
begin
result := Trunc(((cMax - rb) * (HLSMAX / 6) + (cMax - cMin) / 2) /
(cMax - cMin));
end;
begin
R := GetRValue(ColorToRGB(RGBC));
G := GetGValue(ColorToRGB(RGBC));
B := GetBValue(ColorToRGB(RGBC));
cMax := max(max(R, G), B);
cMin := min(min(R, G), B);
L := Trunc(((cMax + cMin) * HLSMAX + RGBMAX) / (2 * RGBMAX));
if cMax = cMin then begin
S := 0;
H := Trunc(HLSMAX * 2 / 3);
end else begin
if
L <= HLSMAX div 2 then
S := Trunc(((cMax - cMin) * HLSMAX + (cMax + cMin) / 2) / (cMax + cMin))
else
S := Trunc(((cMax - cMin) * HLSMAX + (2 * RGBMAX - cMax - cMin) / 2)
/ (2 * RGBMAX - cMax - cMin));
Rdelta := rechne(r);
Gdelta := rechne(g);
Bdelta := rechne(b);
if R = cMax then
H := Bdelta - Gdelta else
if
G = cMax then H := Trunc(HLSMAX / 3 + Rdelta - Bdelta) else
H := Trunc((2 * HLSMAX) / 3 + Gdelta - Rdelta);
if H < 0 then inc(H, HLSMAX) else
if
H > HLSMAX then dec(H, HLSMAX);
end;
Farbe := Byte(H);
Saettigung := Byte(S);
Helligkeit := Byte(L);
end;

// Beispielaufruf
procedure TForm1.Button12Click(Sender: TObject);
var farbe, saettigung, helligkeit: byte;
begin
if
colordialog1.execute then begin
ColorToHSL(colordialog1.color, farbe, saettigung, helligkeit);
label1.caption :=
inttostr(farbe) + #13 + inttostr(saettigung) + #13 +
inttostr(helligkeit);
end else label1.caption := '';
end;



// ---------------------------------------------------------------


// Und so kann man HSL-Werte wieder zu TColor umrechnen:

function HSLtoColor(Farbe, Saettigung, Helligkeit: Byte): TColor;
var
m1, m2: Double;
R, G, B: Byte;
const
HLSMAX = 240;
RGBMAX = 255;
function FTRGB(n1, n2, f: Double): Double;
begin
if
f < 0 then f := f + HLSMAX else
if f > HLSMAX then f := f - HLSMAX;
if f < HLSMAX / 6 then begin
result := trunc(n1 + (((n2 - n1) * f + (HLSMAX / 12)) / (HLSMAX / 6)));
exit;
end;
if
trunc(f) < HLSMAX / 2 then begin
result := round(n2 + 0.1);
exit;
end;
if
trunc(f) < (HLSMAX * 2) / 3 then
result := trunc(n1 + 0.1 + (((n2 - n1) * (((HLSMAX * 2) / 3) - f)
+ (HLSMAX / 12)) / (HLSMAX / 6)))
else result := n1;
end;
begin
if
Farbe > HLSMAX - 1 then Farbe := HLSMAX - 1;
if Saettigung > HLSMAX then Saettigung := HLSMAX;
if Helligkeit > HLSMAX then Helligkeit := HLSMAX;
if Saettigung = 0 then begin
R := trunc((Helligkeit * RGBMAX) / HLSMAX);
G := R;
B := R;
end else begin
if
Helligkeit <= HLSMAX / 2 then
m2 := trunc((Helligkeit * (HLSMAX + Saettigung) + (HLSMAX / 2)) / HLSMAX)
else m2 := (Helligkeit + Saettigung - ((Helligkeit * Saettigung)
+ (HLSMAX / 2)) / HLSMAX);
m1 := trunc(2 * Helligkeit - m2);
R := trunc((FTRGB(m1, m2, Farbe + (HLSMAX / 3)) * RGBMAX
+ (HLSMAX / 2)) / HLSMAX);
G := trunc((FTRGB(m1, m2, Farbe) * RGBMAX + (HLSMAX / 2)) / HLSMAX);
B := trunc((FTRGB(m1, m2, Farbe - (HLSMAX / 3)) * RGBMAX
+ (HLSMAX / 2)) / HLSMAX);
end;
result := rgb(R, G, B);
end;

// Beispielaufruf
procedure TForm1.Button12Click(Sender: TObject);
begin
color := HSLtoColor(172, 141, 160);
end;
 


 

Zugriffe seit 6.9.2001 auf Delphi-Ecke