Draw a polygon with Gouraud shading?

Нарисовать полигон с затенением по методу Гуро.
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;
Source: http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 04117
Category:Алгоритмы
Category:Графика