Licht Simulation RGB in Abhängigkeit der Frequenz

[Sir Rufo]

Hier mal eine Umsetzung

HINWEIS
System.UITypes wird für die Umwandlung von TRGBFloat in TColor benötigt und ist bei älteren Delphi-Versionen möglicherweise nicht vorhanden.

Delphi-Quellcode:

unit wavecolor;

interface

  uses
    System.UITypes;

  const
    C_LAMBDA_MIN = 380.0;
    C_LAMBDA_MAX = 780.0;
    C_GAMMA_DEF  = 0.8;

  type
    TRGBFloat = record
      R : Extended;
      G : Extended;
      B : Extended;
      function ToColorRec : TColorRec;
      function ToColor : TColor;
    end;

    // Umsetzung basiert auf
    // Dan Bruton - Approximate RGB values for Visible Wavelengths
    // http://www.physics.sfasu.edu/astro/color/spectra.html

  function WavelengthToRGB( Lambda : Extended; Gamma : Extended = C_GAMMA_DEF ) : TRGBFloat;

implementation

  uses
    SysUtils,
    Math;

  resourcestring
    C_LAMBDA_OUT_OF_RANGE_ERROR = 'Lambda must be between %f and %f';

  const
    C_LAMBDA_1  = 440.0;
    C_LAMBDA_2  = 490.0;
    C_LAMBDA_3  = 510.0;
    C_LAMBDA_4  = 580.0;
    C_LAMBDA_5  = 645.0;
    C_LAMBDA_F1 = 420.0;
    C_LAMBDA_F2 = 700.0;

  function WavelengthToRGB( Lambda : Extended; Gamma : Extended ) : TRGBFloat;
    var
      LR, LG, LB, LF : Extended;
    begin
      if not InRange( Lambda, C_LAMBDA_MIN, C_LAMBDA_MAX )
      then
        raise EArgumentOutOfRangeException.CreateFmt( C_LAMBDA_OUT_OF_RANGE_ERROR, [C_LAMBDA_MIN, C_LAMBDA_MAX] );

      // ( r', g', b' ) := ( (440-lambda)/(440-380), 0, 1 ) für lambda [380,440[
      // ( r', g', b' ) := ( 0, (lambda-440)/(490-440), 1 ) für lambda [440,490[
      // ( r', g', b' ) := ( 0, 1, (510-lambda)/(510-490) ) für lambda [490,510[
      // ( r', g', b' ) := ( (lambda-510)/(580-510), 1, 0 ) für lambda [510,580[
      // ( r', g', b' ) := ( 1, (645-lambda)/(645-580), 0 ) für lambda [580,645[
      // ( r', g', b' ) := ( 1, 0, 0 ) ____________________ für lambda [645,780]

      if Lambda < C_LAMBDA_1 // [380,440[
      then
        begin
          LR := ( C_LAMBDA_1 - Lambda ) / ( C_LAMBDA_1 - C_LAMBDA_MIN );
          LG := 0;
          LB := 1;
        end
      else if Lambda < C_LAMBDA_2 // [440,490[
      then
        begin
          LR := 0;
          LG := ( Lambda - C_LAMBDA_1 ) / ( C_LAMBDA_2 - C_LAMBDA_1 );
          LB := 1;
        end
      else if Lambda < C_LAMBDA_3 // [490,510[
      then
        begin
          LR := 0;
          LG := 1;
          LB := ( C_LAMBDA_3 - Lambda ) / ( C_LAMBDA_3 - C_LAMBDA_2 );
        end
      else if Lambda < C_LAMBDA_4 // [510,580[
      then
        begin
          LR := ( Lambda - C_LAMBDA_3 ) / ( C_LAMBDA_4 - C_LAMBDA_3 );
          LG := 1;
          LB := 0;
        end
      else if Lambda < C_LAMBDA_5 // [580,645[
      then
        begin
          LR := 1;
          LG := ( C_LAMBDA_5 - Lambda ) / ( C_LAMBDA_5 - C_LAMBDA_4 );
          LB := 0;
        end
      else
        begin // [645,780]
          LR := 1;
          LG := 0;
          LB := 0;
        end;

      // f := 0.3 + 0.7 * (lambda - 380)/(420 - 380) für lambda in [380,420[
      // f := 1 ____________________________________ für lambda in [420,700]
      // f := 0.3 + 0.7 * (780 - lambda)/(780 - 700) für lambda in ]700,780]

      if Lambda < C_LAMBDA_F1 // [380,420[
      then
        begin
          LF := 0.3 + 0.7 * ( Lambda - C_LAMBDA_MIN ) / ( C_LAMBDA_F1 - C_LAMBDA_MIN );
        end
      else if Lambda > C_LAMBDA_F2 // ]700,780]
      then
        begin
          LF := 0.3 + 0.7 * ( C_LAMBDA_MAX - Lambda ) / ( C_LAMBDA_MAX - C_LAMBDA_F2 );
        end
      else // [420,700]
        begin
          LF := 1;
        end;

      // ( r, g, b ) := ( (f * r')^g , (f * g')^g , (f * b')^g )

      Result.R := Power( LF * LR, Gamma );
      Result.G := Power( LF * LG, Gamma );
      Result.B := Power( LF * LB, Gamma );

    end;

  { TRGBFloat }

  function TRGBFloat.ToColor : TColor;
    begin
      Result := ToColorRec.Color;
    end;

  function TRGBFloat.ToColorRec : TColorRec;
    begin
      Result.A := $0;
      Result.R := Round( Self.R * $FF );
      Result.G := Round( Self.G * $FF );
      Result.B := Round( Self.B * $FF );
    end;

end.