Ver Mensaje Individual
  #19  
Antiguo 26-11-2008
JF Sebastian JF Sebastian is offline
Miembro
 
Registrado: oct 2006
Posts: 108
Reputación: 18
JF Sebastian Va por buen camino
Muy buenas aportaciones, companeros.

Os dejo otra solucion que encontre por ahi y que permite interpolar facilmente y obtener el color deseado...



implementation
{$R *.dfm}
uses math;
Código Delphi [-]
 
procedure TForm1.FormClick(Sender: TObject);
var i: integer; R,G,B: byte; cl:TColor;
begin
  for i := 400 to 750 do
  begin
    WavelengthToRGB(1.0*i,R,G,B);
    cl := rgb(r,g,b);
    Canvas.Pen.Color := cl;
    Canvas.Moveto(i-300,0);
    Canvas.LineTo(i-300,100);
  end;
end;
 
procedure TForm1.WavelengthToRGB(const Wavelength:  double; var R,G,B: byte);
const
  Gamma        =   0.80;
  IntensityMax = 255;
var
  Blue   :  double;
  factor :  double;
  Green  :  double;
  Red    :  double;
  function Adjust(const Color, Factor: double):integer;
  begin
    if   Color = 0.0
    then result := 0
    else result := round(IntensityMax * Power(Color * Factor, Gamma))
  end;
begin
  case trunc(Wavelength) OF
    380..439: begin
        Red   := -(Wavelength - 440) / (440 - 380);
        Green := 0.0;
        Blue  := 1.0
    end;
    440..489: begin
        Red   := 0.0;
        Green := (Wavelength - 440) / (490 - 440);
        Blue  := 1.0
    end;
    490..509: begin
        Red   := 0.0;
        Green := 1.0;
        Blue  := -(Wavelength - 510) / (510 - 490)
    end;
    510..579: begin
        Red   := (Wavelength - 510) / (580 - 510);
        Green := 1.0;
        Blue  := 0.0
    end;
    580..644: begin
        Red   := 1.0;
        Green := -(Wavelength - 645) / (645 - 580);
        Blue  := 0.0
    end;
    645..780: begin
        Red   := 1.0;
        Green := 0.0;
        Blue  := 0.0
    end;
    else
      Red   := 0.0;
      Green := 0.0;
      Blue  := 0.0
  end;
  case trunc(Wavelength) of
    380..419:  factor := 0.3 + 0.7*(Wavelength - 380) / (420 - 380);
    420..700:  factor := 1.0;
    701..780:  factor := 0.3 + 0.7*(780 - Wavelength) / (780 - 700)
    else       factor := 0.0
  end;
  R := Adjust(Red,   Factor);
  G := Adjust(Green, Factor);
  B := Adjust(Blue,  Factor)
end;
Responder Con Cita