ezpolyclip.pas

很管用的GIS控件

Unit EzPolyClip;

{***********************************************************}
{     EzGIS/CAD Components                                  }
{   (c) 2003 EzSoft Engineering                             }
{         All Rights Reserved                               }
{***********************************************************}

{$I EZ_FLAG.PAS}
Interface

Uses
  Windows, Classes, ezbasegis, ezbase, ezlib;

Type

  {------------------------------------------------------------------------------}
  {                  Define TEzPolygonClipper                                    }
  {------------------------------------------------------------------------------}

  TEzPolygonClipper = Class( TComponent )
  Private
    FDrawBox: TEzBaseDrawBox;
    FClipOperation: TEzPolyClipOp;
    FClipping: TEzEntityList;
    FClipSubject: TEzEntityList;
    FClipResult: TEzEntityList;
    FHoles: TBits;
    Procedure SetDrawBox( Value: TEzBaseDrawBox );
    function GetAbout:TEzAbout;
    procedure SetAbout( const Value: TEzAbout );
  Protected
    Procedure Notification( AComponent: TComponent; Operation: TOperation ); Override;
  Public
    Constructor Create( AOwner: TComponent ); Override;
    Destructor Destroy; Override;
    Procedure Clear;
    Procedure Execute;
    Procedure ClipAgainstRectangle( Const Axmin, Aymin, Axmax, Aymax: double );

    Property ClipSubject: TEzEntityList Read FClipSubject;
    Property Clipping: TEzEntityList Read FClipping;
    Property ClipResult: TEzEntityList Read FClipResult;
    Property Holes: TBits Read FHoles;
  Published
    Property ClipOperation: TEzPolyClipOp Read FClipOperation Write FClipOperation;
    Property DrawBox: TEzBaseDrawBox Read FDrawBox Write SetDrawBox;
    Property About: TEzAbout read GetAbout write SetAbout;
  End;

Procedure PolygonClip( op: TEzPolyClipOp;
  subject, clipping, result: TEzEntityList; Holes: TBits );
//procedure tristripClip(vp: CustomDrawBox; op: TEzPolyClipOp; subject, clipping, result: TList);

Implementation

Uses
  ezSystem, ezconsts, EzEntities;

{ TEzPolygonClipper }

Constructor TEzPolygonClipper.Create( AOwner: TComponent );
Begin
  Inherited Create( AOwner );
  FClipSubject := TEzEntityList.Create;
  FClipResult := TEzEntityList.Create;
  FClipping := TEzEntityList.Create;
  FHoles := TBits.Create;
End;

Destructor TEzPolygonClipper.Destroy;
Begin
  FClipping.Free;
  FClipResult.free;
  FClipSubject.Free;
  FHoles.Free;
  Inherited Destroy;
End;

function TEzPolygonClipper.GetAbout:TEzAbout;
begin
  Result:= SEz_GisVersion;
end;

procedure TEzPolygonClipper.SetAbout( const Value: TEzAbout );
begin
end;

Procedure TEzPolygonClipper.SetDrawBox( Value: TEzBaseDrawBox );
Begin
{$IFDEF LEVEL5}
  if Assigned( FDrawBox ) then FDrawBox.RemoveFreeNotification( Self );
{$ENDIF}
  If Value <> Nil Then
    Value.FreeNotification( Self );
  FDrawBox := Value;
End;

Procedure TEzPolygonClipper.Notification( AComponent: TComponent; Operation: TOperation );
Begin
  Inherited Notification( AComponent, Operation );
  If ( Operation = opRemove ) And ( AComponent = FDrawBox ) Then
    FDrawBox := Nil;
End;

Procedure TEzPolygonClipper.Execute;
Var
  tempresult: TEzEntityList;
  tmpOp: TEzPolyClipOp;
  I: Integer;
Begin
  If FDrawBox = Nil Then
    MessageToUser( SUnconnectedDrawBox, smsgerror, MB_ICONERROR );
  If ( FClipping.Count = 0 ) Or ( FClipSubject.Count = 0 ) Then
    exit;
  FClipResult.Clear;
  tmpOP := FClipOperation;
  If FClipOperation = pcSPLIT Then
    tmpOp := pcDIFF;
  PolygonClip( tmpOp, FClipSubject, FClipping, FClipResult, FHoles );
  If FClipOperation = pcSPLIT Then
  Begin
    tempresult := TEzEntityList.Create;
    Try
      tmpOp := pcINT;
      polygonClip( tmpOp, clipping, FClipSubject, tempresult, FHoles );
      For I := 0 To tempresult.count - 1 Do
        FClipResult.Add( tempresult[i] );
    Finally
      tempresult.free;
    End;
  End;
End;

Procedure TEzPolygonClipper.ClipAgainstRectangle( Const Axmin, Aymin, Axmax, Aymax: double );
Var
  I: Integer;
  ent: TEzEntity;

  { polylines }
  VisPoints, cnt, n, K, Idx1, Idx2: Integer;
  TmpPt1, TmpPt2: TEzPoint;
  TmpPts: PEzPointArray;
  ClipRes: TEzClipCodes;
  Clip: TEzRect;
  { polygons }
  VisPoints1, TmpSize, MaxCount: Integer;
  FirstClipPts: PEzPointArray;
  PartCount: Integer;
  temp: TEzEntity;
Begin
  If FClipSubject.Count = 0 Then Exit;
  MaxCount := 0;
  For I := 0 To FClipSubject.Count - 1 Do
  Begin
    ent := TEzEntity( FClipSubject[I] );
    MaxCount := ezlib.IMax( MaxCount, ent.Points.Count );
  End;
  If MaxCount = 0 Then
    exit;
  Inc( MaxCount, 4 );

  TmpSize := ( MaxCount * sizeof( TEzPoint ) );

  GetMem( TmpPts, TmpSize );
  GetMem( FirstClipPts, TmpSize );

  Try
    FClipResult.clear;
    Clip := Rect2D( Axmin, Aymin, Axmax, Aymax );
    { clip this entity }
    For I := 0 To FClipSubject.Count - 1 Do
    Begin
      ent := TEzEntity( FClipSubject[I] );
      If ent.isclosed Then
      Begin
        If ent.points.Count = 0 Then
          Exit;
        If ent.points.Count = 2 Then
          continue;
        n := 0;
        K := 0;
        If ent.points.Parts.Count < 2 Then
        Begin
          Idx1 := 0;
          Idx2 := ent.points.Count - 1;
        End
        Else
        Begin
          Idx1 := ent.points.Parts[n];
          Idx2 := ent.points.Parts[n + 1] - 1;
        End;
        PartCount := 0;
        temp := TEzPolygon.CreateEntity( [Point2D( 0, 0 )] );
        temp.points.clear;
        Repeat
          //VisPoints  := 0;
          VisPoints1 := 0;
          If IsBoxFullInBox2D( ent.points.Extension, Clip ) Then
          Begin
            For cnt := Idx1 To Idx2 Do
              TmpPts[cnt - Idx1] := ent.points[cnt];
            VisPoints := ( Idx2 - Idx1 ) + 1;
          End
          Else
          Begin
            For cnt := Idx1 To Idx2 Do
            Begin
              TmpPt1 := ent.points[cnt];
              If cnt < Idx2 Then
                TmpPt2 := ent.points[cnt + 1]
              Else
                TmpPt2 := ent.Points[Idx1];
              ClipRes := ClipLineLeftRight2D( Clip, TmpPt1.X, TmpPt1.Y, TmpPt2.X, TmpPt2.Y );
              If Not ( ccNotVisible In ClipRes ) Then
              Begin
                FirstClipPts[VisPoints1] := TmpPt1;
                Inc( VisPoints1 );
              End;
              If ccSecond In ClipRes Then
              Begin
                FirstClipPts[VisPoints1] := TmpPt2;
                Inc( VisPoints1 );
              End;
            End;
            FirstClipPts[VisPoints1] := FirstClipPts[0];
            Inc( VisPoints1 );
            VisPoints := 0;
            For cnt := 0 To VisPoints1 - 2 Do
            Begin
              TmpPt1 := FirstClipPts[cnt];
              TmpPt2 := FirstClipPts[cnt + 1];
              ClipRes := ClipLineUpBottom2D( Clip, TmpPt1.X, TmpPt1.Y, TmpPt2.X, TmpPt2.Y );
              If Not ( ccNotVisible In ClipRes ) Then
              Begin
                TmpPts[VisPoints] := TmpPt1;
                Inc( VisPoints );
              End;
              If ccSecond In ClipRes Then
              Begin
                TmpPts[VisPoints] := TmpPt2;
                Inc( VisPoints );
              End;
            End;
          End;
          If VisPoints > 1 Then
          Begin
            Inc( PartCount );
            For cnt := 0 To VisPoints - 1 Do
              temp.points.add( TmpPts[cnt] );
            inc( K, vispoints );
            temp.points.parts.add( k );
          End;
          If ent.points.Parts.Count < 2 Then
            Break;
          Inc( n );
          If n >= ent.points.Parts.Count Then
            Break;
          Idx1 := ent.points.Parts[n];
          If n < ent.points.Parts.Count - 1 Then
            Idx2 := ent.points.Parts[n + 1] - 1
          Else
            Idx2 := ent.points.Count - 1;
        Until False;
        { create the polygon }
        If PartCount > 1 Then
          temp.points.parts.insert( 0, 0 )
        Else
          temp.points.parts.clear;
        FClipResult.Add( temp );
      End
      Else
      Begin
        If ent.points.Count = 0 Then
          Exit;
        n := 0;
        If ent.points.Parts.Count < 2 Then
        Begin
          Idx1 := 0;
          Idx2 := ent.points.Count - 1;
        End
        Else
        Begin
          Idx1 := ent.points.Parts[n];
          Idx2 := ent.points.Parts[n + 1] - 1;
        End;
        Repeat
          VisPoints := 0;
          If IsBoxFullInBox2D( ent.points.Extension, Clip ) Then
          Begin
            For cnt := Idx1 To Idx2 Do
              TmpPts[cnt - Idx1] := ent.Points[cnt];
            VisPoints := Succ( Idx2 - Idx1 );
          End
          Else
          Begin
            For cnt := Idx1 + 1 To Idx2 Do
            Begin
              TmpPt1 := ent.Points[cnt - 1];
              TmpPt2 := ent.Points[cnt];
              ClipRes := ClipLine2D( Clip, TmpPt1.X, TmpPt1.Y, TmpPt2.X, TmpPt2.Y );
              If Not ( ccNotVisible In ClipRes ) Then
              Begin
                TmpPts[VisPoints] := TmpPt1;
                Inc( VisPoints );
              End;
              If ccSecond In ClipRes Then
              Begin
                TmpPts[VisPoints] := TmpPt2;
                Inc( VisPoints );

                FClipResult.Add( TEzPolyLine.CreateEntity( Slice( TmpPts^, VisPoints ) ) );

                VisPoints := 0;
              End;
            End;
            If Not ( ccNotVisible In ClipRes ) Then
            Begin
              TmpPts[VisPoints] := TmpPt2;
              Inc( VisPoints );
            End;
          End;
          If VisPoints > 0 Then
            FClipResult.Add( TEzPolyLine.CreateEntity( Slice( TmpPts^, VisPoints ) ) );

          If ent.Points.Parts.Count < 2 Then
            Break;
          Inc( n );
          If n >= ent.Points.Parts.Count Then
            Break;
          Idx1 := ent.Points.Parts[n];
          If n < ent.Points.Parts.Count - 1 Then
            Idx2 := ent.Points.Parts[n + 1] - 1
          Else
            Idx2 := ent.Points.Count - 1;
        Until false;
      End;
    End;
  Finally
    FreeMem( TmpPts, TmpSize );
    FreeMem( FirstClipPts, TmpSize );
  End;
End;

Procedure TEzPolygonClipper.Clear;
Begin
  FClipResult.clear;
  FClipSubject.clear;
  FClipping.clear;
End;

{ main clipping procedures }

Const
  GPC_EPSILON = 0.000001;
  LEFT = 0;
  RIGHT = 1;

  ABOVE = 0;
  BELOW = 1;

  CLIP = 0;
  SUBJ = 1;

  //INVERT_TRISTRIPS = FALSE;

  DBL_MAX = 1E20;

Type

  PEzPointList = ^TEzPointList;
  TEzPointList = Record (* Vertex list structure             *)
    NumVertices: integer; (* Number of vertices in list        *)
    vertex: PEzPointArray; (* Vertex array pointer              *)
  End;

  TEzClipPolygon = Class
  Private
    FList: TList; // list of PEzPointList records
    Fhole: TList; // list of booleans
    Function GetItem( Index: Integer ): TEzPointList;
    Procedure SetItem( Index: Integer; Const Value: TEzPointList );
  Public
    Constructor Create;
    Destructor Destroy; Override;
    Function Add( Const Value: TEzPointList ): Integer;
    Function num_contours: integer; (* Number of contours in polygon *)
    Function num_strips: integer; (* Number of tristrips (if it is a)*)
    Procedure Clear;
    Procedure Delete( Index: Integer );
    Procedure Insert( Index: Integer; Const Value: TEzPointList );

    Property contour[Index: Integer]: TEzPointList Read GetItem Write SetItem;
    //property strip[Index: Integer]: TEzPointList read GetItem write SetItem;
    Property hole: TList Read Fhole; (* Hole / external contour flags *)
  End;

  //Tgpc_tristrip = class(TEzClipPolygon)
  //end;

  TVertexType = (* Edge intersection classes         *)
  ( vtNUL, (* Empty non-intersection            *)
    vtEMX, (* External maximum                  *)
    vtELI, (* External left intermediate        *)
    vtTED, (* Top edge                          *)
    vtERI, (* External right intermediate       *)
    vtRED, (* Right edge                        *)
    vtIMM, (* Internal maximum and minimum      *)
    vtIMN, (* Internal minimum                  *)
    vtEMN, (* External minimum                  *)
    vtEMM, (* External maximum and minimum      *)
    vtLED, (* Left edge                         *)
    vtILI, (* Internal left intermediate        *)
    vtBED, (* Bottom edge                       *)
    vtIRI, (* Internal right intermediate       *)
    vtIMX, (* Internal maximum                  *)
    vtFUL (* Full non-intersection             *)
    );

  THState = (* Horizontal edge states            *)
  ( hsNH, (* No horizontal edge                *)
    hsBH, (* Bottom horizontal edge            *)
    hsTH (* Top horizontal edge               *)
    );

  TBundleState = (* Edge bundle state                 *)
  ( bsUNBUNDLED, (* Isolated edge not within a bundle *)
    bsBUNDLE_HEAD, (* Bundle head node                  *)
    bsBUNDLE_TAIL (* Passive bundle tail node          *)
    );