ezpolyclip.pas

很管用的GIS控件

  PVertexNode = ^TVertexNode;
  TVertexNode = Record (* Internal vertex list datatype     *)
    x: double; (* X coordinate component            *)
    y: double; (* Y coordinate component            *)
    next: PVertexNode; (* Pointer to next vertex in list    *)
  End;

  PPolygonNode = ^TPolygonNode;
  TPolygonNode = Record (* Internal contour / tristrip type  *)
    active: integer; (* Active flag / vertex count        *)
    hole: boolean; (* Hole / external contour flag      *)
    v: Array[0..1] Of PVertexNode; (* Left and right vertex list ptrs   *)
    next: PPolygonNode; (* Pointer to next polygon contour   *)
    proxy: PPolygonNode; (* Pointer to actual structure used  *)
  End;

  PEdgeNode = ^TEdgeNode;
  TEdgeNode = Record
    vertex: TEzPoint; (* Piggy-backed contour vertex data  *)
    bot: TEzPoint; (* Edge lower (x, y) coordinate      *)
    top: TEzPoint; (* Edge upper (x, y) coordinate      *)
    xb: double; (* Scanbeam bottom x coordinate      *)
    xt: double; (* Scanbeam top x coordinate         *)
    dx: double; (* Change in x for a unit y increase *)
    istype: integer; (* Clip / subject edge flag          *)
    bundle: Array[0..1, 0..1] Of integer; (* Bundle edge flags                 *)
    bside: Array[0..1] Of integer; (* Bundle left / right indicators    *)
    bstate: Array[0..1] Of TBundleState; (* Edge bundle state                 *)
    outp: Array[0..1] Of PPolygonNode; (* Output polygon / tristrip pointer *)
    prev: PEdgeNode; (* Previous edge in the AET          *)
    next: PEdgeNode; (* Next edge in the AET              *)
    pred: PEdgeNode; (* Edge connected at the lower end   *)
    succ: PEdgeNode; (* Edge connected at the upper end   *)
    next_bound: PEdgeNode; (* Pointer to next bound in LMT      *)
  End;

  PEdgeNodeArray = ^TEdgeNodeArray;
  TEdgeNodeArray = Array[0..0] Of TEdgeNode;

  PLMTNode = ^TLMTNode;
  TLMTNode = Record (* Local minima table                *)
    y: double; (* Y coordinate at local minimum     *)
    first_bound: PEdgeNode; (* Pointer to bound list             *)
    next: PLMTNode; (* Pointer to next local minimum     *)
  End;

  PSBTree = ^TSBTree;
  TSBTree = Record (* Scanbeam tree                     *)
    y: double; (* Scanbeam node y value             *)
    less: PSBTree; (* Pointer to nodes with lower y     *)
    more: PSBTree; (* Pointer to nodes with higher y    *)
  End;

  PITNode = ^TITNode;
  TITNode = Record (* Intersection table                *)
    ie: Array[0..1] Of PEdgeNode; (* Intersecting edge (bundle) pair   *)
    point: TEzPoint; (* Point of intersection             *)
    next: PITNode; (* The next intersection table node  *)
  End;

  PStNode = ^TStNode;
  TStNode = Record (* Sorted edge table                 *)
    edge: PEdgeNode; (* Pointer to AET edge               *)
    xb: double; (* Scanbeam bottom x coordinate      *)
    xt: double; (* Scanbeam top x coordinate         *)
    dx: double; (* Change in x for a unit y increase *)
    prev: PStNode; (* Previous edge in sorted list      *)
  End;

  (* Horizontal edge state transitions within scanbeam boundary *)
Const
  next_hstate: Array[0..2, 0..5] Of THState = (
    (*   ABOVE     BELOW     CROSS *)
    (*   L   R     L   R     L   R *)
    ( hsBH, hsTH, hsTH, hsBH, hsNH, hsNH ),
    ( hsNH, hsNH, hsNH, hsNH, hsTH, hsTH ),
    ( hsNH, hsNH, hsNH, hsNH, hsBH, hsBH )
    );
  {*)}

Constructor TEzClipPolygon.Create;
Begin
  Inherited Create;
  FList := TList.Create;
  Fhole := TList.Create;
End;

Destructor TEzClipPolygon.destroy;
Begin
  Clear;
  FList.free;
  Fhole.Free;
  Inherited destroy;
End;

Function TEzClipPolygon.num_contours: Integer;
Begin
  Result := FList.Count;
End;

Function TEzClipPolygon.num_strips: integer;
Begin
  Result := FList.Count;
End;

Function TEzClipPolygon.GetItem( Index: Integer ): TEzPointList;
Begin
  If ( Index < 0 ) Or ( Index > FList.Count - 1 ) Then
    Exit;
  Result := PEzPointList( FList.Items[Index] )^;
End;

Procedure TEzClipPolygon.SetItem( Index: Integer; Const Value: TEzPointList );
Begin
  If ( Index < 0 ) Or ( Index > FList.Count - 1 ) Then
    Exit;
  PEzPointList( FList.Items[Index] )^ := Value;
End;

Procedure TEzClipPolygon.Insert( Index: Integer; Const Value: TEzPointList );
Var
  P: PEzPointList;
Begin
  New( P ); { Allocate Memory}
  P^ := Value;
  FList.Insert( Index, P ); { Insert onto Internal List }
  Fhole.Insert( Index, Pointer( 0 ) );
End;

Function TEzClipPolygon.Add( Const Value: TEzPointList ): Integer;
Begin
  Result := num_contours;
  Insert( FList.Count, Value );
End;

Procedure TEzClipPolygon.Clear;
Var
  I: Integer;
Begin
  For I := 0 To Pred( FList.Count ) Do
    Delete( 0 );
  FList.Clear;
  Fhole.Clear;
End;

Procedure TEzClipPolygon.Delete( Index: Integer );
Var
  v: PEzPointList;
Begin
  If ( Index < 0 ) Or ( Index > FList.Count - 1 ) Then
    Exit;
  v := PEzPointList( FList.Items[Index] );
  FreeMem( v.vertex, v.NumVertices * sizeof( TEzPoint ) );
  Dispose( v );
  FList.Delete( Index );
  Fhole.Delete( Index );
End;
//-----------------------------------------------------------------------

Function EQ( Const a, b: Double ): Boolean;
Begin
  Result := ( abs( a - b ) <= GPC_EPSILON );
End;

Function PREV_INDEX( i, n: Integer ): Integer;
Begin
  Result := ( i - 1 + n ) Mod n;
End;

Function NEXT_INDEX( i, n: Integer ): Integer;
Begin
  Result := ( i + 1 ) Mod n;
End;

Function OPTIMAL( v: PEzPointArray; i, n: Integer ): Boolean;
Begin
  Result := ( ( v[PREV_INDEX( i, n )].y <> v[i].y ) Or
    ( v[NEXT_INDEX( i, n )].y <> v[i].y ) );
End;

Function FWD_MIN( v: PEdgeNodeArray; i, n: integer ): boolean;
Begin
  Result := ( ( v[PREV_INDEX( i, n )].vertex.y >= v[i].vertex.y )
    And ( v[NEXT_INDEX( i, n )].vertex.y > v[i].vertex.y ) );
End;

Function NOT_FMAX( v: PEdgeNodeArray; i, n: integer ): boolean;
Begin
  Result := ( v[NEXT_INDEX( i, n )].vertex.y > v[i].vertex.y );
End;

Function REV_MIN( v: PEdgeNodeArray; i, n: integer ): boolean;
Begin
  Result := ( ( v[PREV_INDEX( i, n )].vertex.y > v[i].vertex.y )
    And ( v[NEXT_INDEX( i, n )].vertex.y >= v[i].vertex.y ) );
End;

Function NOT_RMAX( v: PEdgeNodeArray; i, n: integer ): boolean;
Begin
  Result := ( v[PREV_INDEX( i, n )].vertex.y > v[i].vertex.y );
End;

Procedure add_vertex( Var t: PVertexNode; Const x, y: double );
Begin
  If t = Nil Then
  Begin
    New( t );
    t.x := x;
    t.y := y;
    t.next := Nil;
  End
  Else
    (* Head further down the list *)
    add_vertex( t.next, x, y );
End;

Procedure VERTEX( e: PEdgeNode; p, s: integer; Const x, y: double );
Begin
  add_vertex( e.outp[p].v[s], x, y );
  Inc( e.outp[p].active );
End;

Procedure P_EDGE( Var d: PEdgeNode; e: PEdgeNode; p: integer; Var i: double; const j: double );
Begin
  d := e;
  Repeat
    d := d.prev;
  Until d.outp[p] <> Nil;
  i := d.bot.x + d.dx * ( j - d.bot.y );
End;

Procedure N_EDGE( Var d: PEdgeNode; e: PEdgeNode; p: integer;
  Var i: double; const j: Double );
Begin
  d := e;
  Repeat
    d := d.next;
  Until d.outp[p] <> Nil;
  i := d.bot.x + d.dx * ( j - d.bot.y );
End;

Procedure reset_it( Var it: PITNode );
Var
  itn: PITNode;
Begin
  While it <> Nil Do
  Begin
    itn := it.next;
    Dispose( it );
    it := Nil;
    it := itn;
  End;
End;

Procedure reset_lmt( Var lmt: PLMTNode );
Var
  lmtn: PLMTNode;
Begin
  While lmt <> Nil Do
  Begin
    lmtn := lmt.next;
    Dispose( lmt );
    lmt := Nil;
    lmt := lmtn;
  End;
End;

Procedure insert_bound( Var b: PEdgeNode; e: PEdgeNode );
Var
  existing_bound: PEdgeNode;
Begin
  If b = Nil Then
    (* Link node e to the tail of the list *)
    b := e
  Else
  Begin
    (* Do primary sort on the x field *)
    If e.bot.x < b.bot.x Then
    Begin
      (* Insert a new node mid-list *)
      existing_bound := b;
      b := e;
      b.next_bound := existing_bound;
    End
    Else
    Begin
      If e.bot.x = b.bot.x Then
      Begin
        (* Do secondary sort on the dx field *)
        If e.dx < b.dx Then
        Begin
          (* Insert a new node mid-list *)
          existing_bound := b;
          b := e;
          b.next_bound := existing_bound;
        End
        Else
        Begin
          (* Head further down the list *)
          insert_bound( b.next_bound, e );
        End;
      End
      Else
      Begin
        (* Head further down the list *)
        insert_bound( b.next_bound, e );
      End;
    End;
  End;
End;

Function bound_list( Var lmt: PLMTNode; Const y: double ): Pointer;
Var
  existing_node: PLMTNode;
Begin
  If lmt = Nil Then
  Begin
    (* Add node onto the tail end of the LMT *)
    New( lmt );
    fillchar( lmt^, sizeof( TLMTNode ), 0 );
    lmt.y := y;
    lmt.first_bound := Nil;
    lmt.next := Nil;
    result := @lmt.first_bound;
  End
  Else
  Begin
    If y < lmt.y Then
    Begin
      (* Insert a new LMT node before the current node *)
      existing_node := lmt;
      New( lmt );
      FillChar( lmt^, sizeof( TLMTNode ), 0 );
      lmt.y := y;
      lmt.first_bound := Nil;
      lmt.next := existing_node;
      result := @lmt.first_bound;
    End
    Else
    Begin
      If y > lmt.y Then
        (* Head further up the LMT *)
        result := bound_list( lmt.next, y )
      Else
        (* Head further up the LMT *)
        result := @lmt.first_bound;
    End;
  End;
End;

Procedure add_to_sbtree( Var entries: integer; Var sbtree: PSBTree; Const y: double );
Begin
  If sbtree = Nil Then
  Begin
    (* Add a new tree node here *)
    New( sbtree );
    FillChar( sbtree^, sizeof( TSBTree ), 0 );
    sbtree.y := y;
    sbtree.less := Nil;
    sbtree.more := Nil;
    Inc( entries );
  End
  Else
  Begin
    If sbtree.y > y Then
    Begin
      (* Head into the 'less' sub-tree *)
      add_to_sbtree( entries, sbtree.less, y );
    End
    Else
    Begin
      If sbtree.y < y Then
      Begin
        (* Head into the 'more' sub-tree *)
        add_to_sbtree( entries, sbtree.more, y );
      End;
    End;
  End;
End;

Procedure build_sbt( Var entries: integer; sbt: PDoubleArray; sbtree: PSBTree );
Begin
  If sbtree.less <> Nil Then
    build_sbt( entries, sbt, sbtree.less );
  sbt[entries] := sbtree.y;
  Inc( entries );
  If sbtree.more <> Nil Then
    build_sbt( entries, sbt, sbtree.more );
End;

Procedure free_sbtree( Var sbtree: PSBTree );
Begin
  If sbtree <> Nil Then
  Begin
    free_sbtree( sbtree.less );
    free_sbtree( sbtree.more );
    Dispose( sbtree );
    sbtree := Nil;
  End;
End;

Function count_optimal_vertices( Const c: TEzPointList ): integer;
Var
  i: integer;
Begin
  result := 0;

  (* Ignore non-contributing contours *)
  If c.NumVertices > 0 Then
  Begin
    For i := 0 To c.NumVertices - 1 Do
      (* Ignore superfluous vertices embedded in horizontal edges *)
      If OPTIMAL( c.vertex, i, c.NumVertices ) Then
        Inc( result );
  End;
End;

Function build_lmt( Var lmt: PLMTNode; Var sbtree: PSBTree;
  Var sbt_entries: integer; p: TEzClipPolygon; istype: integer;
  op: TEzPolyClipOp ): PEdgeNodeArray;
Var
  total_vertices: integer;
  e_index: integer;
  c, i, min, max, num_edges, v, NumVertices: integer;
  e, edge_table: PEdgeNodeArray;
  tmp_node: pointer;
  temp: TEzPointList;
Begin
  total_vertices := 0;
  e_index := 0;