unit Unit28;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils,Graphics,LCLType,UnitScaleFont;


  type arraycouleurs=array of tcolor;

procedure Degrade(couleurdepart,couleurarrivee:tcolor; nombrecouleurs:integer;
var tableaucouleurs:arraycouleurs);

implementation
FUNCTION RGB(CONST r,g,b:  BYTE):  TColor;
  BEGIN
    RESULT := (r OR (g SHL 8) OR (b SHL 16))
  END {RGB};

  function GetRValue(Color: TColor): Byte;
begin
  Result := Byte(Color);
end;

function GetGValue(Color: TColor): Byte;
begin
  Result := Byte(Color shr 8);
end;

function GetBValue(Color: TColor): Byte;
begin
  Result := Byte(Color shr 16);
end;

procedure Degrade(couleurdepart,couleurarrivee:tcolor; nombrecouleurs:integer;
var tableaucouleurs:arraycouleurs);
var
  couleurdepartRGB   : Array[0..2] Of Byte;
  couleuractuelleRGB : Array[0..2] Of Byte;
  incrementcouleurRGB   : Array[0..2] Of Integer;
  i:integer;
Begin
   if nombrecouleurs<=1 then exit;
  couleurdepartRGB[0] := GetRValue( ColorToRGB( couleurdepart ) );
  couleurdepartRGB[1] := GetGValue( ColorToRGB( couleurdepart ) );
  couleurdepartRGB[2] := GetBValue( ColorToRGB( couleurdepart ) );
  incrementcouleurRGB[0] := GetRValue( ColorToRGB( couleurarrivee )) - couleurdepartRGB[0];
  incrementcouleurRGB[1] := GetgValue( ColorToRGB( couleurarrivee )) - couleurdepartRGB[1];
  incrementcouleurRGB[2] := GetbValue( ColorToRGB( couleurarrivee )) - couleurdepartRGB[2];
   setlength(tableaucouleurs,nombrecouleurs);
      for i:=1 to nombrecouleurs do begin
      couleuractuelleRGB[0] := (couleurdepartRGB[0] + MulDiv( i-1 , incrementcouleurRGB[0] , nombrecouleurs-1 ));
      couleuractuelleRGB[1] := (couleurdepartRGB[1] + MulDiv( i-1 , incrementcouleurRGB[1] , nombrecouleurs-1  ));
      couleuractuelleRGB[2] := (couleurdepartRGB[2] + MulDiv( i-1 , incrementcouleurRGB[2] , nombrecouleurs-1  ));
      tableaucouleurs[i-1]:=RGB(couleuractuelleRGB[0],couleuractuelleRGB[1],couleuractuelleRGB[2]);
      end;
      end;
end.

