//引数のvarは参照渡し
{HLS変換}
procedure RGBtoHLS(rgbR,rgbG,rgbB:integer;var hlsH,hlsL,hlsS: double);
var
  CMax  		:double;
  CMin  		:double;
  cd    		:double;
  dblR,dblG,dblB	:double;
begin
 
  dblR := rgbR/255;
  dblG := rgbG/255;
  dblB := rgbB/255;
 
  CMax := MAX(dblR,MAX(dblG,dblB));
  CMin := MIN(dblR,Min(dblG,dblB));
  hlsL := (CMax + CMin) / 2;
  cd   :=  CMax - CMin;
 
  If cd = 0 Then
  begin
    hlsL := hlsL * 255;
    hlsS := 0;
    exit;
  end;
 
  If hlsL <= 0.5 Then hlsS := cd/(CMax + CMin)
                 else hlsS := cd/(2 - (CMax + CMin));
 
  If dblR = CMax Then hlsH :=     (dblG - dblB) / cd else
  If dblG = CMax Then hlsH := 2 + (dblB - dblR) / cd else
  										hlsH := 4 + (dblR - dblG) / cd;
  hlsH := hlsH * 60;
  If hlsH < 0    Then hlsH := hlsH + 360;
  If hlsH >= 360 Then hlsH := hlsH - 360;
 
  hlsS := hlsS*255;							//0~255に補正
  hlsL := hlsL*255;
 
end;
 
{RGB変換}
procedure HLStoRGB(hlsH,hlsL,hlsS: double ; var rgbR,rgbG,rgbB :Integer);
var
  CMax: double;
  CMin: double;
 
  {ネスト関数:強度を求める}
  function GetHLSValue( Hue , CMin , CMax : double):double;
  begin
    If Hue >= 360 Then Hue := Hue - 360
     Else if Hue < 0 Then Hue := Hue + 360;
 
    If       Hue < 60  Then GetHLSValue := CMin + (CMax - CMin) * Hue / 60
     Else If Hue < 180 Then GetHLSValue := CMax
     Else If Hue < 240 Then GetHLSValue := CMin + (CMax - CMin) * (240 - Hue) / 60
     Else                   GetHLSValue := CMin;
  end;
 
begin
 
  //0~1に正規化
  hlsL := hlsL / 255;
  hlsS := hlsS / 255;
 
  if hlsH < 0   then hlsH := hlsH +360;
  if hlsH > 359 then hlsH := hlsH -360;
 
  hlsS := EnsureRange(hlsS,0,255);
  hlsL := EnsureRange(hlsL,0,255);
 
  If hlsL <= 0.5 Then
    begin
      CMin := hlsL * (1 - hlsS);
      CMax := 2 * hlsL -CMin;
    end
  else
    begin
      CMax := hlsL * (1 - hlsS) + hlsS;
      CMin := hlsL * 2 - CMax;
    end;
 
  rgbR := Round(GetHLSValue(hlsH + 120, CMin, CMax)*255);
  rgbG := Round(GetHLSValue(hlsH,       CMin, CMax)*255);
  rgbB := Round(GetHLSValue(hlsH - 120, CMin, CMax)*255);
 
end;
 
{HLS補正}
procedure HLSChange(bmp: TBitmap; AddH,AddL,AddS:Integer);
var
  x,y       :integer;
  P         :pRGBArray;
  H,L,S	    :double;
  R,G,B     :Integer;
begin
 
    for y := 0 to bmp.Height -1 do begin
      P := bmp.ScanLine[y];
      for x := 0 to bmp.Width -1 do Begin
 
        B := P[X].B;
        G := P[X].G;
        R := P[X].R;
 
        H := 0;
        L := 0;
        S := 0;
 
        RGBtoHLS(R,G,B,H,L,S);
 
        H := H + AddH;
        L := L + AddL;
        S := S + AddS;
 
        HLStoRGB(H,L,S,R,G,B);
 
        P[x].B := Max(Min(255,B)),0);
        P[x].G := Max(Min(255,G)),0);
        P[x].R := Max(Min(255,R)),0);
 
        end;
    end;
 
end;
 
最終更新:2010年04月10日 22:31