gr32_polygons.pas

skin components for design of your applicastions

unit GR32_Polygons;

(* ***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * The Original Code is Graphics32
 *
 * The Initial Developer of the Original Code is
 * Alex A. Denisov
 *
 * Portions created by the Initial Developer are Copyright (C) 2000-2006
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *   Andre Beckedorf <[e-mail]>
 *   Mattias Andersson <[e-mail]>
 *   Peter Larson <[e-mail]>
 *
 * ***** END LICENSE BLOCK ***** *)

interface

{$I GR32.inc}

uses
{$IFDEF CLX}
  Qt, Types,
  {$IFDEF LINUX}Libc, {$ENDIF}
  {$IFDEF MSWINDOWS}Windows, {$ENDIF}
{$ELSE}
  Windows,
{$ENDIF}
  Classes, SysUtils, GR32, GR32_LowLevel, GR32_Blend, GR32_Transforms, GR32_Math;

{ Polylines }

procedure PolylineTS(Bitmap: TBitmap32; const Points: TArrayOfFixedPoint;
  Color: TColor32; Closed: Boolean = False; Transformation: TTransformation = nil);
procedure PolylineAS(Bitmap: TBitmap32; const Points: TArrayOfFixedPoint;
  Color: TColor32; Closed: Boolean = False; Transformation: TTransformation = nil);
procedure PolylineXS(Bitmap: TBitmap32; const Points: TArrayOfFixedPoint;
  Color: TColor32; Closed: Boolean = False; Transformation: TTransformation = nil);
procedure PolylineXSP(Bitmap: TBitmap32; const Points: TArrayOfFixedPoint;
  Closed: Boolean = False; Transformation: TTransformation = nil);

procedure PolyPolylineTS(Bitmap: TBitmap32; const Points: TArrayOfArrayOfFixedPoint;
  Color: TColor32; Closed: Boolean = False; Transformation: TTransformation = nil);
procedure PolyPolylineAS(Bitmap: TBitmap32; const Points: TArrayOfArrayOfFixedPoint;
  Color: TColor32; Closed: Boolean = False; Transformation: TTransformation = nil);
procedure PolyPolylineXS(Bitmap: TBitmap32; const Points: TArrayOfArrayOfFixedPoint;
  Color: TColor32; Closed: Boolean = False; Transformation: TTransformation = nil);
procedure PolyPolylineXSP(Bitmap: TBitmap32; const Points: TArrayOfArrayOfFixedPoint;
  Closed: Boolean = False; Transformation: TTransformation = nil);

{ Polygons }

type
  TPolyFillMode = (pfAlternate, pfWinding);
  TAntialiasMode = (am32times, am16times, am8times, am4times, am2times);

  TFillLineEvent = procedure(Dst: PColor32; DstX, DstY, Length: Integer; AlphaValues: PColor32) of object;

  TCustomPolygonFiller = class
  protected
    function GetFillLine: TFillLineEvent; virtual; abstract;
  public
    property FillLine: TFillLineEvent read GetFillLine;
  end;

const
  DefaultAAMode = am8times; // Use 54 levels of transparency for antialiasing.

procedure PolygonTS(Bitmap: TBitmap32; const Points: TArrayOfFixedPoint;
  Color: TColor32; Mode: TPolyFillMode = pfAlternate; Transformation: TTransformation = nil); overload;
procedure PolygonTS(Bitmap: TBitmap32; const Points: TArrayOfFixedPoint;
  FillLineCallback: TFillLineEvent; Mode: TPolyFillMode = pfAlternate; Transformation: TTransformation = nil); overload;
procedure PolygonTS(Bitmap: TBitmap32; const Points: TArrayOfFixedPoint;
  Filler: TCustomPolygonFiller; Mode: TPolyFillMode = pfAlternate; Transformation: TTransformation = nil); overload;

procedure PolygonXS(Bitmap: TBitmap32; const Points: TArrayOfFixedPoint;
  Color: TColor32; Mode: TPolyFillMode = pfAlternate;
  const AAMode: TAntialiasMode = DefaultAAMode; Transformation: TTransformation = nil); overload;
procedure PolygonXS(Bitmap: TBitmap32; const Points: TArrayOfFixedPoint;
  FillLineCallback: TFillLineEvent; Mode: TPolyFillMode = pfAlternate;
  const AAMode: TAntialiasMode = DefaultAAMode; Transformation: TTransformation = nil); overload;
procedure PolygonXS(Bitmap: TBitmap32; const Points: TArrayOfFixedPoint;
  Filler: TCustomPolygonFiller; Mode: TPolyFillMode = pfAlternate;
  const AAMode: TAntialiasMode = DefaultAAMode; Transformation: TTransformation = nil); overload;

procedure PolyPolygonTS(Bitmap: TBitmap32; const Points: TArrayOfArrayOfFixedPoint;
  Color: TColor32; Mode: TPolyFillMode = pfAlternate; Transformation: TTransformation = nil); overload;
procedure PolyPolygonTS(Bitmap: TBitmap32; const Points: TArrayOfArrayOfFixedPoint;
  FillLineCallback: TFillLineEvent; Mode: TPolyFillMode = pfAlternate; Transformation: TTransformation = nil); overload;
procedure PolyPolygonTS(Bitmap: TBitmap32; const Points: TArrayOfArrayOfFixedPoint;
  Filler: TCustomPolygonFiller; Mode: TPolyFillMode = pfAlternate; Transformation: TTransformation = nil); overload;

procedure PolyPolygonXS(Bitmap: TBitmap32; const Points: TArrayOfArrayOfFixedPoint;
  Color: TColor32; Mode: TPolyFillMode = pfAlternate;
  const AAMode: TAntialiasMode = DefaultAAMode; Transformation: TTransformation = nil); overload;
procedure PolyPolygonXS(Bitmap: TBitmap32; const Points: TArrayOfArrayOfFixedPoint;
  FillLineCallback: TFillLineEvent; Mode: TPolyFillMode = pfAlternate;
  const AAMode: TAntialiasMode = DefaultAAMode; Transformation: TTransformation = nil); overload;
procedure PolyPolygonXS(Bitmap: TBitmap32; const Points: TArrayOfArrayOfFixedPoint;
  Filler: TCustomPolygonFiller; Mode: TPolyFillMode = pfAlternate;
  const AAMode: TAntialiasMode = DefaultAAMode; Transformation: TTransformation = nil); overload;

function PolygonBounds(const Points: TArrayOfFixedPoint): TFixedRect;
function PolyPolygonBounds(const Points: TArrayOfArrayOfFixedPoint): TFixedRect;

function PtInPolygon(const Pt: TFixedPoint; const Points: TArrayOfFixedPoint): Boolean;

{ TPolygon32 }
{ TODO : Bezier Curves, and QSpline curves for TrueType font rendering }
{ TODO : Check if QSpline is compatible with Type1 fonts }
type
  TPolygon32 = class(TThreadPersistent)
  private
    FAntialiased: Boolean;
    FClosed: Boolean;
    FFillMode: TPolyFillMode;
    FNormals: TArrayOfArrayOfFixedPoint;
    FPoints: TArrayOfArrayOfFixedPoint;
    FAntialiasMode: TAntialiasMode;
  protected
    procedure BuildNormals;
    procedure CopyPropertiesTo(Dst: TPolygon32); virtual;
    procedure AssignTo(Dst: TPersistent); override;
  public
    constructor Create; override;
    destructor Destroy; override;
    procedure Add(const P: TFixedPoint);
    procedure AddPoints(var First: TFixedPoint; Count: Integer);
    function  ContainsPoint(const P: TFixedPoint): Boolean;
    procedure Clear;
    function  Grow(const Delta: TFixed; EdgeSharpness: Single = 0): TPolygon32;

    procedure Draw(Bitmap: TBitmap32; OutlineColor, FillColor: TColor32; Transformation: TTransformation = nil); overload;
    procedure Draw(Bitmap: TBitmap32; OutlineColor: TColor32; FillCallback: TFillLineEvent; Transformation: TTransformation = nil); overload;
    procedure Draw(Bitmap: TBitmap32; OutlineColor: TColor32; Filler: TCustomPolygonFiller; Transformation: TTransformation = nil); overload;

    procedure DrawEdge(Bitmap: TBitmap32; Color: TColor32; Transformation: TTransformation = nil);

    procedure DrawFill(Bitmap: TBitmap32; Color: TColor32; Transformation: TTransformation = nil); overload;
    procedure DrawFill(Bitmap: TBitmap32; FillCallback: TFillLineEvent; Transformation: TTransformation = nil); overload;
    procedure DrawFill(Bitmap: TBitmap32; Filler: TCustomPolygonFiller; Transformation: TTransformation = nil); overload;

    procedure NewLine;
    procedure Offset(const Dx, Dy: TFixed);
    function  Outline: TPolygon32;
    procedure Transform(Transformation: TTransformation);
    function GetBoundingRect: TFixedRect;

    property Antialiased: Boolean read FAntialiased write FAntialiased;
    property AntialiasMode: TAntialiasMode read FAntialiasMode write FAntialiasMode;
    property Closed: Boolean read FClosed write FClosed;
    property FillMode: TPolyFillMode read FFillMode write FFillMode;

    property Normals: TArrayOfArrayOfFixedPoint read FNormals write FNormals;
    property Points: TArrayOfArrayOfFixedPoint read FPoints write FPoints;
  end;

  TBitmapPolygonFiller = class(TCustomPolygonFiller)
  private
    FPattern: TBitmap32;
    FOffsetY: Integer;
    FOffsetX: Integer;
  protected
    function GetFillLine: TFillLineEvent; override;
    procedure FillLineOpaque(Dst: PColor32; DstX, DstY, Length: Integer; AlphaValues: PColor32);
    procedure FillLineBlend(Dst: PColor32; DstX, DstY, Length: Integer; AlphaValues: PColor32);
    procedure FillLineBlendMasterAlpha(Dst: PColor32; DstX, DstY, Length: Integer; AlphaValues: PColor32);
    procedure FillLineCustomCombine(Dst: PColor32; DstX, DstY, Length: Integer; AlphaValues: PColor32);
  public
    property Pattern: TBitmap32 read FPattern write FPattern;
    property OffsetX: Integer read FOffsetX write FOffsetX;
    property OffsetY: Integer read FOffsetY write FOffsetY;
  end;


implementation

uses Math;

type
  TBitmap32Access = class(TBitmap32);
  TShiftFunc = function(Value: Integer): Integer;  // needed for antialiasing to speed things up
// These are for edge scan info. Note, that the most significant bit of the
// edge in a scan line is used for winding (edge direction) info.
  TScanLine = TArrayOfInteger;
  TScanLines = TArrayOfArrayOfInteger;
  PIntegerArray = ^TIntegerArray;
  TIntegerArray = array [0..0] of Integer;
  PFixedPointArray = ^TFixedPointArray;
  TFixedPointArray = array [0..0] of TFixedPoint;

const
  AA_LINES: Array[TAntialiasMode] of Integer = (32, 16, 8, 4, 2);
  AA_SHIFT: Array[TAntialiasMode] of Integer = (5, 4, 3, 2, 1);
  AA_MULTI: Array[TAntialiasMode] of Integer = (65, 273, 1167, 5460, 32662);
  AA_SAR:   Array[TAntialiasMode] of TShiftFunc = (SAR_11, SAR_12, SAR_13, SAR_14, SAR_15);

{ POLYLINES }

procedure PolylineTS(
  Bitmap: TBitmap32;
  const Points: TArrayOfFixedPoint;
  Color: TColor32;
  Closed: Boolean;
  Transformation: TTransformation);
var
  I, Count: Integer;
  DoAlpha: Boolean;
begin
  Count := Length(Points);

  if (Count = 1) and Closed then
    if Assigned(Transformation) then
      with Transformation.Transform(Points[0]) do
        Bitmap.SetPixelTS(FixedRound(X), FixedRound(Y), Color)
    else
      with Points[0] do
        Bitmap.SetPixelTS(FixedRound(X), FixedRound(Y), Color);

  if Count < 2 then Exit;
  DoAlpha := Color and $FF000000 <> $FF000000;
  Bitmap.BeginUpdate;
  Bitmap.PenColor := Color;

  If Assigned(Transformation) then
  begin
    with Transformation.Transform(Points[0]) do Bitmap.MoveTo(FixedRound(X), FixedRound(Y));
    if DoAlpha then
      for I := 1 to Count - 1 do
        with Transformation.Transform(Points[I]) do
          Bitmap.LineToTS(FixedRound(X), FixedRound(Y), not Closed and (I=Count-1))
    else
      for I := 1 to Count - 1 do
        with Transformation.Transform(Points[I]) do
          Bitmap.LineToS(FixedRound(X), FixedRound(Y), not Closed and (I=Count-1));

    if Closed then with Transformation.Transform(Points[0]) do
      if DoAlpha then
        Bitmap.LineToTS(FixedRound(X), FixedRound(Y))
      else
        Bitmap.LineToS(FixedRound(X), FixedRound(Y));
  end
  else
  begin
    with Points[0] do Bitmap.MoveTo(FixedRound(X), FixedRound(Y));
    if DoAlpha then
      for I := 1 to Count - 1 do
        with Points[I] do
          Bitmap.LineToTS(FixedRound(X), FixedRound(Y), not Closed and (I=Count-1))
    else
      for I := 1 to Count - 1 do
        with Points[I] do
          Bitmap.LineToS(FixedRound(X), FixedRound(Y), not Closed and (I=Count-1));

    if Closed then with Points[0] do
      if DoAlpha then
        Bitmap.LineToTS(FixedRound(X), FixedRound(Y))
      else
        Bitmap.LineToS(FixedRound(X), FixedRound(Y));
  end;

  Bitmap.EndUpdate;
  Bitmap.Changed;
end;

procedure PolylineAS(
  Bitmap: TBitmap32;
  const Points: TArrayOfFixedPoint;
  Color: TColor32;
  Closed: Boolean;
  Transformation: TTransformation);
var
  I, Count: Integer;
begin
  Count := Length(Points);
  if (Count = 1) and Closed then
    if Assigned(Transformation) then
      with Transformation.Transform(Points[0]) do
        Bitmap.SetPixelTS(FixedRound(X), FixedRound(Y), Color)
    else
      with Points[0] do
        Bitmap.SetPixelTS(FixedRound(X), FixedRound(Y), Color);

  if Count < 2 then Exit;
  Bitmap.BeginUpdate;
  Bitmap.PenColor := Color;

  If Assigned(Transformation) then
  begin
    with Transformation.Transform(Points[0]) do Bitmap.MoveTo(FixedRound(X), FixedRound(Y));
    for I := 1 to Count - 1 do
      with Transformation.Transform(Points[I]) do
        Bitmap.LineToAS(FixedRound(X), FixedRound(Y), not Closed and (I=Count-1));
    if Closed then with Transformation.Transform(Points[0]) do Bitmap.LineToAS(FixedRound(X), FixedRound(Y));
  end
  else
  begin
    with Points[0] do Bitmap.MoveTo(FixedRound(X), FixedRound(Y));
    for I := 1 to Count - 1 do
      with Points[I] do
        Bitmap.LineToAS(FixedRound(X), FixedRound(Y), not Closed and (I=Count-1));
    if Closed then with Points[0] do Bitmap.LineToAS(FixedRound(X), FixedRound(Y));
  end;

  Bitmap.EndUpdate;
  Bitmap.Changed;
end;

procedure PolylineXS(
  Bitmap: TBitmap32;
  const Points: TArrayOfFixedPoint;
  Color: TColor32;
  Closed: Boolean;
  Transformation: TTransformation);
var
  I, Count: Integer;
begin
  Count := Length(Points);
  if (Count = 1) and Closed then
    if Assigned(Transformation) then
      with Transformation.Transform(Points[0]) do Bitmap.PixelXS[X, Y] := Color
    else
      with Points[0] do Bitmap.PixelXS[X, Y] := Color;

  if Count < 2 then Exit;
  Bitmap.BeginUpdate;
  Bitmap.PenColor := Color;

  if Assigned(Transformation) then
  begin
    with Transformation.Transform(Points[0]) do Bitmap.MoveToX(X, Y);
    for I := 1 to Count - 1 do with Transformation.Transform(Points[I]) do Bitmap.LineToXS(X, Y, not Closed and (I=Count-1));
    if Closed then with Transformation.Transform(Points[0]) do Bitmap.LineToXS(X, Y);
  end
  else
  begin
    with Points[0] do Bitmap.MoveToX(X, Y);
    for I := 1 to Count - 1 do with Points[I] do Bitmap.LineToXS(X, Y, not Closed and (I=Count-1));
    if Closed then with Points[0] do Bitmap.LineToXS(X, Y);
  end;

  Bitmap.EndUpdate;
  Bitmap.Changed;
end;

procedure PolylineXSP(
  Bitmap: TBitmap32;
  const Points: TArrayOfFixedPoint;
  Closed: Boolean;
  Transformation: TTransformation);
var
  I, Count: Integer;
begin
  Count := Length(Points);
  if Count < 2 then Exit;
  Bitmap.BeginUpdate;
  if Assigned(Transformation) then
  begin
    with Transformation.Transform(Points[0]) do Bitmap.MoveToX(X, Y);
    for I := 1 to Count - 1 do with Transformation.Transform(Points[I]) do Bitmap.LineToXSP(X, Y, not Closed and (I=Count-1));
    if Closed then with Transformation.Transform(Points[0]) do Bitmap.LineToXSP(X, Y);
  end
  else
  begin
    with Points[0] do Bitmap.MoveToX(X, Y);
    for I := 1 to Count - 1 do with Points[I] do Bitmap.LineToXSP(X, Y, not Closed and (I=Count-1));
    if Closed then with Points[0] do Bitmap.LineToXSP(X, Y);
  end;

  Bitmap.EndUpdate;
  Bitmap.Changed;
end;

procedure PolyPolylineTS(
  Bitmap: TBitmap32;
  const Points: TArrayOfArrayOfFixedPoint;
  Color: TColor32;
  Closed: Boolean;
  Transformation: TTransformation);
var
  I: Integer;
begin
  for I := 0 to High(Points) do PolylineTS(Bitmap, Points[I], Color, Closed, Transformation);
end;

procedure PolyPolylineAS(
  Bitmap: TBitmap32;
  const Points: TArrayOfArrayOfFixedPoint;
  Color: TColor32;
  Closed: Boolean;
  Transformation: TTransformation);
var
  I: Integer;
begin
  for I := 0 to High(Points) do PolylineAS(Bitmap, Points[I], Color, Closed, Transformation);
end;

procedure PolyPolylineXS(
  Bitmap: TBitmap32;
  const Points: TArrayOfArrayOfFixedPoint;
  Color: TColor32;
  Closed: Boolean;
  Transformation: TTransformation);
var
  I: Integer;
begin
  for I := 0 to High(Points) do PolylineXS(Bitmap, Points[I], Color, Closed, Transformation);
end;

procedure PolyPolylineXSP(
  Bitmap: TBitmap32;