gr32_polygons.pas

skin components for design of your applicastions

    MaxY := -$7FFFFFFF;
    MinY := $7FFFFFFF;
    If Assigned(Transformation) then
    begin
      for J := 0 to High(Points) do
      begin
        L := Length(Points[J]);
        SetLength(PP[J], L);
        for I := 0 to L - 1 do
          with Transformation.Transform(Points[J][I]) do
          begin
            PP[J][I].X := SAR_16(X + $00007FFF);
            PP[J][I].Y := SAR_16(Y + $00007FFF);
            if PP[J][I].Y < MinY then MinY := PP[J][I].Y;
            if PP[J][I].Y > MaxY then MaxY := PP[J][I].Y;
          end
      end
    end
    else
    begin
      for J := 0 to High(Points) do
      begin
        L := Length(Points[J]);
        SetLength(PP[J], L);
        for I := 0 to L - 1 do
          with Points[J][I] do
          begin
            PP[J][I].X := SAR_16(X + $00007FFF);
            PP[J][I].Y := SAR_16(Y + $00007FFF);
            if PP[J][I].Y < MinY then MinY := PP[J][I].Y;
            if PP[J][I].Y > MaxY then MaxY := PP[J][I].Y;
          end;
      end;
    end;

    MinY := Constrain(MinY, Bitmap.ClipRect.Top, Bitmap.ClipRect.Bottom);
    MaxY := Constrain(MaxY, Bitmap.ClipRect.Top, Bitmap.ClipRect.Bottom);
    if MinY >= MaxY then Exit;

    ShiftedLeft := Bitmap.ClipRect.Left shl 8;
    ShiftedRight := Bitmap.ClipRect.Right shl 8 - 1;
    ClipBottom := Bitmap.ClipRect.Bottom - 1;

    SetLength(ScanLines, MaxY - MinY + 1);
    for J := 0 to High(Points) do
      AddPolygon(PP[J], ShiftedLeft, MinY, ShiftedRight, ClipBottom, ScanLines, True);

    SortLines(ScanLines);
    Bitmap.BeginUpdate;
    try
      If Assigned(FillLineCallback) then
        CustomFillLines(Bitmap, MinY, ScanLines, FillLineCallback, Mode)
      else
        ColorFillLines(Bitmap, MinY, ScanLines, Color, Mode);
    finally
      Bitmap.EndUpdate;
    end;
  end;
  Bitmap.Changed(MakeRect(PolyPolygonBounds(Points), rrOutside));
end;

procedure PolyPolygonTS(Bitmap: TBitmap32;
  const Points: TArrayOfArrayOfFixedPoint; Color: TColor32; Mode: TPolyFillMode;
  Transformation: TTransformation);
begin
  RenderPolyPolygonTS(Bitmap, Points, Color, nil, Mode, Transformation);
end;

procedure PolyPolygonTS(Bitmap: TBitmap32;
  const Points: TArrayOfArrayOfFixedPoint; FillLineCallback: TFillLineEvent;
  Mode: TPolyFillMode; Transformation: TTransformation);
begin
  RenderPolyPolygonTS(Bitmap, Points, 0, FillLineCallback, Mode, Transformation);
end;

procedure PolyPolygonTS(Bitmap: TBitmap32;
  const Points: TArrayOfArrayOfFixedPoint; Filler: TCustomPolygonFiller;
  Mode: TPolyFillMode; Transformation: TTransformation);
begin
  RenderPolyPolygonTS(Bitmap, Points, 0, Filler.FillLine, Mode, Transformation);
end;

// only used internally to share code:
procedure RenderPolyPolygonXS(Bitmap: TBitmap32;
  const Points: TArrayOfArrayOfFixedPoint; Color: TColor32;
  FillLineCallback: TFillLineEvent; Mode: TPolyFillMode;
  const AAMode: TAntialiasMode; Transformation: TTransformation);
var
  L, I, J, MinY, MaxY: Integer;
  ScanLines: TScanLines;
  PP: TArrayOfArrayOfPoint;
  AAShift, AAClipLeft, AAClipTop, AAClipRight, AAClipBottom: Integer;
  AASAR: TShiftFunc;
begin
  if not Bitmap.MeasuringMode then
  begin
    AASAR := AA_SAR[AAMode];

    SetLength(PP, Length(Points));

    MaxY := -$7F000000;
    MinY := $7F000000;
    If Assigned(Transformation) then
    begin
      for J := 0 to High(Points) do
      begin
        L := Length(Points[J]);
        if L > 2 then
        begin
          SetLength(PP[J], L);
          for I := 0 to L - 1 do
            with Transformation.Transform(Points[J][I]) do
            begin
              PP[J][I].X := AASAR(X + $00007FF);
              PP[J][I].Y := AASAR(Y + $00007FF);
              if PP[J][I].Y < MinY then MinY := PP[J][I].Y;
              if PP[J][I].Y > MaxY then MaxY := PP[J][I].Y;
            end
        end
        else SetLength(PP[J], 0);
      end
    end
    else
    begin
      for J := 0 to High(Points) do
      begin
        L := Length(Points[J]);
        if L > 2 then
        begin
          SetLength(PP[J], L);
          for I := 0 to L - 1 do
            with Points[J][I] do
            begin
              PP[J][I].X := AASAR(X + $000007FF);
              PP[J][I].Y := AASAR(Y + $000007FF);
              if PP[J][I].Y < MinY then MinY := PP[J][I].Y;
              if PP[J][I].Y > MaxY then MaxY := PP[J][I].Y;
            end;
        end
        else SetLength(PP[J], 0);
      end;
    end;

    AAShift := AA_SHIFT[AAMode];
    AAClipLeft := Bitmap.ClipRect.Left shl AAShift;
    AAClipTop := Bitmap.ClipRect.Top shl AAShift;
    AAClipRight := Bitmap.ClipRect.Right shl AAShift - 1;
    AAClipBottom := Bitmap.ClipRect.Bottom shl AAShift - 1;

    MinY := Constrain(MinY, AAClipTop, AAClipBottom);
    MaxY := Constrain(MaxY, AAClipTop, AAClipBottom);
    if MinY >= MaxY then Exit;

    SetLength(ScanLines, MaxY - MinY + 1);
    for J := 0 to High(Points) do
      AddPolygon(PP[J], AAClipLeft, MinY, AAClipRight, AAClipBottom, ScanLines, False);

    SortLines(ScanLines);
    Bitmap.BeginUpdate;
    try
      If Assigned(FillLineCallback) then
        CustomFillLines2(Bitmap, MinY, ScanLines, FillLineCallback, Mode, AAMode)
      else
        ColorFillLines2(Bitmap, MinY, ScanLines, Color, Mode, AAMode);
    finally
      Bitmap.EndUpdate;
    end;
  end;
  Bitmap.Changed(MakeRect(PolyPolygonBounds(Points), rrOutside));
end;

procedure PolyPolygonXS(Bitmap: TBitmap32;
  const Points: TArrayOfArrayOfFixedPoint; Color: TColor32; Mode: TPolyFillMode;
  const AAMode: TAntialiasMode; Transformation: TTransformation);
begin
  RenderPolyPolygonXS(Bitmap, Points, Color, nil, Mode, AAMode, Transformation);
end;

procedure PolyPolygonXS(Bitmap: TBitmap32;
  const Points: TArrayOfArrayOfFixedPoint; FillLineCallback: TFillLineEvent;
  Mode: TPolyFillMode; const AAMode: TAntialiasMode;
  Transformation: TTransformation);
begin
  RenderPolyPolygonXS(Bitmap, Points, 0, FillLineCallback, Mode, AAMode, Transformation);
end;

procedure PolyPolygonXS(Bitmap: TBitmap32;
  const Points: TArrayOfArrayOfFixedPoint; Filler: TCustomPolygonFiller;
  Mode: TPolyFillMode; const AAMode: TAntialiasMode;
  Transformation: TTransformation);
begin
  RenderPolyPolygonXS(Bitmap, Points, 0, Filler.FillLine, Mode, AAMode, Transformation);
end;

{ helper routines }

function PolygonBounds(const Points: TArrayOfFixedPoint): TFixedRect;
var
  I, X, Y: Integer;
begin
  With Result do
  begin
    Left := $7f000000;
    Right := -$7f000000;
    Top := $7f000000;
    Bottom := -$7f000000;

    for I := 0 to High(Points) do
    begin
      X := Points[I].X;
      Y := Points[I].Y;

      if X < Left   then Left := X;
      if X > Right  then Right := X;
      if Y < Top    then Top := Y;
      if Y > Bottom then Bottom := Y;
    end;
  end;
end;

function PolyPolygonBounds(const Points: TArrayOfArrayOfFixedPoint): TFixedRect;
var
  I, J, X, Y: Integer;
begin
  With Result do
  begin
    Left := $7f000000;
    Right := -$7f000000;
    Top := $7f000000;
    Bottom := -$7f000000;

    for I := 0 to High(Points) do
      for J := 0 to High(Points[I]) do
      begin
        X := Points[I, J].X;
        Y := Points[I, J].Y;

        if X < Left   then Left := X;
        if X > Right  then Right := X;
        if Y < Top    then Top := Y;
        if Y > Bottom then Bottom := Y;
      end;
  end;
end;

function PtInPolygon(const Pt: TFixedPoint; const Points: TArrayOfFixedPoint): Boolean;
var
  I: Integer;
  iPt, jPt: PFixedPoint;
begin
  Result := False;
  iPt := @Points[0];
  jPt := @Points[High(Points)];
  for I := 0 to High(Points) do
  begin
    Result := Result xor (((Pt.Y >= iPt.Y) xor (Pt.Y >= jPt.Y)) and
      (Pt.X - iPt.X < MulDiv(jPt.X - iPt.X, Pt.Y - iPt.Y, jPt.Y - iPt.Y)));
    jPt := iPt;
    Inc(iPt);
  end;
end;

{ TPolygon32 }

procedure TPolygon32.Add(const P: TFixedPoint);
var
  H, L: Integer;
begin
  H := High(Points);
  L := Length(Points[H]);
  SetLength(Points[H], L + 1);
  Points[H][L] := P;
  Normals := nil;
end;

procedure TPolygon32.AddPoints(var First: TFixedPoint; Count: Integer);
var
  H, L, I: Integer;
begin
  H := High(Points);
  L := Length(Points[H]);
  SetLength(Points[H], L + Count);
  for I := 0 to Count - 1 do
    Points[H, L + I] := PFixedPointArray(@First)[I];
  Normals := nil;
end;

procedure TPolygon32.CopyPropertiesTo(Dst: TPolygon32);
begin
  Dst.Antialiased := Antialiased;
  Dst.AntialiasMode := AntialiasMode;
  Dst.Closed := Closed;
  Dst.FillMode := FillMode;
end;

procedure TPolygon32.AssignTo(Dst: TPersistent);
var
  DstPolygon: TPolygon32;
begin
  if Dst is TPolygon32 then
  begin
    DstPolygon := TPolygon32(Dst);
    CopyPropertiesTo(DstPolygon);
    DstPolygon.Normals := Copy(Normals);
    DstPolygon.Points := Copy(Points);
  end
  else
    inherited;
end;

function TPolygon32.GetBoundingRect: TFixedRect;
begin
  Result := PolyPolygonBounds(Points);
end;

procedure TPolygon32.BuildNormals;
var
  I, J, Count, NextI: Integer;
  dx, dy, f: Single;
begin
  if Length(Normals) <> 0 then Exit;
  SetLength(FNormals, Length(Points));

  for J := 0 to High(Points) do
  begin
    Count := Length(Points[J]);
    SetLength(Normals[J], Count);

    if Count = 0 then Continue;
    if Count = 1 then
    begin
      FillChar(Normals[J][0], SizeOf(TFixedPoint), 0);
      Continue;
    end;

    I := 0;
    NextI := 1;
    dx := 0;
    dy := 0;

    while I < Count do
    begin
      if Closed and (NextI >= Count) then NextI := 0;
      if NextI < Count then
      begin
        dx := (Points[J][NextI].X - Points[J][I].X) / $10000;
        dy := (Points[J][NextI].Y - Points[J][I].Y) / $10000;
      end;
      if (dx <> 0) or (dy <> 0) then
      begin
        f := 1 / Hypot(dx, dy);
        dx := dx * f;
        dy := dy * f;
      end;
      with Normals[J][I] do
      begin
        X := Fixed(dy);
        Y := Fixed(-dx);
      end;
      Inc(I);
      Inc(NextI);
    end;
  end;
end;

procedure TPolygon32.Clear;
begin
  Points := nil;
  Normals := nil;
  NewLine;
end;

function TPolygon32.ContainsPoint(const P: TFixedPoint): Boolean;
var
  I: Integer;
begin
  Result := False;
  for I := 0 to High(FPoints) do
    if PtInPolygon(P, FPoints[I]) then
    begin
      Result := True;
      Exit;
    end;
end;

constructor TPolygon32.Create;
begin
  inherited;
  FClosed := True;
  FAntialiasMode := DefaultAAMode;
  NewLine; // initiate a new contour
end;

destructor TPolygon32.Destroy;
begin
  Clear;
  inherited;
end;

procedure TPolygon32.Draw(Bitmap: TBitmap32; OutlineColor, FillColor: TColor32; Transformation: TTransformation);
begin
  Bitmap.BeginUpdate;

  if Antialiased then
  begin
    if (FillColor and $FF000000) <> 0 then
      PolyPolygonXS(Bitmap, Points, FillColor, FillMode, AntialiasMode, Transformation);
    if (OutlineColor and $FF000000) <> 0 then
      PolyPolylineXS(Bitmap, Points, OutlineColor, Closed, Transformation);
  end
  else
  begin
    if (FillColor and $FF000000) <> 0 then
      PolyPolygonTS(Bitmap, Points, FillColor, FillMode, Transformation);
    if (OutlineColor and $FF000000) <> 0 then
      PolyPolylineTS(Bitmap, Points, OutlineColor, Closed, Transformation);
  end;

  Bitmap.EndUpdate;
  //SAARIXX
  Bitmap.Changed(MakeRect(GetBoundingRect));
end;

procedure TPolygon32.Draw(Bitmap: TBitmap32; OutlineColor: TColor32;
  FillCallback: TFillLineEvent; Transformation: TTransformation);