uses
 Graphics, Dialogs;
TRGBFloat = record
 R : single;
 G : single;
 B : single;
end;
TPointColor = record
 X : integer;
 Y : integer;
 RGB : TRGBFloat;
end;
TPointColorTriangle = array[0..2] of TPointColor;
{This procedure draws a triangular polygon using Gouraud shading.
 You specify the position and colour of the 3 corners and it will
 draw a filled triangle with the colours smoothed out over the
 surface of the polygon. This is used a lot in 3D graphics for
 improved rendering of curved surfaces. The procedure is very fast
 and can be used for realtime 3D animation.}
// fill a traingular polygon using Gouraud shading
procedure T3DModel.GouraudPoly(var ABitmap : TBitmap ; V : TPointColorTriangle);
Var
 LX, RX, Ldx, Rdx : Single;
 Dif1, Dif2 : Single;
 LRGB, RRGB, RGB, RGBdx, LRGBdy, RRGBdy : TRGBFloat;
 RGBT : RGBTriple;
 Scan : PRGBTripleArray;
 y, x, ScanStart, ScanEnd : integer;
 Vmax : byte;
 Right : boolean;
 Temp : TPointColor;
begin
 try
  // sort vertices by Y
  Vmax := 0;
  if V[1].Y > V[0].Y then Vmax := 1;
  if V[2].Y > V[Vmax].Y then Vmax := 2;
  if Vmax <> 2 then begin
  Temp := V[2];
  V[2] := V[Vmax];
  V[Vmax] := Temp;
  end;
  if V[1].Y > V[0].Y then Vmax := 1
  else Vmax := 0;
  if Vmax = 0 then begin
  Temp := V[1];
  V[1] := V[0];
  V[0] := Temp;
  end;
  Dif1 := V[2].Y - V[0].Y;
  if Dif1 = 0 then Dif1 := 0.001; // prevent EZeroDivide
  Dif2 := V[1].Y - V[0].Y;
  if Dif2 = 0 then Dif2 := 0.001;
  { work out if middle point is to the left or right of the line
  connecting upper and lower points }
  if V[1].X > (V[2].X - V[0].X) * Dif2 / Dif1 + V[0].X then Right := True
  else Right := False;
  // calculate increments in x and colour for stepping through the lines
  if Right then begin
  Ldx := (V[2].X - V[0].X) / Dif1;
  Rdx := (V[1].X - V[0].X) / Dif2;
  LRGBdy.B := (V[2].RGB.B - V[0].RGB.B) / Dif1;
  LRGBdy.G := (V[2].RGB.G - V[0].RGB.G) / Dif1;
  LRGBdy.R := (V[2].RGB.R - V[0].RGB.R) / Dif1;
  RRGBdy.B := (V[1].RGB.B - V[0].RGB.B) / Dif2;
  RRGBdy.G := (V[1].RGB.G - V[0].RGB.G) / Dif2;
  RRGBdy.R := (V[1].RGB.R - V[0].RGB.R) / Dif2;
  end else begin
  Ldx := (V[1].X - V[0].X) / Dif2;
  Rdx := (V[2].X - V[0].X) / Dif1;
  RRGBdy.B := (V[2].RGB.B - V[0].RGB.B) / Dif1;
  RRGBdy.G := (V[2].RGB.G - V[0].RGB.G) / Dif1;
  RRGBdy.R := (V[2].RGB.R - V[0].RGB.R) / Dif1;
  LRGBdy.B := (V[1].RGB.B - V[0].RGB.B) / Dif2;
  LRGBdy.G := (V[1].RGB.G - V[0].RGB.G) / Dif2;
  LRGBdy.R := (V[1].RGB.R - V[0].RGB.R) / Dif2;
  end;
  LRGB := V[0].RGB;
  RRGB := LRGB;
  LX := V[0].X;
  RX := V[0].X;
  // fill region 1
  for y := V[0].Y to V[1].Y - 1 do begin
  // y clipping
  if y > ABitmap.Height - 1 then Break;
  if y < 0 then begin
  LX := LX + Ldx;
  RX := RX + Rdx;
  LRGB.B := LRGB.B + LRGBdy.B;
  LRGB.G := LRGB.G + LRGBdy.G;
  LRGB.R := LRGB.R + LRGBdy.R;
  RRGB.B := RRGB.B + RRGBdy.B;
  RRGB.G := RRGB.G + RRGBdy.G;
  RRGB.R := RRGB.R + RRGBdy.R;
  Continue;
  end;
  Scan := ABitmap.ScanLine[y];
  // calculate increments in color for stepping through pixels
  Dif1 := RX - LX + 1;
  if Dif1 = 0 then Dif1 := 0.001;
  RGBdx.B := (RRGB.B - LRGB.B) / Dif1;
  RGBdx.G := (RRGB.G - LRGB.G) / Dif1;
  RGBdx.R := (RRGB.R - LRGB.R) / Dif1;
  // x clipping
  if LX < 0 then begin
  ScanStart := 0;
  RGB.B := LRGB.B + (RGBdx.B * abs(LX));
  RGB.G := LRGB.G + (RGBdx.G * abs(LX));
  RGB.R := LRGB.R + (RGBdx.R * abs(LX));
  end else begin
  RGB := LRGB;
  ScanStart := round(LX);
  end;
  if RX - 1 > ABitmap.Width - 1 then ScanEnd := ABitmap.Width - 1
  else ScanEnd := round(RX) - 1;
  // scan the line
  for x := ScanStart to ScanEnd do begin
  RGBT.rgbtBlue := trunc(RGB.B);
  RGBT.rgbtGreen := trunc(RGB.G);
  RGBT.rgbtRed := trunc(RGB.R);
  Scan[x] := RGBT;
  RGB.B := RGB.B + RGBdx.B;
  RGB.G := RGB.G + RGBdx.G;
  RGB.R := RGB.R + RGBdx.R;
  end;
  // increment edge x positions
  LX := LX + Ldx;
  RX := RX + Rdx;
  // increment edge colours by the y colour increments
  LRGB.B := LRGB.B + LRGBdy.B;
  LRGB.G := LRGB.G + LRGBdy.G;
  LRGB.R := LRGB.R + LRGBdy.R;
  RRGB.B := RRGB.B + RRGBdy.B;
  RRGB.G := RRGB.G + RRGBdy.G;
  RRGB.R := RRGB.R + RRGBdy.R;
  end;
  Dif1 := V[2].Y - V[1].Y;
  if Dif1 = 0 then Dif1 := 0.001;
  // calculate new increments for region 2
  if Right then begin
  Rdx := (V[2].X - V[1].X) / Dif1;
  RX := V[1].X;
  RRGBdy.B := (V[2].RGB.B - V[1].RGB.B) / Dif1;
  RRGBdy.G := (V[2].RGB.G - V[1].RGB.G) / Dif1;
  RRGBdy.R := (V[2].RGB.R - V[1].RGB.R) / Dif1;
  RRGB := V[1].RGB;
  end else begin
  Ldx := (V[2].X - V[1].X) / Dif1;
  LX := V[1].X;
  LRGBdy.B := (V[2].RGB.B - V[1].RGB.B) / Dif1;
  LRGBdy.G := (V[2].RGB.G - V[1].RGB.G) / Dif1;
  LRGBdy.R := (V[2].RGB.R - V[1].RGB.R) / Dif1;
  LRGB := V[1].RGB;
  end;
  // fill region 2
  for y := V[1].Y to V[2].Y - 1 do begin
  // y clipping
  if y > ABitmap.Height - 1 then Break;
  if y < 0 then begin
  LX := LX + Ldx;
  RX := RX + Rdx;
  LRGB.B := LRGB.B + LRGBdy.B;
  LRGB.G := LRGB.G + LRGBdy.G;
  LRGB.R := LRGB.R + LRGBdy.R;
  RRGB.B := RRGB.B + RRGBdy.B;
  RRGB.G := RRGB.G + RRGBdy.G;
  RRGB.R := RRGB.R + RRGBdy.R;
  Continue;
  end;
  Scan := ABitmap.ScanLine[y];
  Dif1 := RX - LX + 1;
  if Dif1 = 0 then Dif1 := 0.001;
  RGBdx.B := (RRGB.B - LRGB.B) / Dif1;
  RGBdx.G := (RRGB.G - LRGB.G) / Dif1;
  RGBdx.R := (RRGB.R - LRGB.R) / Dif1;
  // x clipping
  if LX < 0 then begin
  ScanStart := 0;
  RGB.B := LRGB.B + (RGBdx.B * abs(LX));
  RGB.G := LRGB.G + (RGBdx.G * abs(LX));
  RGB.R := LRGB.R + (RGBdx.R * abs(LX));
  end else begin
  RGB := LRGB;
  ScanStart := round(LX);
  end;
  if RX - 1 > ABitmap.Width - 1 then ScanEnd := ABitmap.Width - 1
  else ScanEnd := round(RX) - 1;
  // scan the line
  for x := ScanStart to ScanEnd do begin
  RGBT.rgbtBlue := trunc(RGB.B);
  RGBT.rgbtGreen := trunc(RGB.G);
  RGBT.rgbtRed := trunc(RGB.R);
  Scan[x] := RGBT;
  RGB.B := RGB.B + RGBdx.B;
  RGB.G := RGB.G + RGBdx.G;
  RGB.R := RGB.R + RGBdx.R;
  end;
  LX := LX + Ldx;
  RX := RX + Rdx;
  LRGB.B := LRGB.B + LRGBdy.B;
  LRGB.G := LRGB.G + LRGBdy.G;
  LRGB.R := LRGB.R + LRGBdy.R;
  RRGB.B := RRGB.B + RRGBdy.B;
  RRGB.G := RRGB.G + RRGBdy.G;
  RRGB.R := RRGB.R + RRGBdy.R;
  end;
 except
  ShowMessage('Exception in GouraudPoly Method');
 end;
end;