ezlib.pas

很管用的GIS控件

Procedure TEzVector.Insert( Index: Integer; Const Item: TEzPoint );
Var
  I, n, Idx1, Idx2: Integer;
  TmpBool: Boolean;
  TmpInt: Integer;
  TmpList: TIntegerList;
Begin
  If ( Index < 0 ) Or ( Index >= FCount ) Then
    EzGISError( SVectorOutOfBound );
  TmpBool := FDisableEvents;
  FDisableEvents := True;
  Try
    { Reindex the parts first }
    If FParts.Count > 1 Then
    Begin
      TmpList := TIntegerList.Create;
      Try
        n := 0;
        Idx1 := FParts[n];
        Idx2 := FParts[n + 1] - 1;
        Repeat
          For i := Idx1 To Idx2 Do
            TmpList.Add( n );
          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;
        { Insert on same part }
        i := Index - 1;
        If i < 0 Then
          i := 0;
        TmpInt := TmpList[i];
        TmpList.Insert( Index, TmpInt );

        TmpList.Reindex;

        FParts.Count:= 0;
        FParts.Add( 0 );
        n := TmpList[0];
        I := 1;
        While I <= TmpList.Count - 1 Do
        Begin
          If n <> TmpList[I] Then
          Begin
            FParts.Add( I );
            n := TmpList[I];
          End;
          Inc( I );
        End;
        If FParts.Count < 2 Then
          FParts.Clear;
      Finally
        TmpList.Free;
      End;
    End;

    { Now, make the space for the new item }
    Add( Item );
    { Insert the item }
    For I := FCount - 1 Downto Index + 1 Do
      FPoints^[I] := FPoints^[I - 1];
    FPoints^[Index] := Item;
  Finally
    FDisableEvents := TmpBool;
  End;
  If Not FDisableEvents And Assigned( FOnChange ) Then
    FOnChange;
End;

procedure OutOfResources;
begin
  raise EOutOfResources.Create(SOutOfResources);
end;

procedure GDIError;
var
  ErrorCode: Integer;
  Buf: array [Byte] of Char;
begin
  ErrorCode := GetLastError;
  if (ErrorCode <> 0) and (FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, nil,
    ErrorCode, LOCALE_USER_DEFAULT, Buf, sizeof(Buf), nil) <> 0) then
    raise EOutOfResources.Create(Buf)
  else
    OutOfResources;
end;

Function GDICheck( Value: Integer ): Integer;
Begin
  if Value = 0 then GDIError;
  Result := Value;
End;

Procedure TEzVector.DrawWithLineStyle( Canvas: TCanvas;
                                       Const Clip: TEzRect;
                                       Grapher: TEzGrapher;
                                       Const PenStyle: TEzPenStyle;
                                       Const M: TEzMatrix;
                                       DrawMode: TEzDrawMode );
Var
  TmpPenStyle: TEzPenStyle;
  Style: Integer;
Begin
  If Ez_Linetypes.Count = 0 Then Exit;
  Style := PenStyle.Style - MAX_LINETYPES - 2;
  If Style >= Ez_Linetypes.Count - 1 Then Style := 0;
  TmpPenStyle := PenStyle;
  TmpPenStyle.Style := 1;
  Ez_Linetypes[Style].DrawVector( Self, TmpPenStyle, Grapher, Canvas, Clip, M, DrawMode );
End;

Procedure TEzVector.DrawHatch( Canvas: TCanvas;
  Const Clip, Extent: TEzRect;
  Grapher: TEzGrapher;
  Const BrushStyle: TEzBrushStyle;
  Const M: TEzMatrix;
  DrawMode: TEzDrawMode );
Var
  hatch: Integer;
  Scale, Angle: Double;
  Color: TColor;
Begin
  If ( Ez_Hatches.Count = 0 ) Or Not ( DrawMode In [dmNormal, dmSelection] ) Then
    exit;
  hatch := BrushStyle.Pattern - 2;
  If hatch >= Ez_Hatches.Count - 1 Then
    hatch := 0;
  If DrawMode = dmNormal Then
    Color := BrushStyle.Color
  Else
    Color := Ez_Preferences.SelectionBrush.Color;
  Scale := BrushStyle.Scale;
  Angle := BrushStyle.Angle;
  Ez_Hatches[hatch].DrawHatchTo( Self, Clip, Extent, Grapher, Canvas, Color, Scale, Angle, M );

End;

Procedure TEzVector.DrawClosed( Canvas: TCanvas;
  Const Clip, Extent: TEzRect; Grapher: TEzGrapher; Const PenStyle: TEzPenStyle;
  Const BrushStyle: TEzBrushStyle; Const M: TEzMatrix;
  DrawMode: TEzDrawMode; Bitmap: TBitmap );
Var
  P, Idx1, Idx2, cnt, n, Index: Integer;
  TmpPt1, TmpPt2: TEzPoint;
  ClipRes: TEzClipCodes;
  AStyle, APattern: Byte;
  //AScale: Double;
  //ALineColor,
  AForeColor, ABackColor: TColor;
  IsFullInside: Boolean;
  IsIdentMatrix: Boolean;
  lb: TLogBrush;
  oldBkMode: Integer;
  oldFillMode: Integer;
  bo, PrevPt: TPoint;
  DC: THandle;
  UsingTempBitmap: Boolean;
  Resname: String;
  OptimizerWasOn: Boolean;
  pointarr: PPointArray;
Begin
  If FCount < 3 Then
  Begin
    DrawOpened( Canvas, Clip, Extent, Grapher, PenStyle, M, DrawMode );
    Exit;
  End;
  IsIdentMatrix := CompareMem( @M, @IDENTITY_MATRIX2D, SizeOf( TEzMatrix ) );
  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;

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

  Try
    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;
        IsFullInside := True;
      End
      Else
      Begin
        IsFullInside := False;
        For cnt := Idx1 To Idx2 Do
        Begin
          If IsIdentMatrix Then
            TmpPt1 := FPoints^[cnt]
          Else
            TmpPt1 := TransformPoint2D( FPoints^[cnt], M );
          If cnt < Idx2 Then
          Begin
            If IsIdentMatrix Then
              TmpPt2 := FPoints^[cnt + 1]
            Else
              TmpPt2 := TransformPoint2D( FPoints^[cnt + 1], M )
          End
          Else
          Begin
            If IsIdentMatrix Then
              TmpPt2 := FPoints^[Idx1]
            Else
              TmpPt2 := TransformPoint2D( FPoints^[Idx1], M );
          End;
          ClipRes := ClipLineLeftRight2D( Clip, TmpPt1.X, TmpPt1.Y, TmpPt2.X, TmpPt2.Y );
          If Not ( ccNotVisible In ClipRes ) Then
          Begin
            Grapher.FFirstClipPts.Add( TmpPt1 );
          End;
          If ccSecond In ClipRes Then
          Begin
            Grapher.FFirstClipPts.Add( TmpPt2 );
          End;
        End;
        If Grapher.FFirstClipPts.Count > 0 Then
        Begin
          Grapher.FFirstClipPts.Add( Grapher.FFirstClipPts[0] );
          For cnt := 0 To Grapher.FFirstClipPts.Count - 2 Do
          Begin
            TmpPt1 := Grapher.FFirstClipPts[cnt];
            TmpPt2 := Grapher.FFirstClipPts[cnt + 1];
            ClipRes := ClipLineUpBottom2D( 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 );
            End;
          End;
        End;
      End;
      If Grapher.FVisiblePoints.Count > 1 Then
      Begin
        { Convert to device points }
        For cnt := 0 To Grapher.FVisiblePoints.Count - 1 Do
        Begin
          Grapher.FDevicePoints.Add( Grapher.RealToPoint( Grapher.FVisiblePoints[cnt] ) );
        End;
        { Grapher.FParts is used for storeing how many points in
          every part in Grapher.FVisiblePoints are visible }
        Grapher.FParts.Add( Grapher.FVisiblePoints.Count );
        Grapher.FIsFullInside[ Grapher.FParts.Count - 1 ] := IsFullInside;
      End;
      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;

      Grapher.FVisiblePoints.Clear;
      Grapher.FFirstClipPts.Clear;

    Until False;

    if Grapher.FParts.Count = 0 then Exit;

    { Now draw the results - First the filling }
    AStyle := 1;
    APattern := 1;
    ABackColor:= clBlack;
    AForeColor := clBlack;
    Case DrawMode Of
      dmNormal:
        Begin
          With PenStyle Do
          Begin
            AStyle := Style;
            //ALineColor := Color;
            //AScale := Scale;
          End;
          With BrushStyle Do
          Begin
            APattern := Pattern;
            AForeColor := ForeColor; // it's the same as Color data
            ABackColor := BackColor;
          End;
        End;
      dmSelection:
        With Ez_Preferences Do
        Begin
          With SelectionPen.FPenStyle Do
          Begin
            AStyle := Style;
            //ALineColor := Color;
            //AScale := Scale;
          End;
          With SelectionBrush.FBrushStyle Do
          Begin
            APattern := Pattern;
            AForeColor := ForeColor;
            ABackColor := BackColor;
          End;
        End;
      dmRubberPen:
        Begin
          AStyle := 1;
          APattern := 1;
        End;
    End;

    Case DrawMode Of
      dmSelection, dmNormal:
        Begin
          Canvas.Pen.Style := psClear;
          UsingTempBitmap:= False;
          if ( DrawMode = dmSelection ) and ( Bitmap = nil ) and
             ( ABackColor = clNone ) and ( APattern in [2..89] ) and
             ( Grapher.Device = adScreen ) then
          begin
            Bitmap := TBitmap.Create;
            { load the resource bitmap }
            Resname := '#' + IntToStr( 98 + APattern );
            Bitmap.Handle := LoadBitmap( HInstance, PChar( Resname ) );
            UsingTempBitmap:= True;
          end;
          if ( Bitmap = nil ) and ( APattern = 1 ) and ( ABackColor = clNone ) then
          begin
            { build a temporary bitmap in order to show transparency with
              solid colors }
            Bitmap:= TBitmap.Create;
            Bitmap.Width:= 8;
            Bitmap.Height:= 8;
            Bitmap.PixelFormat:= pf1bit;
            Bitmap.Canvas.Brush.Color:= clBlack;
            Bitmap.Canvas.FillRect(Rect(0,0,8,8));
            UsingTempBitmap:= True;
          end;
          If Bitmap <> Nil Then
          Begin
{$IFDEF FALSE}
            If ( ( Bitmap.Width = 8 ) And
              ( Bitmap.Height = 8 ) And
              ( Bitmap.Monochrome ) And
              ( Grapher.Device = adScreen ) ) Or
              ( Grapher.Device = adPrinter ) Then
            Begin
{$ENDIF}
              //bo:= Grapher.RealToPoint(Self.GetExtension.Emin);
              //SetBrushOrgEx(Canvas.Handle,bo.X,bo.Y,@PrevPt);
              If Grapher.Device = adScreen Then
              Begin
                EzGraphics.PolygonScreenFill8X8Bitmap( Canvas,
                                                       Grapher,
                                                       Grapher.FDevicePoints.FPoints^,
                                                       PIntegerArray(Grapher.FParts.FList.List)^,
                                                       Grapher.FParts.Count,
                                                       Bitmap,
                                                       AForeColor,
                                                       ABackColor );
              End
              Else If PrintersInstalled Then
              Begin
                DC := GetDC( 0 );
                Try

                  EzGraphics.PolygonPrinterFill8X8Bitmap(
                    Canvas,
                    Grapher,
                    Grapher.FDevicePoints.FPoints^,
                    PIntegerArray(Grapher.FParts.FList.List)^,
                    Grapher.FParts.Count,
                    Bitmap,
                    AForeColor,
                    ABackColor,
                    GetDeviceCaps( Printer.Handle, LOGPIXELSX ) / GetDeviceCaps( DC, LOGPIXELSX ),
                    Ez_Preferences.PatternPlotterOptimized );

                Finally
                  ReleaseDC( 0, DC );
                End;
              End;
              //SetBrushOrgEx(Canvas.Handle,PrevPt.X,PrevPt.Y,nil);
              if UsingTempBitmap then
              begin
                Bitmap.Free;
              end;
{$IFDEF FALSE}
            End
            Else If ( DrawMode = dmNormal ) And ( Grapher.Device = adScreen ) Then
            Begin
              bo := Grapher.RealToPoint( Self.GetExtension.Emin );
              SetBrushOrgEx( Canvas.Handle, bo.X, bo.Y, @PrevPt );
              Bitmap.HandleType := bmDDB;
              lb.lbColor := AForeColor;
              lb.lbStyle := BS_PATTERN;