home *** CD-ROM | disk | FTP | other *** search
/ Chip 2005 November / CDVD1105.ISO / Software / Freeware / programare / graphics32 / GR32_Polygons.pas < prev    next >
Pascal/Delphi Source File  |  2005-02-24  |  62KB  |  2,037 lines
  1. unit GR32_Polygons;
  2.  
  3. (* ***** BEGIN LICENSE BLOCK *****
  4.  * Version: MPL 1.1
  5.  *
  6.  * The contents of this file are subject to the Mozilla Public License Version
  7.  * 1.1 (the "License"); you may not use this file except in compliance with
  8.  * the License. You may obtain a copy of the License at
  9.  * http://www.mozilla.org/MPL/
  10.  *
  11.  * Software distributed under the License is distributed on an "AS IS" basis,
  12.  * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
  13.  * for the specific language governing rights and limitations under the
  14.  * License.
  15.  *
  16.  * The Original Code is Graphics32
  17.  *
  18.  * The Initial Developer of the Original Code is
  19.  * Alex A. Denisov
  20.  *
  21.  * Portions created by the Initial Developer are Copyright (C) 2000-2004
  22.  * the Initial Developer. All Rights Reserved.
  23.  *
  24.  * Contributor(s):
  25.  *   Andre Beckedorf <Andre@metaException.de>
  26.  *   Mattias Andersson <mattias@centaurix.com>
  27.  *   Peter Larson <peter@larson.net>
  28.  *
  29.  * ***** END LICENSE BLOCK ***** *)
  30.  
  31. interface
  32.  
  33. {$I GR32.inc}
  34.  
  35. uses
  36. {$IFDEF CLX}
  37.   Qt, Types,
  38.   {$IFDEF LINUX}Libc, {$ENDIF}
  39.   {$IFDEF MSWINDOWS}Windows, {$ENDIF}
  40. {$ELSE}
  41.   Windows,
  42. {$ENDIF}
  43.   Classes, SysUtils, GR32, GR32_LowLevel, GR32_Blend, GR32_Transforms;
  44.  
  45. { Polylines }
  46.  
  47. procedure PolylineTS(Bitmap: TBitmap32; const Points: TArrayOfFixedPoint;
  48.   Color: TColor32; Closed: Boolean = False; Transformation: TTransformation = nil);
  49. procedure PolylineAS(Bitmap: TBitmap32; const Points: TArrayOfFixedPoint;
  50.   Color: TColor32; Closed: Boolean = False; Transformation: TTransformation = nil);
  51. procedure PolylineXS(Bitmap: TBitmap32; const Points: TArrayOfFixedPoint;
  52.   Color: TColor32; Closed: Boolean = False; Transformation: TTransformation = nil);
  53. procedure PolylineXSP(Bitmap: TBitmap32; const Points: TArrayOfFixedPoint;
  54.   Closed: Boolean = False; Transformation: TTransformation = nil);
  55.  
  56. procedure PolyPolylineTS(Bitmap: TBitmap32; const Points: TArrayOfArrayOfFixedPoint;
  57.   Color: TColor32; Closed: Boolean = False; Transformation: TTransformation = nil);
  58. procedure PolyPolylineAS(Bitmap: TBitmap32; const Points: TArrayOfArrayOfFixedPoint;
  59.   Color: TColor32; Closed: Boolean = False; Transformation: TTransformation = nil);
  60. procedure PolyPolylineXS(Bitmap: TBitmap32; const Points: TArrayOfArrayOfFixedPoint;
  61.   Color: TColor32; Closed: Boolean = False; Transformation: TTransformation = nil);
  62. procedure PolyPolylineXSP(Bitmap: TBitmap32; const Points: TArrayOfArrayOfFixedPoint;
  63.   Closed: Boolean = False; Transformation: TTransformation = nil);
  64.  
  65. { Polygons }
  66.  
  67. type
  68.   TPolyFillMode = (pfAlternate, pfWinding);
  69.   TShiftFunc = function(Value: Integer): Integer;  // needed for antialiasing to speed things up
  70.   TAntialiasMode = (am16times, am8times, am4times);
  71.  
  72.   TFillLineEvent = procedure(Dst: PColor32; DstX, DstY, Length: Integer; AlphaValues: PColor32) of object;
  73.  
  74.   TCustomPolygonFiller = class
  75.   protected
  76.     function GetFillLine: TFillLineEvent; virtual; abstract;
  77.   public
  78.     property FillLine: TFillLineEvent read GetFillLine;
  79.   end;
  80.  
  81. const
  82.   DefaultAAMode = am8times; // Use 54 levels of transparency for antialiasing.
  83.  
  84. procedure PolygonTS(Bitmap: TBitmap32; const Points: TArrayOfFixedPoint;
  85.   Color: TColor32; Mode: TPolyFillMode = pfAlternate; Transformation: TTransformation = nil); overload;
  86. procedure PolygonTS(Bitmap: TBitmap32; const Points: TArrayOfFixedPoint;
  87.   FillLineCallback: TFillLineEvent; Mode: TPolyFillMode = pfAlternate; Transformation: TTransformation = nil); overload;
  88. procedure PolygonTS(Bitmap: TBitmap32; const Points: TArrayOfFixedPoint;
  89.   Filler: TCustomPolygonFiller; Mode: TPolyFillMode = pfAlternate; Transformation: TTransformation = nil); overload;
  90.  
  91. procedure PolygonXS(Bitmap: TBitmap32; const Points: TArrayOfFixedPoint;
  92.   Color: TColor32; Mode: TPolyFillMode = pfAlternate;
  93.   const AAMode: TAntialiasMode = DefaultAAMode; Transformation: TTransformation = nil); overload;
  94. procedure PolygonXS(Bitmap: TBitmap32; const Points: TArrayOfFixedPoint;
  95.   FillLineCallback: TFillLineEvent; Mode: TPolyFillMode = pfAlternate;
  96.   const AAMode: TAntialiasMode = DefaultAAMode; Transformation: TTransformation = nil); overload;
  97. procedure PolygonXS(Bitmap: TBitmap32; const Points: TArrayOfFixedPoint;
  98.   Filler: TCustomPolygonFiller; Mode: TPolyFillMode = pfAlternate;
  99.   const AAMode: TAntialiasMode = DefaultAAMode; Transformation: TTransformation = nil); overload;
  100.  
  101. procedure PolyPolygonTS(Bitmap: TBitmap32; const Points: TArrayOfArrayOfFixedPoint;
  102.   Color: TColor32; Mode: TPolyFillMode = pfAlternate; Transformation: TTransformation = nil); overload;
  103. procedure PolyPolygonTS(Bitmap: TBitmap32; const Points: TArrayOfArrayOfFixedPoint;
  104.   FillLineCallback: TFillLineEvent; Mode: TPolyFillMode = pfAlternate; Transformation: TTransformation = nil); overload;
  105. procedure PolyPolygonTS(Bitmap: TBitmap32; const Points: TArrayOfArrayOfFixedPoint;
  106.   Filler: TCustomPolygonFiller; Mode: TPolyFillMode = pfAlternate; Transformation: TTransformation = nil); overload;
  107.  
  108. procedure PolyPolygonXS(Bitmap: TBitmap32; const Points: TArrayOfArrayOfFixedPoint;
  109.   Color: TColor32; Mode: TPolyFillMode = pfAlternate;
  110.   const AAMode: TAntialiasMode = DefaultAAMode; Transformation: TTransformation = nil); overload;
  111. procedure PolyPolygonXS(Bitmap: TBitmap32; const Points: TArrayOfArrayOfFixedPoint;
  112.   FillLineCallback: TFillLineEvent; Mode: TPolyFillMode = pfAlternate;
  113.   const AAMode: TAntialiasMode = DefaultAAMode; Transformation: TTransformation = nil); overload;
  114. procedure PolyPolygonXS(Bitmap: TBitmap32; const Points: TArrayOfArrayOfFixedPoint;
  115.   Filler: TCustomPolygonFiller; Mode: TPolyFillMode = pfAlternate;
  116.   const AAMode: TAntialiasMode = DefaultAAMode; Transformation: TTransformation = nil); overload;
  117.  
  118. function PtInPolygon(const Pt: TFixedPoint; const Points: TArrayOfFixedPoint): Boolean;
  119.  
  120. { TPolygon32 }
  121. { TODO : Bezier Curves, and QSpline curves for TrueType font rendering }
  122. { TODO : Check if QSpline is compatible with Type1 fonts }
  123. type
  124.   TPolygon32 = class(TThreadPersistent)
  125.   private
  126.     FAntialiased: Boolean;
  127.     FClosed: Boolean;
  128.     FFillMode: TPolyFillMode;
  129.     FNormals: TArrayOfArrayOfFixedPoint;
  130.     FPoints: TArrayOfArrayOfFixedPoint;
  131.     FAntialiasMode: TAntialiasMode;
  132.   protected
  133.     procedure BuildNormals;
  134.     procedure AssignProperties(Dest: TPolygon32); virtual;
  135.     procedure AssignTo(Dest: TPersistent); override;
  136.   public
  137.     constructor Create; override;
  138.     destructor Destroy; override;
  139.     procedure Add(const P: TFixedPoint);
  140.     procedure AddPoints(var First: TFixedPoint; Count: Integer);
  141.     function  ContainsPoint(const P: TFixedPoint): Boolean;
  142.     procedure Clear;
  143.     function  Grow(const Delta: TFixed; EdgeSharpness: Single = 0): TPolygon32;
  144.  
  145.     procedure Draw(Bitmap: TBitmap32; OutlineColor, FillColor: TColor32; Transformation: TTransformation = nil); overload;
  146.     procedure Draw(Bitmap: TBitmap32; OutlineColor: TColor32; FillCallback: TFillLineEvent; Transformation: TTransformation = nil); overload;
  147.     procedure Draw(Bitmap: TBitmap32; OutlineColor: TColor32; Filler: TCustomPolygonFiller; Transformation: TTransformation = nil); overload;
  148.  
  149.     procedure DrawEdge(Bitmap: TBitmap32; Color: TColor32; Transformation: TTransformation = nil);
  150.  
  151.     procedure DrawFill(Bitmap: TBitmap32; Color: TColor32; Transformation: TTransformation = nil); overload;
  152.     procedure DrawFill(Bitmap: TBitmap32; FillCallback: TFillLineEvent; Transformation: TTransformation = nil); overload;
  153.     procedure DrawFill(Bitmap: TBitmap32; Filler: TCustomPolygonFiller; Transformation: TTransformation = nil); overload;
  154.  
  155.     procedure NewLine;
  156.     procedure Offset(const Dx, Dy: TFixed);
  157.     function  Outline: TPolygon32;
  158.     procedure Transform(Transformation: TTransformation);
  159.     function GetBoundingRect: TFixedRect;
  160.  
  161.     property Antialiased: Boolean read FAntialiased write FAntialiased;
  162.     property AntialiasMode: TAntialiasMode read FAntialiasMode write FAntialiasMode;
  163.     property Closed: Boolean read FClosed write FClosed;
  164.     property FillMode: TPolyFillMode read FFillMode write FFillMode;
  165.  
  166.     property Normals: TArrayOfArrayOfFixedPoint read FNormals write FNormals;
  167.     property Points: TArrayOfArrayOfFixedPoint read FPoints write FPoints;
  168.   end;
  169.  
  170.   TBitmapPolygonFiller = class(TCustomPolygonFiller)
  171.   private
  172.     FPattern: TBitmap32;
  173.     FOffsetY: Integer;
  174.     FOffsetX: Integer;
  175.   protected
  176.     function GetFillLine: TFillLineEvent; override;
  177.     procedure FillLineOpaque(Dst: PColor32; DstX, DstY, Length: Integer; AlphaValues: PColor32);
  178.     procedure FillLineBlend(Dst: PColor32; DstX, DstY, Length: Integer; AlphaValues: PColor32);
  179.     procedure FillLineBlendMasterAlpha(Dst: PColor32; DstX, DstY, Length: Integer; AlphaValues: PColor32);
  180.     procedure FillLineCustomCombine(Dst: PColor32; DstX, DstY, Length: Integer; AlphaValues: PColor32);
  181.   public
  182.     property Pattern: TBitmap32 read FPattern write FPattern;
  183.     property OffsetX: Integer read FOffsetX write FOffsetX;
  184.     property OffsetY: Integer read FOffsetY write FOffsetY;
  185.   end;
  186.  
  187.  
  188. implementation
  189.  
  190. uses Math;
  191.  
  192. const
  193.   AA_LINES: Array[TAntialiasMode] of Integer = (16, 8, 4);
  194.   AA_SHIFT: Array[TAntialiasMode] of Integer = (4, 3, 2);
  195.   AA_MULTI: Array[TAntialiasMode] of Integer = (273, 1167, 5460);
  196.   AA_SAR:   Array[TAntialiasMode] of TShiftFunc = (SAR_12, SAR_13, SAR_14);
  197.  
  198. type
  199.   TBitmap32Access = class(TBitmap32);
  200. // These are for edge scan info. Note, that the most significant bit of the
  201. // edge in a scan line is used for winding (edge direction) info.
  202.   TScanLine = TArrayOfInteger;
  203.   TScanLines = TArrayOfArrayOfInteger;
  204.   PIntegerArray = ^TIntegerArray;
  205.   TIntegerArray = array [0..0] of Integer;
  206.   PFixedPointArray = ^TFixedPointArray;
  207.   TFixedPointArray = array [0..0] of TFixedPoint;
  208.  
  209. { POLYLINES }
  210.  
  211. procedure PolylineTS(
  212.   Bitmap: TBitmap32;
  213.   const Points: TArrayOfFixedPoint;
  214.   Color: TColor32;
  215.   Closed: Boolean;
  216.   Transformation: TTransformation);
  217. var
  218.   I, Count: Integer;
  219.   DoAlpha: Boolean;
  220. begin
  221.   Count := Length(Points);
  222.  
  223.   if (Count = 1) and Closed then
  224.     if Assigned(Transformation) then
  225.       with Transformation.Transform(Points[0]) do
  226.         Bitmap.SetPixelTS(FixedRound(X), FixedRound(Y), Color)
  227.     else
  228.       with Points[0] do
  229.         Bitmap.SetPixelTS(FixedRound(X), FixedRound(Y), Color);
  230.  
  231.   if Count < 2 then Exit;
  232.   DoAlpha := Color and $FF000000 <> $FF000000;
  233.   Bitmap.BeginUpdate;
  234.   Bitmap.PenColor := Color;
  235.  
  236.   If Assigned(Transformation) then
  237.   begin
  238.     with Transformation.Transform(Points[0]) do Bitmap.MoveTo(FixedRound(X), FixedRound(Y));
  239.     if DoAlpha then
  240.       for I := 1 to Count - 1 do
  241.         with Transformation.Transform(Points[I]) do
  242.           Bitmap.LineToTS(FixedRound(X), FixedRound(Y))
  243.     else
  244.       for I := 1 to Count - 1 do
  245.         with Transformation.Transform(Points[I]) do
  246.           Bitmap.LineToS(FixedRound(X), FixedRound(Y));
  247.  
  248.     if Closed then with Transformation.Transform(Points[0]) do
  249.       if DoAlpha then
  250.         Bitmap.LineToTS(FixedRound(X), FixedRound(Y))
  251.       else
  252.         Bitmap.LineToS(FixedRound(X), FixedRound(Y));
  253.   end
  254.   else
  255.   begin
  256.     with Points[0] do Bitmap.MoveTo(FixedRound(X), FixedRound(Y));
  257.     if DoAlpha then
  258.       for I := 1 to Count - 1 do
  259.         with Points[I] do
  260.           Bitmap.LineToTS(FixedRound(X), FixedRound(Y))
  261.     else
  262.       for I := 1 to Count - 1 do
  263.         with Points[I] do
  264.           Bitmap.LineToS(FixedRound(X), FixedRound(Y));
  265.  
  266.     if Closed then with Points[0] do
  267.       if DoAlpha then
  268.         Bitmap.LineToTS(FixedRound(X), FixedRound(Y))
  269.       else
  270.         Bitmap.LineToS(FixedRound(X), FixedRound(Y));
  271.   end;
  272.  
  273.   Bitmap.EndUpdate;
  274.   Bitmap.Changed;
  275. end;
  276.  
  277. procedure PolylineAS(
  278.   Bitmap: TBitmap32;
  279.   const Points: TArrayOfFixedPoint;
  280.   Color: TColor32;
  281.   Closed: Boolean;
  282.   Transformation: TTransformation);
  283. var
  284.   I, Count: Integer;
  285. begin
  286.   Count := Length(Points);
  287.   if (Count = 1) and Closed then
  288.     if Assigned(Transformation) then
  289.       with Transformation.Transform(Points[0]) do
  290.         Bitmap.SetPixelTS(FixedRound(X), FixedRound(Y), Color)
  291.     else
  292.       with Points[0] do
  293.         Bitmap.SetPixelTS(FixedRound(X), FixedRound(Y), Color);
  294.  
  295.   if Count < 2 then Exit;
  296.   Bitmap.BeginUpdate;
  297.   Bitmap.PenColor := Color;
  298.  
  299.   If Assigned(Transformation) then
  300.   begin
  301.     with Transformation.Transform(Points[0]) do Bitmap.MoveTo(FixedRound(X), FixedRound(Y));
  302.     for I := 1 to Count - 1 do
  303.       with Transformation.Transform(Points[I]) do
  304.         Bitmap.LineToAS(FixedRound(X), FixedRound(Y));
  305.     if Closed then with Transformation.Transform(Points[0]) do Bitmap.LineToAS(FixedRound(X), FixedRound(Y));
  306.   end
  307.   else
  308.   begin
  309.     with Points[0] do Bitmap.MoveTo(FixedRound(X), FixedRound(Y));
  310.     for I := 1 to Count - 1 do
  311.       with Points[I] do
  312.         Bitmap.LineToAS(FixedRound(X), FixedRound(Y));
  313.     if Closed then with Points[0] do Bitmap.LineToAS(FixedRound(X), FixedRound(Y));
  314.   end;
  315.  
  316.   Bitmap.EndUpdate;
  317.   Bitmap.Changed;
  318. end;
  319.  
  320. procedure PolylineXS(
  321.   Bitmap: TBitmap32;
  322.   const Points: TArrayOfFixedPoint;
  323.   Color: TColor32;
  324.   Closed: Boolean;
  325.   Transformation: TTransformation);
  326. var
  327.   I, Count: Integer;
  328. begin
  329.   Count := Length(Points);
  330.   if (Count = 1) and Closed then
  331.     if Assigned(Transformation) then
  332.       with Transformation.Transform(Points[0]) do Bitmap.PixelXS[X, Y] := Color
  333.     else
  334.       with Points[0] do Bitmap.PixelXS[X, Y] := Color;
  335.  
  336.   if Count < 2 then Exit;
  337.   Bitmap.BeginUpdate;
  338.   Bitmap.PenColor := Color;
  339.  
  340.   if Assigned(Transformation) then
  341.   begin
  342.     with Transformation.Transform(Points[0]) do Bitmap.MoveToX(X, Y);
  343.     for I := 1 to Count - 1 do with Transformation.Transform(Points[I]) do Bitmap.LineToXS(X, Y);
  344.     if Closed then with Transformation.Transform(Points[0]) do Bitmap.LineToXS(X, Y);
  345.   end
  346.   else
  347.   begin
  348.     with Points[0] do Bitmap.MoveToX(X, Y);
  349.     for I := 1 to Count - 1 do with Points[I] do Bitmap.LineToXS(X, Y);
  350.     if Closed then with Points[0] do Bitmap.LineToXS(X, Y);
  351.   end;
  352.  
  353.   Bitmap.EndUpdate;
  354.   Bitmap.Changed;
  355. end;
  356.  
  357. procedure PolylineXSP(
  358.   Bitmap: TBitmap32;
  359.   const Points: TArrayOfFixedPoint;
  360.   Closed: Boolean;
  361.   Transformation: TTransformation);
  362. var
  363.   I, Count: Integer;
  364. begin
  365.   Count := Length(Points);
  366.   if Count < 2 then Exit;
  367.   Bitmap.BeginUpdate;
  368.   if Assigned(Transformation) then
  369.   begin
  370.     with Transformation.Transform(Points[0]) do Bitmap.MoveToX(X, Y);
  371.     for I := 1 to Count - 1 do with Transformation.Transform(Points[I]) do Bitmap.LineToXSP(X, Y);
  372.     if Closed then with Transformation.Transform(Points[0]) do Bitmap.LineToXSP(X, Y);
  373.   end
  374.   else
  375.   begin
  376.     with Points[0] do Bitmap.MoveToX(X, Y);
  377.     for I := 1 to Count - 1 do with Points[I] do Bitmap.LineToXSP(X, Y);
  378.     if Closed then with Points[0] do Bitmap.LineToXSP(X, Y);
  379.   end;
  380.  
  381.   Bitmap.EndUpdate;
  382.   Bitmap.Changed;
  383. end;
  384.  
  385. procedure PolyPolylineTS(
  386.   Bitmap: TBitmap32;
  387.   const Points: TArrayOfArrayOfFixedPoint;
  388.   Color: TColor32;
  389.   Closed: Boolean;
  390.   Transformation: TTransformation);
  391. var
  392.   I: Integer;
  393. begin
  394.   for I := 0 to High(Points) do PolylineTS(Bitmap, Points[I], Color, Closed, Transformation);
  395. end;
  396.  
  397. procedure PolyPolylineAS(
  398.   Bitmap: TBitmap32;
  399.   const Points: TArrayOfArrayOfFixedPoint;
  400.   Color: TColor32;
  401.   Closed: Boolean;
  402.   Transformation: TTransformation);
  403. var
  404.   I: Integer;
  405. begin
  406.   for I := 0 to High(Points) do PolylineAS(Bitmap, Points[I], Color, Closed, Transformation);
  407. end;
  408.  
  409. procedure PolyPolylineXS(
  410.   Bitmap: TBitmap32;
  411.   const Points: TArrayOfArrayOfFixedPoint;
  412.   Color: TColor32;
  413.   Closed: Boolean;
  414.   Transformation: TTransformation);
  415. var
  416.   I: Integer;
  417. begin
  418.   for I := 0 to High(Points) do PolylineXS(Bitmap, Points[I], Color, Closed, Transformation);
  419. end;
  420.  
  421. procedure PolyPolylineXSP(
  422.   Bitmap: TBitmap32;
  423.   const Points: TArrayOfArrayOfFixedPoint;
  424.   Closed: Boolean;
  425.   Transformation: TTransformation);
  426. var
  427.   I: Integer;
  428. begin
  429.   for I := 0 to High(Points) do PolylineXSP(Bitmap, Points[I], Closed, Transformation);
  430. end;
  431.  
  432. procedure QSortLine(const ALine: TScanLine; L, R: Integer);
  433. var
  434.   I, J, P: Integer;
  435. begin
  436.   repeat
  437.     I := L;
  438.     J := R;
  439.     P := ALine[(L + R) shr 1] and $7FFFFFFF;
  440.     repeat
  441.       while (ALine[I] and $7FFFFFFF) < P do Inc(I);
  442.       while (ALine[J] and $7FFFFFFF) > P do Dec(J);
  443.       if I <= J then
  444.       begin
  445.         Swap(ALine[I], ALine[J]);
  446.         Inc(I);
  447.         Dec(J);
  448.       end;
  449.     until I > J;
  450.     if L < J then QSortLine(ALine, L, J);
  451.     L := I;
  452.   until I >= R;
  453. end;
  454.  
  455. { General routines for drawing polygons }
  456.  
  457. procedure SortLine(const ALine: TScanLine);
  458. var
  459.   L, Tmp: Integer;
  460. begin
  461.   L := Length(ALine);
  462.   Assert(not Odd(L));
  463.   if L = 2 then
  464.   begin
  465.     if (ALine[0] and $7FFFFFFF) > (ALine[1] and $7FFFFFFF) then
  466.     begin
  467.       Tmp := ALine[0];
  468.       ALine[0] := ALine[1];
  469.       ALine[1] := Tmp;
  470.     end;
  471.   end
  472.   else if L > 2 then QSortLine(ALine, 0, L - 1);
  473. end;
  474.  
  475. procedure SortLines(const ScanLines: TScanLines);
  476. var
  477.   I: Integer;
  478. begin
  479.   for I := 0 to High(ScanLines) do SortLine(ScanLines[I]);
  480. end;
  481.  
  482. procedure AddPolygon(const Points: TArrayOfPoint; const BaseX, BaseY: Integer;
  483.   const MaxX, MaxY: Integer; var ScanLines: TScanLines; SubSampleX: Boolean);
  484. var
  485.   I, X1, Y1, X2, Y2: Integer;
  486.   Direction, PrevDirection: Integer; // up = 1 or down = -1
  487.  
  488.   function Sign(I: Integer): Integer;
  489.   begin
  490.     if I > 0 then Result := 1
  491.     else if I < 0 then Result := -1
  492.     else Result := 0;
  493.   end;
  494.  
  495.   procedure AddEdgePoint(X, Y: Integer; Direction: Integer);
  496.   var
  497.     L: Integer;
  498.   begin
  499.     // positive direction (+1) is down
  500.     if (Y < BaseY) or (Y > MaxY) then Exit;
  501.     if X < BaseX then X := BaseX else if X > MaxX then X := MaxX;
  502.     L := Length(ScanLines[Y - BaseY]);
  503.     SetLength(ScanLines[Y - BaseY], L + 1);
  504.     if Direction < 0 then X := Integer(Longword(X) or $80000000); // set the highest bit if the winding is up
  505.     ScanLines[Y - BaseY][L] := X;
  506.   end;
  507.  
  508.   function DrawEdge(X1, Y1, X2, Y2: Integer): Integer;
  509.   var
  510.     X, Y, I, K: Integer;
  511.     Dx, Dy, Sx, Sy: Integer;
  512.     Delta: Integer;
  513.   begin
  514.     // this function 'renders' a line into the edge (ScanLines) buffer
  515.     // and returns the line direction (1 - down, -1 - up, 0 - horizontal)
  516.     Result := 0;
  517.     if Y2 = Y1 then Exit;
  518.     Dx := X2 - X1;
  519.     Dy := Y2 - Y1;
  520.     if Dy > 0 then Sy := 1 
  521.     else
  522.     begin
  523.       Sy := -1;
  524.       Dy := -Dy;
  525.     end;
  526.     Result := Sy;
  527.     if Dx > 0 then Sx := 1
  528.     else
  529.     begin
  530.       Sx := -1;
  531.       Dx := -Dx;
  532.     end;
  533.     Delta := (Dx mod Dy) shr 1;
  534.     X := X1; Y := Y1;
  535.     for I := 0 to Dy - 1 do
  536.     begin
  537.       AddEdgePoint(X, Y, Result);
  538.       Inc(Y, Sy);
  539.       Inc(Delta, Dx);
  540.  
  541.       // try it two times and if anything else left, use div and mod
  542.       if Delta > Dy then
  543.       begin
  544.         Inc(X, Sx);
  545.         Dec(Delta, Dy);
  546.  
  547.         if Delta > Dy then  // segment is tilted more than 45 degrees?
  548.         begin
  549.           Inc(X, Sx);
  550.           Dec(Delta, Dy);
  551.  
  552.           if Delta > Dy then // are we still here?
  553.           begin
  554.             K := (Delta + Dy - 1) div Dy;
  555.             Inc(X, Sx * K);
  556.             Dec(Delta, Dy * K);
  557.           end;
  558.         end;
  559.       end;
  560.     end;
  561.   end;
  562. begin
  563.   if Length(Points) < 3 then Exit;
  564.  
  565.   with Points[0] do
  566.   begin
  567.     X1 := X;
  568.     if SubSampleX then X1 := X1 shl 8;
  569.     Y1 := Y;
  570.   end;
  571.  
  572.   // find the last Y different from Y1 and assign it to Y0
  573.   PrevDirection := 0;
  574.   I := High(Points);
  575.   while I > 0 do
  576.   begin
  577.     PrevDirection := Sign(Y1 - Points[I].Y);
  578.     if PrevDirection <> 0 then Break;
  579.     Dec(I);
  580.   end;
  581.  
  582.   for I := 1 to High(Points) do
  583.   begin
  584.     with Points[I] do
  585.     begin
  586.       X2 := X;
  587.       Y2 := Y;
  588.       if SubSampleX then X2 := X2 shl 8;
  589.     end;
  590.     if Y1 <> Y2 then
  591.     begin
  592.       Direction := DrawEdge(X1, Y1, X2, Y2);
  593.       if Direction <> PrevDirection then
  594.       begin
  595.         AddEdgePoint(X1, Y1, -Direction);
  596.         PrevDirection := Direction;
  597.       end;
  598.     end;
  599.     X1 := X2; Y1 := Y2;
  600.   end;
  601.   with Points[0] do
  602.   begin
  603.     X2 := X;
  604.     Y2 := Y;
  605.     if SubSampleX then X2 := X2 shl 8;
  606.   end;
  607.   if Y1 <> Y2 then
  608.   begin
  609.     Direction := DrawEdge(X1, Y1, X2, Y2);
  610.     if Direction <> PrevDirection then AddEdgePoint(X1, Y1, -Direction);
  611.   end;
  612. end;
  613.  
  614. procedure ColorFillLines(Bitmap: TBitmap32; BaseY: Integer;
  615.   const ScanLines: TScanLines; Color: TColor32; Mode: TPolyFillMode);
  616. var
  617.   I, J, L: Integer;
  618.   Left, Right, OldRight, LP, RP: Integer;
  619.   Winding, NextWinding: Integer;
  620.   HorzLine: procedure(X1, Y, X2: Integer; Value: TColor32) of Object;
  621. begin
  622.   if Color and $FF000000 <> $FF000000 then
  623.     HorzLine := Bitmap.HorzLineT
  624.   else
  625.     HorzLine := Bitmap.HorzLine;
  626.  
  627.   if Mode = pfAlternate then
  628.     for J := 0 to High(ScanLines) do
  629.     begin
  630.       L := Length(ScanLines[J]); // assuming length is even
  631.       if L = 0 then Continue;
  632.       I := 0;
  633.       OldRight := -1;
  634.  
  635.       while I < L do
  636.       begin
  637.         Left := ScanLines[J][I] and $7FFFFFFF;
  638.         Inc(I);
  639.         Right := ScanLines[J][I] and $7FFFFFFF - 1;
  640.         if Right > Left then
  641.         begin
  642.           if (Left and $FF) < $80 then Left := Left shr 8
  643.           else Left := Left shr 8 + 1;
  644.           if (Right and $FF) < $80 then Right := Right shr 8
  645.           else Right := Right shr 8 + 1;
  646.  
  647.           if Right >= Bitmap.ClipRect.Right - 1 then Right := Bitmap.ClipRect.Right - 1;
  648.  
  649.           if Left <= OldRight then Left := OldRight + 1;
  650.           OldRight := Right;
  651.           if Right >= Left then HorzLine(Left, BaseY + J, Right, Color);
  652.         end;
  653.         Inc(I);
  654.       end
  655.     end
  656.   else // Mode = pfWinding
  657.     for J := 0 to High(ScanLines) do
  658.     begin
  659.       L := Length(ScanLines[J]); // assuming length is even
  660.       if L = 0 then Continue;
  661.       I := 0;
  662.  
  663.       Winding := 0;
  664.       Left := ScanLines[J][0];
  665.       if (Left and $80000000) <> 0 then Inc(Winding) else Dec(Winding);
  666.       Left := Left and $7FFFFFFF;
  667.       Inc(I);
  668.       while I < L do
  669.       begin
  670.         Right := ScanLines[J][I];
  671.         if (Right and $80000000) <> 0 then NextWinding := 1 else NextWinding := -1;
  672.         Right := Right and $7FFFFFFF;
  673.         Inc(I);
  674.  
  675.         if Winding <> 0 then
  676.         begin
  677.           if (Left and $FF) < $80 then LP := Left shr 8
  678.           else LP := Left shr 8 + 1;
  679.           if (Right and $FF) < $80 then RP := Right shr 8
  680.           else RP := Right shr 8 + 1;
  681.  
  682.           if RP >= Bitmap.ClipRect.Right - 1 then RP := Bitmap.ClipRect.Right - 1;
  683.  
  684.           if RP >= LP then HorzLine(LP, BaseY + J, RP, Color);
  685.         end;
  686.  
  687.         Inc(Winding, NextWinding);
  688.         Left := Right;
  689.       end;
  690.     end;
  691. end;
  692.  
  693. procedure ColorFillLines2(Bitmap: TBitmap32; BaseY: Integer;
  694.   const ScanLines: TScanLines; Color: TColor32; Mode: TPolyFillMode;
  695.   const AAMode: TAntialiasMode = DefaultAAMode);
  696. var
  697.   I, J, L, N: Integer;
  698.   MinY, MaxY, Y, Top, Bottom: Integer;
  699.   MinX, MaxX, X, Dx: Integer;
  700.   Left, Right: Integer;
  701.   Buffer: array of Integer;
  702.   ColorBuffer: array of TColor32;
  703.   BufferSize: Integer;
  704.   C, A: TColor32;
  705.   ScanLine: PIntegerArray;
  706.   Winding, NextWinding: Integer;
  707.   AAShift, AALines, AAMultiplier: Integer;
  708.   BlendLineEx: TBlendLineEx;
  709. begin
  710.   A := Color shr 24;
  711.  
  712.   AAShift := AA_SHIFT[AAMode];
  713.   AALines := AA_LINES[AAMode] - 1; // we do the -1 here for optimization.
  714.   AAMultiplier := AA_MULTI[AAMode];
  715.  
  716.   BlendLineEx := BLEND_LINE_EX[Bitmap.CombineMode];
  717.  
  718.   // find the range of Y screen coordinates
  719.   MinY := BaseY shr AAShift;
  720.   MaxY := (BaseY + Length(ScanLines) + AALines) shr AAShift;
  721.  
  722.   Y := MinY;
  723.   while Y < MaxY do
  724.   begin
  725.     Top := Y shl AAShift - BaseY;
  726.     Bottom := Top + AALines;
  727.     if Top < 0 then Top := 0;
  728.     if Bottom >= Length(ScanLines) then Bottom := High(ScanLines);
  729.  
  730.     // find left and right edges of the screen scanline
  731.     MinX := $7F000000; MaxX := -$7F000000;
  732.     for J := Top to Bottom do
  733.     begin
  734.       L := Length(ScanLines[J]) - 1;
  735.       if L > 0 then
  736.       begin
  737.         Left := (ScanLines[J][0] and $7FFFFFFF);
  738.         Right := (ScanLines[J][L] and $7FFFFFFF + AALines);
  739.         if Left < MinX then MinX := Left;
  740.         if Right > MaxX then MaxX := Right;
  741.       end
  742.     end;
  743.  
  744.     if MaxX >= MinX then
  745.     begin
  746.       MinX := MinX shr AAShift;
  747.       MaxX := MaxX shr AAShift;
  748.       // allocate buffer for a single scanline
  749.       BufferSize := MaxX - MinX + 2;
  750.       if Length(Buffer) < BufferSize then
  751.       begin
  752.         SetLength(Buffer, BufferSize + 64);
  753.         SetLength(ColorBuffer, BufferSize + 64);
  754.       end;
  755.       FillLongword(Buffer[0], BufferSize, 0);
  756.  
  757.       // ...and fill it
  758.       if Mode = pfAlternate then
  759.         for J := Top to Bottom do
  760.         begin
  761.           I := 0;
  762.           L := Length(ScanLines[J]);
  763.           ScanLine := @ScanLines[J][0];
  764.           while I < L do
  765.           begin
  766.             // Left edge
  767.             X := ScanLine[I] and $7FFFFFFF;
  768.             Dx := X and AALines;
  769.             X := X shr AAShift - MinX;
  770.             Inc(Buffer[X], Dx xor AALines);
  771.             Inc(Buffer[X + 1], Dx);
  772.             Inc(I);
  773.  
  774.             // Right edge
  775.             X := ScanLine[I] and $7FFFFFFF;
  776.             Dx := X and AALines;
  777.             X := X shr AAShift - MinX;
  778.             Dec(Buffer[X], Dx xor AALines);
  779.             Dec(Buffer[X + 1], Dx);
  780.             Inc(I);
  781.           end
  782.         end
  783.       else // mode = pfWinding
  784.         for J := Top to Bottom do
  785.         begin
  786.           I := 0;
  787.           L := Length(ScanLines[J]);
  788.           ScanLine := @ScanLines[J][0];
  789.           Winding := 0;
  790.           while I < L do
  791.           begin
  792.             X := ScanLine[I];
  793.             Inc(I);
  794.             if (X and $80000000) <> 0 then NextWinding := 1 else NextWinding := -1;
  795.             X := X and $7FFFFFFF;
  796.             if Winding = 0 then
  797.             begin
  798.               Dx := X and AALines;
  799.               X := X shr AAShift - MinX;
  800.               Inc(Buffer[X], Dx xor AALines);
  801.               Inc(Buffer[X + 1], Dx);
  802.             end;
  803.             Inc(Winding, NextWinding);
  804.             if Winding = 0 then
  805.             begin
  806.               Dx := X and AALines;
  807.               X := X shr AAShift - MinX;
  808.               Dec(Buffer[X], Dx xor AALines);
  809.               Dec(Buffer[X + 1], Dx);
  810.             end;
  811.           end;
  812.         end;
  813.  
  814.       // integrate the buffer
  815.       N := 0;
  816.       C := Color and $00FFFFFF;
  817.       for I := 0 to BufferSize - 1 do
  818.       begin
  819.         Inc(N, Buffer[I]);
  820.         ColorBuffer[I] := TColor32(N * AAMultiplier and $FF00) shl 16 or C;
  821.       end;
  822.  
  823.       // draw it to the screen
  824.       BlendLineEx(@ColorBuffer[0], Pointer(Bitmap.PixelPtr[MinX, Y]), BufferSize, A);
  825.       EMMS;
  826.     end;
  827.  
  828.     Inc(Y);
  829.   end;
  830. end;
  831.  
  832. procedure CustomFillLines(Bitmap: TBitmap32; BaseY: Integer;
  833.   const ScanLines: TScanLines; FillLineCallback: TFillLineEvent; Mode: TPolyFillMode);
  834. var
  835.   I, J, L: Integer;
  836.   Left, Right, OldRight, LP, RP, Top: Integer;
  837.   Winding, NextWinding: Integer;
  838. begin
  839.   if Mode = pfAlternate then
  840.     for J := 0 to High(ScanLines) do
  841.     begin
  842.       L := Length(ScanLines[J]); // assuming length is even
  843.       if L = 0 then Continue;
  844.       I := 0;
  845.       OldRight := -1;
  846.  
  847.       while I < L do
  848.       begin
  849.         Left := ScanLines[J][I] and $7FFFFFFF;
  850.         Inc(I);
  851.         Right := ScanLines[J][I] and $7FFFFFFF - 1;
  852.         if Right > Left then
  853.         begin
  854.           if (Left and $FF) < $80 then Left := Left shr 8
  855.           else Left := Left shr 8 + 1;
  856.           if (Right and $FF) < $80 then Right := Right shr 8
  857.           else Right := Right shr 8 + 1;
  858.  
  859.           if Right >= Bitmap.ClipRect.Right - 1 then Right := Bitmap.ClipRect.Right - 1;
  860.  
  861.           if Left <= OldRight then Left := OldRight + 1;
  862.           OldRight := Right;
  863.           if Right >= Left then
  864.           begin
  865.             Top := BaseY + J;
  866.             FillLineCallback(Bitmap.PixelPtr[Left, Top], Left, Top, Right - Left, nil);
  867.           end;
  868.         end;
  869.         Inc(I);
  870.       end
  871.     end
  872.   else // Mode = pfWinding
  873.     for J := 0 to High(ScanLines) do
  874.     begin
  875.       L := Length(ScanLines[J]); // assuming length is even
  876.       if L = 0 then Continue;
  877.       I := 0;
  878.  
  879.       Winding := 0;
  880.       Left := ScanLines[J][0];
  881.       if (Left and $80000000) <> 0 then Inc(Winding) else Dec(Winding);
  882.       Left := Left and $7FFFFFFF;
  883.       Inc(I);
  884.       while I < L do
  885.       begin
  886.         Right := ScanLines[J][I];
  887.         if (Right and $80000000) <> 0 then NextWinding := 1 else NextWinding := -1;
  888.         Right := Right and $7FFFFFFF;
  889.         Inc(I);
  890.  
  891.         if Winding <> 0 then
  892.         begin
  893.           if (Left and $FF) < $80 then LP := Left shr 8
  894.           else LP := Left shr 8 + 1;
  895.           if (Right and $FF) < $80 then RP := Right shr 8
  896.           else RP := Right shr 8 + 1;
  897.  
  898.           if RP >= Bitmap.ClipRect.Right - 1 then RP := Bitmap.ClipRect.Right - 1;
  899.  
  900.           if RP >= LP then
  901.           begin
  902.             Top := BaseY + J;
  903.             FillLineCallback(Bitmap.PixelPtr[LP, Top], LP, Top, RP - LP, nil);
  904.           end;
  905.         end;
  906.  
  907.         Inc(Winding, NextWinding);
  908.         Left := Right;
  909.       end;
  910.     end;
  911.   EMMS;
  912. end;
  913.  
  914. procedure CustomFillLines2(Bitmap: TBitmap32; BaseY: Integer;
  915.   const ScanLines: TScanLines; FillLineCallback: TFillLineEvent; Mode: TPolyFillMode;
  916.   const AAMode: TAntialiasMode = DefaultAAMode);
  917. var
  918.   I, J, L, N: Integer;
  919.   MinY, MaxY, Y, Top, Bottom: Integer;
  920.   MinX, MaxX, X, Dx: Integer;
  921.   Left, Right: Integer;
  922.   Buffer: array of Integer;
  923.   AlphaBuffer: array of TColor32;
  924.   BufferSize: Integer;
  925.   ScanLine: PIntegerArray;
  926.   Winding, NextWinding: Integer;
  927.   AAShift, AALines, AAMultiplier: Integer;
  928. begin
  929.   AAShift := AA_SHIFT[AAMode];
  930.   AALines := AA_LINES[AAMode] - 1; // we do the -1 here for optimization.
  931.   AAMultiplier := AA_MULTI[AAMode];
  932.  
  933.   // find the range of Y screen coordinates
  934.   MinY := BaseY shr AAShift;
  935.   MaxY := (BaseY + Length(ScanLines) + AALines) shr AAShift;
  936.  
  937.   Y := MinY;
  938.   while Y < MaxY do
  939.   begin
  940.     Top := Y shl AAShift - BaseY;
  941.     Bottom := Top + AALines;
  942.     if Top < 0 then Top := 0;
  943.     if Bottom >= Length(ScanLines) then Bottom := High(ScanLines);
  944.  
  945.     // find left and right edges of the screen scanline
  946.     MinX := $7F000000; MaxX := -$7F000000;
  947.     for J := Top to Bottom do
  948.     begin
  949.       L := Length(ScanLines[J]) - 1;
  950.       if L > 0 then
  951.       begin
  952.         Left := (ScanLines[J][0] and $7FFFFFFF);
  953.         Right := (ScanLines[J][L] and $7FFFFFFF + AALines);
  954.         if Left < MinX then MinX := Left;
  955.         if Right > MaxX then MaxX := Right;
  956.       end
  957.     end;
  958.  
  959.     if MaxX >= MinX then
  960.     begin
  961.       MinX := MinX shr AAShift;
  962.       MaxX := MaxX shr AAShift;
  963.       // allocate buffer for a single scanline
  964.       BufferSize := MaxX - MinX + 2;
  965.       if Length(Buffer) < BufferSize then
  966.       begin
  967.         SetLength(Buffer, BufferSize + 64);
  968.         SetLength(AlphaBuffer, BufferSize + 64);
  969.       end;
  970.       FillLongword(Buffer[0], BufferSize, 0);
  971.  
  972.       // ...and fill it
  973.       if Mode = pfAlternate then
  974.         for J := Top to Bottom do
  975.         begin
  976.           I := 0;
  977.           L := Length(ScanLines[J]);
  978.           ScanLine := @ScanLines[J][0];
  979.           while I < L do
  980.           begin
  981.             // Left edge
  982.             X := ScanLine[I] and $7FFFFFFF;
  983.             Dx := X and AALines;
  984.             X := X shr AAShift - MinX;
  985.             Inc(Buffer[X], Dx xor AALines);
  986.             Inc(Buffer[X + 1], Dx);
  987.             Inc(I);
  988.  
  989.             // Right edge
  990.             X := ScanLine[I] and $7FFFFFFF;
  991.             Dx := X and AALines;
  992.             X := X shr AAShift - MinX;
  993.             Dec(Buffer[X], Dx xor AALines);
  994.             Dec(Buffer[X + 1], Dx);
  995.             Inc(I);
  996.           end
  997.         end
  998.       else // mode = pfWinding
  999.         for J := Top to Bottom do
  1000.         begin
  1001.           I := 0;
  1002.           L := Length(ScanLines[J]);
  1003.           ScanLine := @ScanLines[J][0];
  1004.           Winding := 0;
  1005.           while I < L do
  1006.           begin
  1007.             X := ScanLine[I];
  1008.             Inc(I);
  1009.             if (X and $80000000) <> 0 then NextWinding := 1 else NextWinding := -1;
  1010.             X := X and $7FFFFFFF;
  1011.             if Winding = 0 then
  1012.             begin
  1013.               Dx := X and AALines;
  1014.               X := X shr AAShift - MinX;
  1015.               Inc(Buffer[X], Dx xor AALines);
  1016.               Inc(Buffer[X + 1], Dx);
  1017.             end;
  1018.             Inc(Winding, NextWinding);
  1019.             if Winding = 0 then
  1020.             begin
  1021.               Dx := X and AALines;
  1022.               X := X shr AAShift - MinX;
  1023.               Dec(Buffer[X], Dx xor AALines);
  1024.               Dec(Buffer[X + 1], Dx);
  1025.             end;
  1026.           end;
  1027.         end;
  1028.  
  1029.       // integrate the buffer
  1030.       N := 0;
  1031.       for I := 0 to BufferSize - 1 do
  1032.       begin
  1033.         Inc(N, Buffer[I]);
  1034.         AlphaBuffer[I] := (N * AAMultiplier) shr 8;
  1035.       end;
  1036.  
  1037.       // draw it to the screen
  1038.       FillLineCallback(Pointer(Bitmap.PixelPtr[MinX, Y]), MinX, Y, BufferSize, @AlphaBuffer[0]);
  1039.       EMMS;
  1040.     end;
  1041.  
  1042.     Inc(Y);
  1043.   end;
  1044. end;
  1045.  
  1046. { Polygons }
  1047.  
  1048. // only used internally to share code:
  1049. procedure RenderPolygonTS(Bitmap: TBitmap32; const Points: TArrayOfFixedPoint;
  1050.   Color: TColor32; FillLineCallback: TFillLineEvent; Mode: TPolyFillMode;
  1051.   Transformation: TTransformation);
  1052. var
  1053.   L, I, MinY, MaxY: Integer;
  1054.   ScanLines: TScanLines;
  1055.   PP: TArrayOfPoint;
  1056. begin
  1057.   L := Length(Points);
  1058.   if (L < 3) or not Assigned(FillLineCallback) and (Color and $FF000000 = 0) then Exit;
  1059.   SetLength(PP, L);
  1060.  
  1061.   MinY := $7F000000;
  1062.   MaxY := -$7F000000;
  1063.  
  1064.   If Assigned(Transformation) then
  1065.   begin
  1066.     for I := 0 to L - 1 do
  1067.       with Transformation.Transform(Points[I]) do
  1068.       begin
  1069.         PP[I].X := SAR_16(X + $00007FFF);
  1070.         PP[I].Y := SAR_16(Y + $00007FFF);
  1071.         if PP[I].Y < MinY then MinY := PP[I].Y;
  1072.         if PP[I].Y > MaxY then MaxY := PP[I].Y;
  1073.       end;
  1074.   end
  1075.   else
  1076.   begin
  1077.     for I := 0 to L - 1 do
  1078.       with Points[I] do
  1079.       begin
  1080.         PP[I].X := SAR_16(X + $00007FFF);
  1081.         PP[I].Y := SAR_16(Y + $00007FFF);
  1082.         if PP[I].Y < MinY then MinY := PP[I].Y;
  1083.         if PP[I].Y > MaxY then MaxY := PP[I].Y;
  1084.       end;
  1085.   end;
  1086.  
  1087.   MinY := Constrain(MinY, Bitmap.ClipRect.Top, Bitmap.ClipRect.Bottom);
  1088.   MaxY := Constrain(MaxY, Bitmap.ClipRect.Top, Bitmap.ClipRect.Bottom);
  1089.   if MinY >= MaxY then Exit;
  1090.  
  1091.   SetLength(ScanLines, MaxY - MinY + 1);
  1092.   AddPolygon(PP, Bitmap.ClipRect.Left shl 8, MinY, Bitmap.ClipRect.Right shl 8 - 1,
  1093.     Bitmap.ClipRect.Bottom - 1, ScanLines, True);
  1094.  
  1095.   SortLines(ScanLines);
  1096.   Bitmap.BeginUpdate;
  1097.   try
  1098.     If Assigned(FillLineCallback) then
  1099.       CustomFillLines(Bitmap, MinY, ScanLines, FillLineCallback, Mode)
  1100.     else
  1101.       ColorFillLines(Bitmap, MinY, ScanLines, Color, Mode);
  1102.   finally
  1103.     Bitmap.EndUpdate;
  1104.     Bitmap.Changed;
  1105.   end;
  1106. end;
  1107.  
  1108. procedure PolygonTS(Bitmap: TBitmap32; const Points: TArrayOfFixedPoint;
  1109.   Color: TColor32; Mode: TPolyFillMode; Transformation: TTransformation);
  1110. begin
  1111.   RenderPolygonTS(Bitmap, Points, Color, nil, Mode, Transformation);
  1112. end;
  1113.  
  1114. procedure PolygonTS(Bitmap: TBitmap32; const Points: TArrayOfFixedPoint;
  1115.   FillLineCallback: TFillLineEvent; Mode: TPolyFillMode;
  1116.   Transformation: TTransformation);
  1117. begin
  1118.   RenderPolygonTS(Bitmap, Points, 0, FillLineCallback, Mode, Transformation);
  1119. end;
  1120.  
  1121. procedure PolygonTS(Bitmap: TBitmap32; const Points: TArrayOfFixedPoint;
  1122.   Filler: TCustomPolygonFiller; Mode: TPolyFillMode;
  1123.   Transformation: TTransformation);
  1124. begin
  1125.   RenderPolygonTS(Bitmap, Points, 0, Filler.FillLine, Mode, Transformation);
  1126. end;
  1127.  
  1128. // only used internally to share code:
  1129. procedure RenderPolygonXS(Bitmap: TBitmap32; const Points: TArrayOfFixedPoint;
  1130.   Color: TColor32; FillLineCallback: TFillLineEvent; Mode: TPolyFillMode;
  1131.   const AAMode: TAntialiasMode; Transformation: TTransformation);
  1132. var
  1133.   L, I, MinY, MaxY: Integer;
  1134.   ScanLines: TScanLines;
  1135.   PP: TArrayOfPoint;
  1136.   AAShift, AAClipTop, AAClipBottom: Integer;
  1137.   AASAR: TShiftFunc;
  1138. begin
  1139.   L := Length(Points);
  1140.   if (L < 3) or not Assigned(FillLineCallback) and (Color and $FF000000 = 0) then Exit;
  1141.   SetLength(PP, L);
  1142.  
  1143.   AASAR := AA_SAR[AAMode];
  1144.  
  1145.   MinY := $7F000000;
  1146.   MaxY := -$7F000000;
  1147.  
  1148.   If Assigned(Transformation) then
  1149.   begin
  1150.     for I := 0 to L - 1 do
  1151.       with Transformation.Transform(Points[I]) do
  1152.       begin
  1153.         PP[I].X := AASAR(X + $00007FF);
  1154.         PP[I].Y := AASAR(Y + $00007FF);
  1155.         if PP[I].Y < MinY then MinY := PP[I].Y;
  1156.         if PP[I].Y > MaxY then MaxY := PP[I].Y;
  1157.       end;
  1158.   end
  1159.   else
  1160.   begin
  1161.     for I := 0 to L - 1 do
  1162.       with Points[I] do
  1163.       begin
  1164.         PP[I].X := AASAR(X + $00007FF);
  1165.         PP[I].Y := AASAR(Y + $00007FF);
  1166.         if PP[I].Y < MinY then MinY := PP[I].Y;
  1167.         if PP[I].Y > MaxY then MaxY := PP[I].Y;
  1168.       end;
  1169.   end;
  1170.  
  1171.   AAShift := AA_SHIFT[AAMode];
  1172.   AAClipTop := Bitmap.ClipRect.Top shl AAShift;
  1173.   AAClipBottom := Bitmap.ClipRect.Bottom shl AAShift - 1;
  1174.  
  1175.   MinY := Constrain(MinY, AAClipTop, AAClipBottom);
  1176.   MaxY := Constrain(MaxY, AAClipTop, AAClipBottom);
  1177.   if MinY >= MaxY then Exit;
  1178.  
  1179.   SetLength(ScanLines, MaxY - MinY + 1);
  1180.   AddPolygon(PP, Bitmap.ClipRect.Left shl AAShift, MinY,
  1181.     Bitmap.ClipRect.Right shl AAShift - 1, AAClipBottom, ScanLines, False);
  1182.  
  1183.   SortLines(ScanLines);
  1184.   Bitmap.BeginUpdate;
  1185.   try
  1186.     If Assigned(FillLineCallback) then
  1187.       CustomFillLines2(Bitmap, MinY, ScanLines, FillLineCallback, Mode, AAMode)
  1188.     else
  1189.       ColorFillLines2(Bitmap, MinY, ScanLines, Color, Mode, AAMode);
  1190.   finally
  1191.     Bitmap.EndUpdate;
  1192.     Bitmap.Changed;
  1193.   end;
  1194. end;
  1195.  
  1196. procedure PolygonXS(Bitmap: TBitmap32; const Points: TArrayOfFixedPoint;
  1197.   Color: TColor32; Mode: TPolyFillMode;
  1198.   const AAMode: TAntialiasMode; Transformation: TTransformation);
  1199. begin
  1200.   RenderPolygonXS(Bitmap, Points, Color, nil, Mode, AAMode, Transformation);
  1201. end;
  1202.  
  1203. procedure PolygonXS(Bitmap: TBitmap32; const Points: TArrayOfFixedPoint;
  1204.   FillLineCallback: TFillLineEvent; Mode: TPolyFillMode;
  1205.   const AAMode: TAntialiasMode; Transformation: TTransformation);
  1206. begin
  1207.   RenderPolygonXS(Bitmap, Points, 0, FillLineCallback, Mode, AAMode, Transformation);
  1208. end;
  1209.  
  1210. procedure PolygonXS(Bitmap: TBitmap32; const Points: TArrayOfFixedPoint;
  1211.   Filler: TCustomPolygonFiller; Mode: TPolyFillMode;
  1212.   const AAMode: TAntialiasMode; Transformation: TTransformation);
  1213. begin
  1214.   RenderPolygonXS(Bitmap, Points, 0, Filler.FillLine, Mode, AAMode, Transformation);
  1215. end;
  1216.  
  1217. { PolyPolygons }
  1218.  
  1219. // only used internally to share code:
  1220. procedure RenderPolyPolygonTS(Bitmap: TBitmap32;
  1221.   const Points: TArrayOfArrayOfFixedPoint; Color: TColor32;
  1222.   FillLineCallback: TFillLineEvent; Mode: TPolyFillMode;
  1223.   Transformation: TTransformation);
  1224. var
  1225.   L, I, J, MinY, MaxY, ShiftedLeft, ShiftedRight, ClipBottom: Integer;
  1226.   ScanLines: TScanLines;
  1227.   PP: TArrayOfArrayOfPoint;
  1228. begin
  1229.   SetLength(PP, Length(Points));
  1230.  
  1231.   MaxY := -$7FFFFFFF;
  1232.   MinY := $7FFFFFFF;
  1233.   If Assigned(Transformation) then
  1234.   begin
  1235.     for J := 0 to High(Points) do
  1236.     begin
  1237.       L := Length(Points[J]);
  1238.       SetLength(PP[J], L);
  1239.       for I := 0 to L - 1 do
  1240.         with Transformation.Transform(Points[J][I]) do
  1241.         begin
  1242.           PP[J][I].X := SAR_16(X + $00007FFF);
  1243.           PP[J][I].Y := SAR_16(Y + $00007FFF);
  1244.           if PP[J][I].Y < MinY then MinY := PP[J][I].Y;
  1245.           if PP[J][I].Y > MaxY then MaxY := PP[J][I].Y;
  1246.         end
  1247.     end
  1248.   end
  1249.   else
  1250.   begin
  1251.     for J := 0 to High(Points) do
  1252.     begin
  1253.       L := Length(Points[J]);
  1254.       SetLength(PP[J], L);
  1255.       for I := 0 to L - 1 do
  1256.         with Points[J][I] do
  1257.         begin
  1258.           PP[J][I].X := SAR_16(X + $00007FFF);
  1259.           PP[J][I].Y := SAR_16(Y + $00007FFF);
  1260.           if PP[J][I].Y < MinY then MinY := PP[J][I].Y;
  1261.           if PP[J][I].Y > MaxY then MaxY := PP[J][I].Y;
  1262.         end;
  1263.     end;
  1264.   end;
  1265.  
  1266.   MinY := Constrain(MinY, Bitmap.ClipRect.Top, Bitmap.ClipRect.Bottom);
  1267.   MaxY := Constrain(MaxY, Bitmap.ClipRect.Top, Bitmap.ClipRect.Bottom);
  1268.   if MinY >= MaxY then Exit;
  1269.  
  1270.   ShiftedLeft := Bitmap.ClipRect.Left shl 8;
  1271.   ShiftedRight := Bitmap.ClipRect.Right shl 8 - 1;
  1272.   ClipBottom := Bitmap.ClipRect.Bottom - 1;
  1273.  
  1274.   SetLength(ScanLines, MaxY - MinY + 1);
  1275.   for J := 0 to High(Points) do
  1276.     AddPolygon(PP[J], ShiftedLeft, MinY, ShiftedRight, ClipBottom, ScanLines, True);
  1277.  
  1278.   SortLines(ScanLines);
  1279.   Bitmap.BeginUpdate;
  1280.   try
  1281.     If Assigned(FillLineCallback) then
  1282.       CustomFillLines(Bitmap, MinY, ScanLines, FillLineCallback, Mode)
  1283.     else
  1284.       ColorFillLines(Bitmap, MinY, ScanLines, Color, Mode);
  1285.   finally
  1286.     Bitmap.EndUpdate;
  1287.     Bitmap.Changed;
  1288.   end;
  1289. end;
  1290.  
  1291. procedure PolyPolygonTS(Bitmap: TBitmap32;
  1292.   const Points: TArrayOfArrayOfFixedPoint; Color: TColor32; Mode: TPolyFillMode;
  1293.   Transformation: TTransformation);
  1294. begin
  1295.   RenderPolyPolygonTS(Bitmap, Points, Color, nil, Mode, Transformation);
  1296. end;
  1297.  
  1298. procedure PolyPolygonTS(Bitmap: TBitmap32;
  1299.   const Points: TArrayOfArrayOfFixedPoint; FillLineCallback: TFillLineEvent;
  1300.   Mode: TPolyFillMode; Transformation: TTransformation);
  1301. begin
  1302.   RenderPolyPolygonTS(Bitmap, Points, 0, FillLineCallback, Mode, Transformation);
  1303. end;
  1304.  
  1305. procedure PolyPolygonTS(Bitmap: TBitmap32;
  1306.   const Points: TArrayOfArrayOfFixedPoint; Filler: TCustomPolygonFiller;
  1307.   Mode: TPolyFillMode; Transformation: TTransformation);
  1308. begin
  1309.   RenderPolyPolygonTS(Bitmap, Points, 0, Filler.FillLine, Mode, Transformation);
  1310. end;
  1311.  
  1312. // only used internally to share code:
  1313. procedure RenderPolyPolygonXS(Bitmap: TBitmap32;
  1314.   const Points: TArrayOfArrayOfFixedPoint; Color: TColor32;
  1315.   FillLineCallback: TFillLineEvent; Mode: TPolyFillMode;
  1316.   const AAMode: TAntialiasMode; Transformation: TTransformation);
  1317. var
  1318.   L, I, J, MinY, MaxY: Integer;
  1319.   ScanLines: TScanLines;
  1320.   PP: TArrayOfArrayOfPoint;
  1321.   AAShift, AAClipLeft, AAClipTop, AAClipRight, AAClipBottom: Integer;
  1322.   AASAR: TShiftFunc;
  1323. begin
  1324.   AASAR := AA_SAR[AAMode];
  1325.  
  1326.   SetLength(PP, Length(Points));
  1327.  
  1328.   MaxY := -$7F000000;
  1329.   MinY := $7F000000;
  1330.   If Assigned(Transformation) then
  1331.   begin
  1332.     for J := 0 to High(Points) do
  1333.     begin
  1334.       L := Length(Points[J]);
  1335.       if L > 2 then
  1336.       begin
  1337.         SetLength(PP[J], L);
  1338.         for I := 0 to L - 1 do
  1339.           with Transformation.Transform(Points[J][I]) do
  1340.           begin
  1341.             PP[J][I].X := AASAR(X + $00007FF);
  1342.             PP[J][I].Y := AASAR(Y + $00007FF);
  1343.             if PP[J][I].Y < MinY then MinY := PP[J][I].Y;
  1344.             if PP[J][I].Y > MaxY then MaxY := PP[J][I].Y;
  1345.           end
  1346.       end
  1347.       else SetLength(PP[J], 0);
  1348.     end
  1349.   end
  1350.   else
  1351.   begin
  1352.     for J := 0 to High(Points) do
  1353.     begin
  1354.       L := Length(Points[J]);
  1355.       if L > 2 then
  1356.       begin
  1357.         SetLength(PP[J], L);
  1358.         for I := 0 to L - 1 do
  1359.           with Points[J][I] do
  1360.           begin
  1361.             PP[J][I].X := AASAR(X + $000007FF);
  1362.             PP[J][I].Y := AASAR(Y + $000007FF);
  1363.             if PP[J][I].Y < MinY then MinY := PP[J][I].Y;
  1364.             if PP[J][I].Y > MaxY then MaxY := PP[J][I].Y;
  1365.           end;
  1366.       end
  1367.       else SetLength(PP[J], 0);
  1368.     end;
  1369.   end;
  1370.   
  1371.   AAShift := AA_SHIFT[AAMode];
  1372.   AAClipLeft := Bitmap.ClipRect.Left shl AAShift;
  1373.   AAClipTop := Bitmap.ClipRect.Top shl AAShift;
  1374.   AAClipRight := Bitmap.ClipRect.Right shl AAShift - 1;
  1375.   AAClipBottom := Bitmap.ClipRect.Bottom shl AAShift - 1;
  1376.  
  1377.   MinY := Constrain(MinY, AAClipTop, AAClipBottom);
  1378.   MaxY := Constrain(MaxY, AAClipTop, AAClipBottom);
  1379.   if MinY >= MaxY then Exit;
  1380.  
  1381.   SetLength(ScanLines, MaxY - MinY + 1);
  1382.   for J := 0 to High(Points) do
  1383.     AddPolygon(PP[J], AAClipLeft, MinY, AAClipRight, AAClipBottom, ScanLines, False);
  1384.  
  1385.   SortLines(ScanLines);
  1386.   Bitmap.BeginUpdate;
  1387.   try
  1388.     If Assigned(FillLineCallback) then
  1389.       CustomFillLines2(Bitmap, MinY, ScanLines, FillLineCallback, Mode, AAMode)
  1390.     else
  1391.       ColorFillLines2(Bitmap, MinY, ScanLines, Color, Mode, AAMode);
  1392.   finally
  1393.     Bitmap.EndUpdate;
  1394.     Bitmap.Changed;
  1395.   end;
  1396. end;
  1397.  
  1398. procedure PolyPolygonXS(Bitmap: TBitmap32;
  1399.   const Points: TArrayOfArrayOfFixedPoint; Color: TColor32; Mode: TPolyFillMode;
  1400.   const AAMode: TAntialiasMode; Transformation: TTransformation);
  1401. begin
  1402.   RenderPolyPolygonXS(Bitmap, Points, Color, nil, Mode, AAMode, Transformation);
  1403. end;
  1404.  
  1405. procedure PolyPolygonXS(Bitmap: TBitmap32;
  1406.   const Points: TArrayOfArrayOfFixedPoint; FillLineCallback: TFillLineEvent;
  1407.   Mode: TPolyFillMode; const AAMode: TAntialiasMode;
  1408.   Transformation: TTransformation);
  1409. begin
  1410.   RenderPolyPolygonXS(Bitmap, Points, 0, FillLineCallback, Mode, AAMode, Transformation);
  1411. end;
  1412.  
  1413. procedure PolyPolygonXS(Bitmap: TBitmap32;
  1414.   const Points: TArrayOfArrayOfFixedPoint; Filler: TCustomPolygonFiller;
  1415.   Mode: TPolyFillMode; const AAMode: TAntialiasMode;
  1416.   Transformation: TTransformation);
  1417. begin
  1418.   RenderPolyPolygonXS(Bitmap, Points, 0, Filler.FillLine, Mode, AAMode, Transformation);
  1419. end;
  1420.  
  1421. { helper routines }
  1422.  
  1423. function PtInPolygon(const Pt: TFixedPoint; const Points: TArrayOfFixedPoint): Boolean;
  1424. var
  1425.   I: Integer;
  1426.   iPt, jPt: PFixedPoint;
  1427. begin
  1428.   Result := False;
  1429.   iPt := @Points[0];
  1430.   jPt := @Points[High(Points)];
  1431.   for I := 0 to High(Points) do
  1432.   begin
  1433.     Result := Result xor (((Pt.Y >= iPt.Y) xor (Pt.Y >= jPt.Y)) and
  1434.       (Pt.X - iPt.X < MulDiv(jPt.X - iPt.X, Pt.Y - iPt.Y, jPt.Y - iPt.Y)));
  1435.     jPt := iPt;
  1436.     Inc(iPt);
  1437.   end;
  1438. end;
  1439.  
  1440. { TPolygon32 }
  1441.  
  1442. procedure TPolygon32.Add(const P: TFixedPoint);
  1443. var
  1444.   H, L: Integer;
  1445. begin
  1446.   H := High(Points);
  1447.   L := Length(Points[H]);
  1448.   SetLength(Points[H], L + 1);
  1449.   Points[H][L] := P;
  1450.   Normals := nil;
  1451. end;
  1452.  
  1453. procedure TPolygon32.AddPoints(var First: TFixedPoint; Count: Integer);
  1454. var
  1455.   H, L, I: Integer;
  1456. begin
  1457.   H := High(Points);
  1458.   L := Length(Points[H]);
  1459.   SetLength(Points[H], L + Count);
  1460.   for I := 0 to Count - 1 do
  1461.     Points[H, L + I] := PFixedPointArray(@First)[I];
  1462.   Normals := nil;
  1463. end;
  1464.  
  1465. procedure TPolygon32.AssignProperties(Dest: TPolygon32);
  1466. begin
  1467.   Dest.Antialiased := Antialiased;
  1468.   Dest.AntialiasMode := AntialiasMode;
  1469.   Dest.Closed := Closed;
  1470.   Dest.FillMode := FillMode;
  1471. end;
  1472.  
  1473. procedure TPolygon32.AssignTo(Dest: TPersistent);
  1474. var
  1475.   DestPolygon: TPolygon32;
  1476. begin
  1477.   if Dest is TPolygon32 then
  1478.   begin
  1479.     DestPolygon := TPolygon32(Dest);
  1480.     AssignProperties(DestPolygon);
  1481.     DestPolygon.Normals := Copy(Normals);
  1482.     DestPolygon.Points := Copy(Points);
  1483.   end
  1484.   else
  1485.     inherited;
  1486. end;
  1487.  
  1488. function TPolygon32.GetBoundingRect: TFixedRect;
  1489. var
  1490.   I, J, X, Y: Integer;
  1491. begin
  1492.   With Result do
  1493.   begin
  1494.     Left := $7f000000;
  1495.     Right := -$7f000000;
  1496.     Top := $7f000000;
  1497.     Bottom := -$7f000000;
  1498.  
  1499.     for I := 0 to High(Points) do
  1500.       for J := 0 to High(Points[I]) do
  1501.       begin
  1502.         X := Points[I, J].X;
  1503.         Y := Points[I, J].Y;
  1504.  
  1505.         if X < Left   then Left := X;
  1506.         if X > Right  then Right := X;
  1507.         if Y < Top    then Top := Y;
  1508.         if Y > Bottom then Bottom := Y;
  1509.       end;
  1510.   end;
  1511. end;
  1512.  
  1513. procedure TPolygon32.BuildNormals;
  1514. var
  1515.   I, J, Count, NextI: Integer;
  1516.   dx, dy, f: Single;
  1517. begin
  1518.   if Length(Normals) <> 0 then Exit;
  1519.   SetLength(FNormals, Length(Points));
  1520.  
  1521.   for J := 0 to High(Points) do
  1522.   begin
  1523.     Count := Length(Points[J]);
  1524.     SetLength(Normals[J], Count);
  1525.  
  1526.     if Count = 0 then Exit;
  1527.     if Count = 1 then
  1528.     begin
  1529.       FillChar(Normals[J][0], SizeOf(TFixedPoint), 0);
  1530.       Exit;
  1531.     end;
  1532.  
  1533.     I := 0;
  1534.     NextI := 1;
  1535.     dx := 0;
  1536.     dy := 0;
  1537.  
  1538.     while I < Count do
  1539.     begin
  1540.       if Closed and (NextI >= Count) then NextI := 0;
  1541.       if NextI < Count then
  1542.       begin
  1543.         dx := (Points[J][NextI].X - Points[J][I].X) / $10000;
  1544.         dy := (Points[J][NextI].Y - Points[J][I].Y) / $10000;
  1545.       end;
  1546.       if (dx <> 0) or (dy <> 0) then
  1547.       begin
  1548.         f := 1 / Hypot(dx, dy);
  1549.         dx := dx * f;
  1550.         dy := dy * f;
  1551.       end;
  1552.       with Normals[J][I] do
  1553.       begin
  1554.         X := Fixed(dy);
  1555.         Y := Fixed(-dx);
  1556.       end;
  1557.       Inc(I);
  1558.       Inc(NextI);
  1559.     end;
  1560.   end;
  1561. end;
  1562.  
  1563. procedure TPolygon32.Clear;
  1564. begin
  1565.   Points := nil;
  1566.   Normals := nil;
  1567.   NewLine;
  1568. end;
  1569.  
  1570. function TPolygon32.ContainsPoint(const P: TFixedPoint): Boolean;
  1571. var
  1572.   I: Integer;
  1573. begin
  1574.   Result := False;
  1575.   for I := 0 to High(FPoints) do
  1576.     if PtInPolygon(P, FPoints[I]) then
  1577.     begin
  1578.       Result := True;
  1579.       Exit;
  1580.     end;
  1581. end;
  1582.  
  1583. constructor TPolygon32.Create;
  1584. begin
  1585.   inherited;
  1586.   FClosed := True;
  1587.   FAntialiasMode := DefaultAAMode;
  1588.   NewLine; // initiate a new contour
  1589. end;
  1590.  
  1591. destructor TPolygon32.Destroy;
  1592. begin
  1593.   Clear;
  1594.   inherited;
  1595. end;
  1596.  
  1597. procedure TPolygon32.Draw(Bitmap: TBitmap32; OutlineColor, FillColor: TColor32; Transformation: TTransformation);
  1598. begin
  1599.   Bitmap.BeginUpdate;
  1600.  
  1601.   if Antialiased then
  1602.   begin
  1603.     if (FillColor and $FF000000) <> 0 then
  1604.       PolyPolygonXS(Bitmap, Points, FillColor, FillMode, AntialiasMode, Transformation);
  1605.     if (OutlineColor and $FF000000) <> 0 then
  1606.       PolyPolylineXS(Bitmap, Points, OutlineColor, Closed, Transformation);
  1607.   end
  1608.   else
  1609.   begin
  1610.     if (FillColor and $FF000000) <> 0 then
  1611.       PolyPolygonTS(Bitmap, Points, FillColor, FillMode, Transformation);
  1612.     if (OutlineColor and $FF000000) <> 0 then
  1613.       PolyPolylineTS(Bitmap, Points, OutlineColor, Closed, Transformation);
  1614.   end;
  1615.  
  1616.   Bitmap.EndUpdate;
  1617.   Bitmap.Changed;
  1618. end;
  1619.  
  1620. procedure TPolygon32.Draw(Bitmap: TBitmap32; OutlineColor: TColor32;
  1621.   FillCallback: TFillLineEvent; Transformation: TTransformation);
  1622. begin
  1623.   Bitmap.BeginUpdate;
  1624.  
  1625.   if Antialiased then
  1626.   begin
  1627.     PolyPolygonXS(Bitmap, Points, FillCallback, FillMode, AntialiasMode, Transformation);
  1628.     if (OutlineColor and $FF000000) <> 0 then
  1629.       PolyPolylineXS(Bitmap, Points, OutlineColor, Closed, Transformation);
  1630.   end
  1631.   else
  1632.   begin
  1633.     PolyPolygonTS(Bitmap, Points, FillCallback, FillMode, Transformation);
  1634.     if (OutlineColor and $FF000000) <> 0 then
  1635.       PolyPolylineTS(Bitmap, Points, OutlineColor, Closed, Transformation);
  1636.   end;
  1637.  
  1638.   Bitmap.EndUpdate;
  1639.   Bitmap.Changed;
  1640. end;
  1641.  
  1642. procedure TPolygon32.Draw(Bitmap: TBitmap32; OutlineColor: TColor32;
  1643.   Filler: TCustomPolygonFiller; Transformation: TTransformation);
  1644. begin
  1645.   Draw(Bitmap, OutlineColor, Filler.FillLine, Transformation);
  1646. end;
  1647.  
  1648. procedure TPolygon32.DrawEdge(Bitmap: TBitmap32; Color: TColor32; Transformation: TTransformation);
  1649. begin
  1650.   Bitmap.BeginUpdate;
  1651.  
  1652.   if Antialiased then
  1653.     PolyPolylineXS(Bitmap, Points, Color, Closed, Transformation)
  1654.   else
  1655.     PolyPolylineTS(Bitmap, Points, Color, Closed, Transformation);
  1656.  
  1657.   Bitmap.EndUpdate;
  1658.   Bitmap.Changed;
  1659. end;
  1660.  
  1661. procedure TPolygon32.DrawFill(Bitmap: TBitmap32; Color: TColor32; Transformation: TTransformation);
  1662. begin
  1663.   Bitmap.BeginUpdate;
  1664.  
  1665.   if Antialiased then
  1666.     PolyPolygonXS(Bitmap, Points, Color, FillMode, AntialiasMode, Transformation)
  1667.   else
  1668.     PolyPolygonTS(Bitmap, Points, Color, FillMode, Transformation);
  1669.  
  1670.   Bitmap.EndUpdate;
  1671.   Bitmap.Changed;
  1672. end;
  1673.  
  1674. procedure TPolygon32.DrawFill(Bitmap: TBitmap32; FillCallback: TFillLineEvent;
  1675.   Transformation: TTransformation);
  1676. begin
  1677.   Bitmap.BeginUpdate;
  1678.  
  1679.   if Antialiased then
  1680.     PolyPolygonXS(Bitmap, Points, FillCallback, FillMode, AntialiasMode, Transformation)
  1681.   else
  1682.     PolyPolygonTS(Bitmap, Points, FillCallback, FillMode, Transformation);
  1683.  
  1684.   Bitmap.EndUpdate;
  1685.   Bitmap.Changed;
  1686. end;
  1687.  
  1688. procedure TPolygon32.DrawFill(Bitmap: TBitmap32; Filler: TCustomPolygonFiller;
  1689.   Transformation: TTransformation);
  1690. begin
  1691.   DrawFill(Bitmap, Filler.FillLine, Transformation);
  1692. end;
  1693.  
  1694. function TPolygon32.Grow(const Delta: TFixed; EdgeSharpness: Single = 0): TPolygon32;
  1695. var
  1696.   J, I, PrevI: Integer;
  1697.   PX, PY, AX, AY, BX, BY, CX, CY, R, D, E: Integer;
  1698.  
  1699.   procedure AddPoint(LongDeltaX, LongDeltaY: Integer);
  1700.   var
  1701.     N, L: Integer;
  1702.   begin
  1703.     with Result do
  1704.     begin
  1705.       N := High(Points);
  1706.       L := Length(Points[N]);
  1707.       SetLength(Points[N], L + 1);
  1708.     end;
  1709.     with Result.Points[N][L] do
  1710.     begin
  1711.       X := PX + LongDeltaX;
  1712.       Y := PY + LongDeltaY;
  1713.     end;
  1714.   end;
  1715.  
  1716. begin
  1717.   BuildNormals;
  1718.  
  1719.   if EdgeSharpness > 0.99 then EdgeSharpness := 0.99
  1720.   else if EdgeSharpness < 0 then EdgeSharpness := 0;
  1721.  
  1722.   D := Delta;
  1723.   E := Round(D * (1 - EdgeSharpness));
  1724.  
  1725.   Result := TPolygon32.Create;
  1726.   AssignProperties(Result);
  1727.  
  1728.   if Delta = 0 then
  1729.   begin
  1730.     // simply copy the data
  1731.     SetLength(Result.FPoints, Length(Points));
  1732.     for J := 0 to High(Points) do
  1733.       Result.Points[J] := Copy(Points[J], 0, Length(Points[J]));
  1734.     Exit;
  1735.   end;
  1736.  
  1737.   Result.Points := nil;
  1738.  
  1739.   for J := 0 to High(Points) do
  1740.   begin
  1741.     if Length(Points[J]) < 2 then Continue;
  1742.  
  1743.     Result.NewLine;
  1744.  
  1745.     for I := 0 to High(Points[J]) do
  1746.     begin
  1747.       with Points[J][I] do
  1748.       begin
  1749.         PX := X;
  1750.         PY := Y;
  1751.       end;
  1752.  
  1753.       with Normals[J][I] do
  1754.       begin
  1755.         BX := MulDiv(X, D, $10000);
  1756.         BY := MulDiv(Y, D, $10000);
  1757.       end;
  1758.  
  1759.       if (I > 0) or Closed then
  1760.       begin
  1761.         PrevI := I - 1;
  1762.         if PrevI < 0 then PrevI := High(Points[J]);
  1763.         with Normals[J][PrevI] do
  1764.         begin
  1765.           AX := MulDiv(X, D, $10000);
  1766.           AY := MulDiv(Y, D, $10000);
  1767.         end;
  1768.  
  1769.         if (I = High(Points[J])) and (not Closed) then AddPoint(AX, AY)
  1770.         else
  1771.         begin
  1772.           CX := AX + BX;
  1773.           CY := AY + BY;
  1774.           R := MulDiv(AX, CX, D) + MulDiv(AY, CY, D);
  1775.           if R > E then AddPoint(MulDiv(CX, D, R), MulDiv(CY, D, R))
  1776.           else
  1777.           begin
  1778.             AddPoint(AX, AY);
  1779.             AddPoint(BX, BY);
  1780.           end;
  1781.         end;
  1782.       end
  1783.       else AddPoint(BX, BY);
  1784.     end;
  1785.   end;
  1786. end;
  1787.  
  1788. procedure TPolygon32.NewLine;
  1789. begin
  1790.   SetLength(FPoints, Length(Points) + 1);
  1791.   Normals := nil;
  1792. end;
  1793.  
  1794. procedure TPolygon32.Offset(const Dx, Dy: TFixed);
  1795. var
  1796.   J, I: Integer;
  1797. begin
  1798.   for J := 0 to High(Points) do
  1799.     for I := 0 to High(Points[J]) do
  1800.       with Points[J][I] do
  1801.       begin
  1802.         Inc(X, Dx);
  1803.         Inc(Y, Dy);
  1804.       end;
  1805. end;
  1806.  
  1807. function TPolygon32.Outline: TPolygon32;
  1808. var
  1809.   J, I: Integer;
  1810. begin
  1811.   BuildNormals;
  1812.  
  1813.   Result := TPolygon32.Create;
  1814.   AssignProperties(Result);
  1815.  
  1816.   Result.Points := nil;
  1817.  
  1818.   for J := 0 to High(Points) do
  1819.   begin
  1820.     if Length(Points[J]) < 2 then Continue;
  1821.  
  1822.     if Closed then
  1823.     begin
  1824.       Result.NewLine;
  1825.       for I := 0 to High(Points[J]) do Result.Add(Points[J][I]);
  1826.       Result.NewLine;
  1827.       for I := High(Points[J]) downto 0 do Result.Add(Points[J][I]);
  1828.     end
  1829.     else // not closed
  1830.     begin
  1831.       Result.NewLine;
  1832.       for I := 0 to High(Points[J]) do Result.Add(Points[J][I]);
  1833.       for I := High(Points[J]) downto 0 do Result.Add(Points[J][I]);
  1834.     end;
  1835.   end;
  1836. end;
  1837.  
  1838. procedure TPolygon32.Transform(Transformation: TTransformation);
  1839. begin
  1840.   Points := TransformPoints(Points, Transformation);
  1841. end;
  1842.  
  1843. { TBitmapFiller }
  1844.  
  1845. procedure TBitmapPolygonFiller.FillLineOpaque(Dst: PColor32; DstX, DstY,
  1846.   Length: Integer; AlphaValues: PColor32);
  1847. var
  1848.   PatternX, PatternY, X: Integer;
  1849.   OpaqueAlpha: TColor32;
  1850.   Src: PColor32;
  1851.   BlendMemEx: TBlendMemEx;
  1852. begin
  1853.   PatternX := (DstX - OffsetX) mod FPattern.Width;
  1854.   If PatternX < 0 then PatternX := (FPattern.Width + PatternX) mod FPattern.Width;
  1855.   PatternY := (DstY - OffsetY) mod FPattern.Height;
  1856.   If PatternY < 0 then PatternY := (FPattern.Height + PatternY) mod FPattern.Height;
  1857.  
  1858.   Src := @FPattern.Bits[PatternX + PatternY * FPattern.Width];
  1859.  
  1860.   If Assigned(AlphaValues) then
  1861.   begin
  1862.     OpaqueAlpha := TColor32($FF shl 24);
  1863.     BlendMemEx := BLEND_MEM_EX[FPattern.CombineMode];
  1864.     for X := DstX to DstX + Length - 1 do
  1865.     begin
  1866.       BlendMemEx(Src^ and $00FFFFFF or OpaqueAlpha, Dst^, AlphaValues^);
  1867.       Inc(Dst);  Inc(Src);  Inc(PatternX);
  1868.       If PatternX >= FPattern.Width then
  1869.       begin
  1870.         PatternX := 0;
  1871.         Src := @FPattern.Bits[PatternX + PatternY * FPattern.Width];
  1872.       end;
  1873.       Inc(AlphaValues);
  1874.     end
  1875.   end
  1876.   else
  1877.     for X := DstX to DstX + Length - 1 do
  1878.     begin
  1879.       Dst^ := Src^;
  1880.       Inc(Dst);  Inc(Src);  Inc(PatternX);
  1881.       If PatternX >= FPattern.Width then
  1882.       begin
  1883.         PatternX := 0;
  1884.         Src := @FPattern.Bits[PatternX + PatternY * FPattern.Width];
  1885.       end;
  1886.     end;
  1887. end;
  1888.  
  1889. procedure TBitmapPolygonFiller.FillLineBlend(Dst: PColor32; DstX, DstY, Length: Integer; AlphaValues: PColor32);
  1890. var
  1891.   PatternX, PatternY, X: Integer;
  1892.   Src: PColor32;
  1893.   BlendMemEx: TBlendMemEx;
  1894.   BlendMem: TBlendMem;
  1895. begin
  1896.   PatternX := (DstX - OffsetX) mod FPattern.Width;
  1897.   If PatternX < 0 then PatternX := (FPattern.Width + PatternX) mod FPattern.Width;
  1898.   PatternY := (DstY - OffsetY) mod FPattern.Height;
  1899.   If PatternY < 0 then PatternY := (FPattern.Height + PatternY) mod FPattern.Height;
  1900.  
  1901.   Src := @FPattern.Bits[PatternX + PatternY * FPattern.Width];
  1902.  
  1903.   If Assigned(AlphaValues) then
  1904.   begin
  1905.     BlendMemEx := BLEND_MEM_EX[FPattern.CombineMode];
  1906.     for X := DstX to DstX + Length - 1 do
  1907.     begin
  1908.       BlendMemEx(Src^, Dst^, AlphaValues^);
  1909.       Inc(Dst);  Inc(Src);  Inc(PatternX);
  1910.       If PatternX >= FPattern.Width then
  1911.       begin
  1912.         PatternX := 0;
  1913.         Src := @FPattern.Bits[PatternX + PatternY * FPattern.Width];
  1914.       end;
  1915.       Inc(AlphaValues);
  1916.     end
  1917.   end
  1918.   else
  1919.   begin
  1920.     BlendMem := BLEND_MEM[FPattern.CombineMode];
  1921.     for X := DstX to DstX + Length - 1 do
  1922.     begin
  1923.       BlendMem(Src^, Dst^);
  1924.       Inc(Dst);  Inc(Src);  Inc(PatternX);
  1925.       If PatternX >= FPattern.Width then
  1926.       begin
  1927.         PatternX := 0;
  1928.         Src := @FPattern.Bits[PatternX + PatternY * FPattern.Width];
  1929.       end;
  1930.     end;
  1931.   end;
  1932. end;
  1933.  
  1934. procedure TBitmapPolygonFiller.FillLineBlendMasterAlpha(Dst: PColor32; DstX, DstY,
  1935.   Length: Integer; AlphaValues: PColor32);
  1936. var
  1937.   PatternX, PatternY, X: Integer;
  1938.   Src: PColor32;
  1939.   BlendMemEx: TBlendMemEx;
  1940. begin
  1941.   PatternX := (DstX - OffsetX) mod FPattern.Width;
  1942.   If PatternX < 0 then PatternX := (FPattern.Width + PatternX) mod FPattern.Width;
  1943.   PatternY := (DstY - OffsetY) mod FPattern.Height;
  1944.   If PatternY < 0 then PatternY := (FPattern.Height + PatternY) mod FPattern.Height;
  1945.  
  1946.   Src := @FPattern.Bits[PatternX + PatternY * FPattern.Width];
  1947.  
  1948.   BlendMemEx := BLEND_MEM_EX[FPattern.CombineMode];
  1949.  
  1950.   If Assigned(AlphaValues) then
  1951.     for X := DstX to DstX + Length - 1 do
  1952.     begin
  1953.       BlendMemEx(Src^, Dst^, (AlphaValues^ * FPattern.MasterAlpha) div 255);
  1954.       Inc(Dst);  Inc(Src);  Inc(PatternX);
  1955.       If PatternX >= FPattern.Width then
  1956.       begin
  1957.         PatternX := 0;
  1958.         Src := @FPattern.Bits[PatternX + PatternY * FPattern.Width];
  1959.       end;
  1960.       Inc(AlphaValues);
  1961.     end
  1962.   else
  1963.     for X := DstX to DstX + Length - 1 do
  1964.     begin
  1965.       BlendMemEx(Src^, Dst^, FPattern.MasterAlpha);
  1966.       Inc(Dst);  Inc(Src);  Inc(PatternX);
  1967.       If PatternX >= FPattern.Width then
  1968.       begin
  1969.         PatternX := 0;
  1970.         Src := @FPattern.Bits[PatternX + PatternY * FPattern.Width];
  1971.       end;
  1972.     end;
  1973. end;
  1974.  
  1975. procedure TBitmapPolygonFiller.FillLineCustomCombine(Dst: PColor32; DstX, DstY,
  1976.   Length: Integer; AlphaValues: PColor32);
  1977. var
  1978.   PatternX, PatternY, X: Integer;
  1979.   Src: PColor32;
  1980. begin
  1981.   PatternX := (DstX - OffsetX) mod FPattern.Width;
  1982.   If PatternX < 0 then PatternX := (FPattern.Width + PatternX) mod FPattern.Width;
  1983.   PatternY := (DstY - OffsetY) mod FPattern.Height;
  1984.   If PatternY < 0 then PatternY := (FPattern.Height + PatternY) mod FPattern.Height;
  1985.  
  1986.   Src := @FPattern.Bits[PatternX + PatternY * FPattern.Width];
  1987.  
  1988.   If Assigned(AlphaValues) then
  1989.     for X := DstX to DstX + Length - 1 do
  1990.     begin
  1991.       FPattern.OnPixelCombine(Src^, Dst^, (AlphaValues^ * FPattern.MasterAlpha) div 255);
  1992.       Inc(Dst);  Inc(Src);  Inc(PatternX);
  1993.       If PatternX >= FPattern.Width then
  1994.       begin
  1995.         PatternX := 0;
  1996.         Src := @FPattern.Bits[PatternX + PatternY * FPattern.Width];
  1997.       end;
  1998.       Inc(AlphaValues);
  1999.     end
  2000.   else
  2001.     for X := DstX to DstX + Length - 1 do
  2002.     begin
  2003.       FPattern.OnPixelCombine(Src^, Dst^, FPattern.MasterAlpha);
  2004.       Inc(Dst);  Inc(Src);  Inc(PatternX);
  2005.       If PatternX >= FPattern.Width then
  2006.       begin
  2007.         PatternX := 0;
  2008.         Src := @FPattern.Bits[PatternX + PatternY * FPattern.Width];
  2009.       end;
  2010.     end;
  2011. end;
  2012.  
  2013. function TBitmapPolygonFiller.GetFillLine: TFillLineEvent;
  2014. begin
  2015.   if not Assigned(FPattern) then
  2016.   begin
  2017.     Result := nil;
  2018.   end
  2019.   else if FPattern.DrawMode = dmOpaque then
  2020.     Result := FillLineOpaque
  2021.   else if FPattern.DrawMode = dmBlend then
  2022.   begin
  2023.     If FPattern.MasterAlpha = 255 then
  2024.       Result := FillLineBlend
  2025.     else
  2026.       Result := FillLineBlendMasterAlpha;
  2027.   end
  2028.   else if (FPattern.DrawMode = dmCustom) and Assigned(FPattern.OnPixelCombine) then
  2029.   begin
  2030.     Result := FillLineCustomCombine;
  2031.   end
  2032.   else
  2033.     Result := nil;
  2034. end;
  2035.  
  2036. end.
  2037.