// 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