// Ohjelmapätkää voisi nopeuttaa entisestään käyttämällä kokonaislukuja liukulukujen sijaan
// vaikka tietokoneet ovatkin nykyisin aika tehokkaita


procedure SplitToRGB(Color: TColor; var R, G, B: Byte);
begin
  R := (Color and 255);
  G := (Color shr 8) and 255;
  B := (Color shr 16) and 255;
end;

function CombineRGB(r, g, b: Byte): TColor;
begin
  Result := (b shl 16) + (g shl 8) + r;
end;

procedure Gradient4(var Bmp: TBitmap; clTopLeft, clTopRight, clBottomLeft, clBottomRight: TColor);
const
  PixelCountMax = 32768;

type
  pRGBTripleArray = ^TRGBTripleArray;
  TRGBTripleArray = array[0..PixelCountMax-1] of TRGBTriple;

  TRGB = record
           R, G, B: Byte;
         end;

var
  Row:  pRGBTripleArray;
  Width, Height, i, j: Integer;

  Start_R, Start_G, Start_B,
  Stop_R, Stop_G,Stop_B: Byte;
  rgbTopLeft, rgbTopRight, rgbBottomLeft, rgbBottomRight: TRGB;

  IncLeft_R, IncLeft_G, IncLeft_B,
  IncRight_R, IncRight_G, IncRight_B: Real;

  Left_R, Left_G, Left_B,
  Right_R, Right_G, Right_B: Real;

  DiffLeft_R, DiffLeft_G, DiffLeft_B,
  DiffRight_R, DiffRight_G, DiffRight_B: Integer;

  Diff_R, Diff_G, Diff_B: Integer;

  Inc_R, Inc_G, Inc_B: Real;
  R, G, B: Real;

begin

  Width := Bmp.Width;         // Bittikartan leveys
  Height := Bmp.Height;       // Bittikartan korkeus
  Bmp.PixelFormat := pf24bit; // Laitetaan bittikartta 24-bittiseksi, muuten ei toimi

  // Erotellaan parameterinä annetut värit RGB-väreihin
  with rgbTopLeft do SplitToRGB(clTopLeft, r, g, b);
  with rgbTopRight do SplitToRGB(clTopRight, r, g, b);
  with rgbBottomLeft do SplitToRGB(clBottomLeft, r, g, b);
  with rgbBottomRight do SplitToRGB(clBottomRight, r, g, b);

  // Lasketaan "ala"- ja "ylä"-arvojen erot jokaiselle värikomponentille vasemmalle värille
  DiffLeft_R := rgbBottomLeft.R - rgbTopLeft.R;
  DiffLeft_G := rgbBottomLeft.G - rgbTopLeft.G;
  DiffLeft_B := rgbBottomLeft.B - rgbTopLeft.B;

  // Lasketaan "ala"- ja "ylä"-arvojen erot jokaiselle värikomponentille oikealle värille
  DiffRight_R := rgbBottomRight.R - rgbTopRight.R;
  DiffRight_G := rgbBottomRight.G - rgbTopRight.G;
  DiffRight_B := rgbBottomRight.B - rgbTopRight.B;

  // Lasketaan "stepsize" vasemmalle värille
  // Nämä arvot voivat olla negatiivisia
  IncLeft_R := DiffLeft_R / Height;
  IncLeft_G := DiffLeft_G / Height;
  IncLeft_B := DiffLeft_B / Height;

  // Lasketaan "stepsize" oikealle värille
  // Nämä arvot voivat olla negatiivisia
  IncRight_R := DiffRight_R / Height;
  IncRight_G := DiffRight_G / Height;
  IncRight_B := DiffRight_B / Height;

  // Aloitusvärikomponentit vasemmalle värille
  Left_R := RGBTopLeft.R;
  Left_G := RGBTopLeft.G;
  Left_B := RGBTopLeft.B;

  // Aloitusvärikomponentit oikealle värille
  Right_R := RGBTopRight.R;
  Right_G := RGBTopRight.G;
  Right_B := RGBTopRight.B;

   for j := 1 to Height do // Height on bittikartan korkeus pikseleissä
    begin

      // Erotellaan vasen väri RGB-värikomponentteihin
      SplitToRGB(CombineRGB(Trunc(Left_R), Trunc(Left_G), Trunc(Left_B)), Start_R, Start_G, Start_B);

      // Erotellaan oikea väri RGB-värikomponentteihin
      SplitToRGB(CombineRGB(Trunc(Right_R), Trunc(Right_G), Trunc(Right_B)), Stop_R, Stop_G, Stop_B);

      // Lasketaan erot loppu- ja alkuvärien kesken
      Diff_R := Stop_R - Start_R;
      Diff_G := Stop_G - Start_G;
      Diff_B := Stop_B - Start_B;

      // Lasketaan loppu- ja alkuvärien "stepsize" jokaiselle värikomponentille.
      // Width-muuttuja on bittikartan leveys pikseleissä
      Inc_R := Diff_R / Width;
      Inc_G := Diff_G / Width;
      Inc_B := Diff_B / Width;

      // Annetaan aloitusarvot muuttujille R, G, B
      // Näitä muuttujia käytetään kun lasketaan horisontaaliset värit
      R := Start_R;
      G := Start_G;
      B := Start_B;

      // Valitaan rivi bitmapista
      Row := Bmp.Scanline[j - 1];

      for i := 1 to Width do
        begin

          with Row[i - 1] do // Annetaan väri i - 1 pisteelly bittikartassa
            begin
              // Pyöristetään arvot tässä
              rgbtRed   := Round(R);
              rgbtGreen := Round(G);
              rgbtBlue  := Round(B);
            end;

          // Lisätään askelta
          R := R + Inc_R;
          G := G + Inc_G;
          B := B + Inc_B;
        end;

      // Vasemman värin komponentit
      // Arvo pienenee tai suurenee riippuen ovatko arvot negatiivisia vai positiivisia
      // IncLeft_.. arvot määriteltiin ennen for-silmukoita
      Left_R := Left_R + IncLeft_R;
      Left_G := Left_G + IncLeft_G;
      Left_B := Left_B + IncLeft_B;

      // Oikean värin komponentit
      // Tässä vastaava juttu kuin vasemmassa värissä
      Right_R := Right_R + IncRight_R;
      Right_G := Right_G + IncRight_G;
      Right_B := Right_B + IncRight_B;

    end;
end;

(*
.......
.......
.......
.......

Näitä voi käyttää testaamiseen...


procedure TForm1.FormPaint(Sender: TObject);
var
  Bmp: TBitmap;
begin
  Bmp := TBitmap.Create;
  Bmp.Width := Form1.Width;
  Bmp.Height := Form1.Height;
  Gradient4(Bmp, clRed, clPurple, clLime, clYellow);
  Form1.Canvas.Draw(0, 0, Bmp);
  Bmp.Free;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  Form1.Repaint;
end;

*)