ezlib.pas

很管用的GIS控件

              lb.lbHatch := Longint( Bitmap.Handle );
              Canvas.Brush.Handle := CreateBrushIndirect( lb );
              oldFillMode := Windows.GetPolyFillMode( Canvas.Handle );
              oldBkMode := Windows.GetBkMode( Canvas.Handle );
              Try
                Windows.SetPolyFillMode( Canvas.Handle, Alternate );
                Windows.SetBkMode( Canvas.Handle, TRANSPARENT );

                If Grapher.FParts.Count = 1 Then
                  Polygon( Canvas.Handle, Grapher.FDevicePoints.FPoints^,
                                       Grapher.FParts[0] )
                Else
                Begin
                  if Win32Platform = VER_PLATFORM_WIN32_NT then
                  Begin
                    {WinNT or Win2000}
                    PolyPolygon( Canvas.Handle, Grapher.FDevicePoints.FPoints^,
                       Grapher.FParts.FList.List^, Grapher.FParts.Count );
                  End Else
                    { Win95 or Win98 have problems handling PolyPolygon with a lot of parts }

                  Begin
                  End;
                End;
              Finally
                Windows.SetBkMode( Canvas.Handle, oldBkMode );
                Windows.SetPolyFillMode( Canvas.Handle, oldFillMode );
                SetBrushOrgEx( Canvas.Handle, PrevPt.X, PrevPt.Y, Nil );
              End;
            End;
{$ENDIF}
          End
          Else
          Begin
            { solid fill pattern }
            If APattern = 1 Then
            Begin
              Canvas.Brush.Style := bsSolid;
              Canvas.Brush.Color := AForeColor;
              If Grapher.FParts.Count = 1 Then
                Polygon( Canvas.Handle, Grapher.FDevicePoints.FPoints^, Grapher.FParts[0] )
              Else
              Begin
                SetPolyFillMode( Canvas.Handle, Alternate );
                if Win32Platform = VER_PLATFORM_WIN32_NT then
                begin
                  { WinNT or Win2000 }
                  PolyPolygon( Canvas.Handle, Grapher.FDevicePoints.FPoints^,
                    Grapher.FParts.FList.List^, Grapher.FParts.Count );
                end else
                begin
                  { Win95 or Win98 - these have problems with a lot of entities and parts.
                    We don't know what the limit it is }
                  Idx1:= 0;
                  for cnt:= 0 to Grapher.FParts.Count-1 do
                  begin
                    pointarr := @Grapher.FDevicePoints.FPoints^[Idx1];
                    n := Grapher.FParts[cnt];
                    Polygon( Canvas.Handle, pointarr^, n );
                    Inc(Idx1, n );
                  end;
                end;
              End;
            //End
            //Else If ( APattern >= 2 ) And ( ( APattern - 2 ) <= Ez_Hatches.Count - 1 ) Then
            //Begin
              { a hatch pattern is drawed on .DrawHatch method }
            End;
          End;

          { follows the line drawing section }
          If AStyle = 0 Then Exit;
          If ( DrawMode <> dmRubberPen ) And ( AStyle > Succ(MAX_LINETYPES) ) Then
          Begin
            DrawWithLineStyle( Canvas, Clip, Grapher, PenStyle, M, DrawMode );
            Exit;
          End;
          DrawOpened( Canvas, Clip, Extent, Grapher, PenStyle, M, DrawMode );
{$IFDEF FALSE}
          Canvas.Brush.Style := bsClear;
          Canvas.Pen.Style := psSolid;
          if AStyle = 1 then
          begin
            If AScale = 0 Then
              Canvas.Pen.Width := 1
            Else
              Canvas.Pen.Width := IMax( 1, Grapher.RealToDistY( AScale ) );
            Canvas.Pen.Color := ALineColor;
            IsFullInside := True;
            For cnt := 0 To Grapher.FParts.Count - 1 Do
              If Not Grapher.FIsFullInside[cnt] Then
              Begin
                IsFullInside := False;
                Break;
              End;
            If IsFullInside Or ( Canvas.Pen.Width = 1 ) Then
            Begin
              If Grapher.FParts.Count = 1 Then
                Polygon( Canvas.Handle, Grapher.FDevicePoints.FPoints^, Grapher.FParts[0] )
              Else If Grapher.FParts.Count > 1 Then
              Begin
                if Win32Platform = VER_PLATFORM_WIN32_NT then
                begin
                  { WinXP, Win2000 or WinNT }
                  PolyPolygon( Canvas.Handle, Grapher.FDevicePoints.FPoints^,
                    Grapher.FParts.FList.List^, Grapher.FParts.Count );
                end else
                begin
                  { Win95 or Win98 }
                  Idx1:= 0;
                  for cnt:= 0 to Grapher.FParts.Count-1 do
                  begin
                    pointarr := @Grapher.FDevicePoints.FPoints^[Idx1];
                    n := Grapher.FParts[cnt];
                    Polygon( Canvas.Handle, pointarr^, n );
                    Inc(Idx1, n );
                  end;
                end;
              End;
            End
            Else
              clipLiangBarsky( Canvas, Clip, Grapher, M, Nil );
          end else if ( AStyle >= 2 ) and ( AStyle <= Succ(MAX_LINETYPES) ) then
          begin
            Canvas.Pen.Width:= 1;
            EzLineDraw.PolyDDA( Grapher.FDevicePoints.FPoints^,
              PIntegerArray(Grapher.FParts.FList.List)^, Grapher.FParts.Count,
              Canvas, Grapher, Pred(AStyle), ALineColor, 1 );
          end;
{$ENDIF}
        End;
      dmRubberPen:
        Begin
          //DrawOpened( Canvas, Clip, Extent, Grapher, PenStyle, M, DrawMode );
{.$IFDEF FALSE}
          If Grapher.FParts.Count = 1 Then
            Polygon( Canvas.Handle, Grapher.FDevicePoints.FPoints^, Grapher.FParts[0] )
          Else
          Begin
            //SetPolyFillMode(Canvas.Handle, Alternate);
            if Win32Platform = VER_PLATFORM_WIN32_NT then
            begin
              { WinNT or Win2000 }
              PolyPolygon( Canvas.Handle, Grapher.FDevicePoints.FPoints^,
                Grapher.FParts.FList.List^, Grapher.FParts.Count );
            end else
            begin
              { Win95 or Win98 }
              Idx1:= 0;
              for cnt:= 0 to Grapher.FParts.Count-1 do
              begin
                pointarr := @Grapher.FDevicePoints.FPoints^[Idx1];
                n := Grapher.FParts[cnt];
                Polygon( Canvas.Handle, pointarr^, n );
                Inc(Idx1, n );
              end;
            end;
          End;
{.$ENDIF}
        End;
    End;
  Finally
    // Free Optimizer memory
    If Not OptimizerWasOn then
    Begin
      Grapher.EndOptimizer;
    End;
  End;
End;

Procedure TEzVector.DrawOpened( Canvas: TCanvas;
                                Const Clip, Extent: TEzRect;
                                Grapher: TEzGrapher;
                                Const PenStyle: TEzPenStyle;
                                Const M: TEzMatrix;
                                DrawMode: TEzDrawMode );
Var
  cnt, n, Idx1, Idx2: Integer;
  TmpPt1, TmpPt2: TEzPoint;
  ClipRes: TEzClipCodes;
  IsIdentMatrix: Boolean;
  AScale: Integer;
  OptimizerWasOn: Boolean;

  Procedure DrawPolyline;
  Var
    //AScale: Double;
    ALineColor: TColor;
    I: integer;
    Parts: Array[0..0] Of Integer;
  Begin
    If Grapher.FVisiblePoints.Count < 2 Then
    Begin
      Grapher.FVisiblePoints.Clear;
      Grapher.FDevicePoints.Clear;
      Exit;
    End;
    For I := 0 To Grapher.FVisiblePoints.Count - 1 Do
      Grapher.FDevicePoints.Add( Grapher.RealToPoint( Grapher.FVisiblePoints[I] ) );
    Case DrawMode Of
      dmSelection:
        With Ez_Preferences.SelectionPen.FPenStyle Do
        Begin
          ALineColor := Color;
          //AScale:= Scale;//Grapher.getrealsize(Scale);
        End;
      dmNormal:
        With PenStyle Do
        Begin
          ALineColor := Color;
          //AScale:= Scale;
        End;
    Else
      Begin
        ALineColor := clBlack;
        //AScale:= 0;
      End;
    End;
    If Not ( DrawMode = dmRubberPen ) Then
    Begin
      Canvas.Pen.Style := psSolid;
      Canvas.Pen.Color := ALineColor;
    End;
    Case DrawMode Of
      dmRubberPen:
        Begin
          Polyline( Canvas.Handle, Grapher.FDevicePoints.FPoints^, Grapher.FDevicePoints.Count );
        End;
      dmSelection, dmNormal:
        Begin
          if PenStyle.Style = 1 then
          begin
            Canvas.Pen.Width := AScale;
            Polyline( Canvas.Handle, Grapher.FDevicePoints.FPoints^, Grapher.FDevicePoints.Count );
          end else if ( PenStyle.Style >= 2 ) and ( PenStyle.Style <= Succ(MAX_LINETYPES) ) then
          begin
            Canvas.Pen.Width:= 1;
            Parts[0]:= Grapher.FDevicePoints.Count;
            PolyDDA( Grapher.FDevicePoints.FPoints^, Parts, 1, Canvas, Grapher,
                     Pred(PenStyle.Style), ALineColor, 1 );

          end;
        End;
    End;
    Grapher.FVisiblePoints.Clear;
    Grapher.FDevicePoints.Clear;
  End;

Begin
  If (FCount < 2) Or ((DrawMode <> dmRubberPen) And (PenStyle.Style <= 0)) Then Exit;

  If (DrawMode <> dmRubberPen ) And (PenStyle.Style > Succ(MAX_LINETYPES)) Then
  Begin
    DrawWithLineStyle(Canvas, Clip, Grapher, PenStyle, M, DrawMode);
    Exit;
  End;

  n := 0;
  If FParts.Count < 2 Then
  Begin
    Idx1 := 0;
    Idx2 := FCount - 1;
  End
  Else
  Begin
    Idx1 := FParts[n];
    Idx2 := FParts[n + 1] - 1;
  End;

  OptimizerWasOn:= Grapher.FInOptimizer;
  If Not OptimizerWasOn then
  Begin
    Grapher.BeginOptimizer( FCount+4, FParts.Count+4 );
  End;
  Grapher.ClearOptimizer;

  AScale:= 1;
  case DrawMode of
    dmNormal:
      if PenStyle.Style = 1 then
        AScale:= IMax( 1, Grapher.RealToDistY( PenStyle.Width ) );
    dmSelection:
      if Ez_Preferences.SelectionPen.FPenStyle.Style = 1 then
        AScale:= IMax( 1, Grapher.RealToDistY( Ez_Preferences.SelectionPen.FPenStyle.Width ) );
  end;

  Try
    IsIdentMatrix := CompareMem( @M, @IDENTITY_MATRIX2D, SizeOf( TEzMatrix ) );
    Repeat
      If IsBoxFullInBox2D( Extent, Clip ) Then
      Begin
        If IsIdentMatrix Then
        Begin
          For cnt := Idx1 To Idx2 Do
            Grapher.FVisiblePoints.Add( FPoints^[cnt] );
        End
        Else
        Begin
          For cnt := Idx1 To Idx2 Do
            Grapher.FVisiblePoints.Add( TransformPoint2D( FPoints^[cnt], M ) );
        End;
      End
      Else
      Begin
        For cnt := Idx1 + 1 To Idx2 Do
        Begin
          If IsIdentMatrix Then
          Begin
            TmpPt1 := FPoints^[cnt - 1];
            TmpPt2 := FPoints^[cnt];
          End
          Else
          Begin
            TmpPt1 := TransformPoint2D( FPoints^[cnt - 1], M );
            TmpPt2 := TransformPoint2D( FPoints^[cnt], M );
          End;
          ClipRes := ClipLine2D( Clip, TmpPt1.X, TmpPt1.Y, TmpPt2.X, TmpPt2.Y );
          If Not ( ccNotVisible In ClipRes ) Then
          Begin
            Grapher.FVisiblePoints.Add( TmpPt1 );
          End;
          If ccSecond In ClipRes Then
          Begin
            Grapher.FVisiblePoints.Add( TmpPt2 );

            DrawPolyline;
          End;
        End;
        If Not ( ccNotVisible In ClipRes ) Then
        Begin
          Grapher.FVisiblePoints.Add( TmpPt2 );
        End;
      End;
      If Grapher.FVisiblePoints.Count > 0 Then
        DrawPolyline;

      If FParts.Count < 2 Then Break;

      Inc( n );
      If n >= FParts.Count Then Break;

      Idx1 := FParts[n];
      If n < FParts.Count - 1 Then
        Idx2 := FParts[n + 1] - 1
      Else
        Idx2 := FCount - 1;

    Until false;
  Finally
    //Free Optimizer Memory
    If Not OptimizerWasOn then
    Begin
      Grapher.EndOptimizer;
    End;
  End;
End;

Procedure TEzVector.clipLiangBarsky( Canvas: TCanvas;
                                     Const clipArea: TEzRect;
                                     Grapher: TEzGrapher;
                                     Const Matrix: TEzMatrix;
                                     ResultVector: TEzVector );
Var
  i, n, Idx1, Idx2: integer;

  Procedure clipLine( p1, p2: TEzPoint );
  Var
    u1, u2, dx, dy: Double;
    dp1, dp2: TPoint;
    visible: boolean;

    Function clipTest( Const p, q: Double; Var u1, u2: Double ): boolean;
    Var
      r: Double;
    Begin
      result := true;
      If p < 0.0 Then
      Begin
        r := q / p;
        If r > u2 Then
          result := false
        Else If r > u1 Then
          u1 := r;
      End
      Else If p > 0.0 Then
      Begin
        r := q / p;
        If r < u1 Then
          result := false
        Else If r < u2 Then
          u2 := r;
      End
      Else If q < 0.0 Then
        result := false;
    End;

  Begin
    u1 := 0.0;
    u2 := 1.0;
    dx := p2.x - p1.x;
    visible := false;
    If clipTest( -dx, p1.x - clipArea.Emin.x, u1, u2 ) Then
      If clipTest( dx, clipArea.Emax.x - p1.x, u1, u2 ) Then
      Begin
        dy := p2.y - p1.y;
        If clipTest( -dy, p1.y - clipArea.Emin.y, u1, u2 ) Then
          If clipTest( dy, clipArea.Emax.y - p1.y, u1, u2 ) Then
          Begin
            If u1 > 0.0 Then
            Begin
              p1.x := p1.x + u1 * dx;
              p1.y := p1.y + u1 * dy;
            End;
            If u2 < 1.0 Then
            Begin
              p2.x := p1.x + u2 * dx;
              p2.y := p1.y + u2 * dy;
            End;