ezlib.pas

很管用的GIS控件

Unit EzLib;

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

{$I EZ_FLAG.PAS}
Interface

Uses
  SysUtils, Classes, Windows, Graphics, Printers;

Type

  TEzVector = Class;
  TIntegerList = Class;
  TEzPointList = Class;

  TEzLineRelation = ( lrDivToRight,
                      lrDivToLeft,
                      lrAtDivStart,
                      lrAtDivEnd,
                      lrBetweenDiv,
                      lrOffDivStart,
                      lrOffDivEnd,
                      lrParToRight,
                      lrParToLeft,
                      lrAtParStart,
                      lrAtParEnd,
                      lrBetweenPar,
                      lrOffParStart,
                      lrOffParEnd,
                      lrParallel,
                      lrIntOffDiv,
                      lrIntOffPar );

  TEzLineRelations = Set Of TEzLineRelation;

  TEzDrawMode = ( dmNormal, dmRubberPen, dmSelection );

  TEzClipCodes = Set Of ( ccFirst, ccSecond, ccNotVisible, ccVisible );

  { 2D Point }
  PEzPoint = ^TEzPoint;
  TEzPoint = Packed Record
    x: double; (* Vertex x component                *)
    y: double; (* vertex y component                *)
  End;

  //PEzRect = ^TEzRect;
  TEzRect = Packed Record
    Case Byte Of
      0: ( X1, Y1, X2, Y2: Double ); // (left,bottom)-(right,top) coordinates
      1: ( Emin, Emax: TEzPoint );
      2: ( xmin, ymin, xmax, ymax: Double );
  End;

  TBooleanArray = Array[0..( MaxInt Div SizeOf( Boolean ) ) - 1] Of Boolean;
  PBooleanArray = ^TBooleanArray;

  TByteArray = Array[0..( MaxInt Div SizeOf( Byte ) ) - 1] Of Byte;
  PByteArray = ^TByteArray;

  TIntegerArray = Array[0..( MaxInt Div SizeOf( Integer ) ) - 1] Of Integer;
  PIntegerArray = ^TIntegerArray;

  PDoubleArray = ^TDoubleArray;
  TDoubleArray = Array[0..0] Of Double;

  TPointArray = Array[0..( MaxInt Div SizeOf( TPoint ) ) - 1] Of TPoint;
  PPointArray = ^TPointArray;

  TEzPointArray = Array[0..( MaxInt Div SizeOf( TEzPoint ) ) - 1] Of TEzPoint;
  PEzPointArray = ^TEzPointArray;

  TEzRectArray = Array[0..0] Of TEzRect;
  PEzRectArray = ^TEzRectArray;

  PEzMatrix = ^TEzMatrix;
  TEzMatrix = Packed record
    Matrix: Array[0..2,0..2] of Double;
  end;

  { Symbol style }
  TEzSymbolStyle = Packed Record
    Index: SmallInt;
    Rotangle: Double; // rotation angle in radians
    Height: Double; // <0 is in points, >0 is in real units
  End;

  { Line style record }
  TEzPenStyle = Packed Record
    Style: Byte; {line Style, 0= no draw, 1=solid, etc.}
    Color: TColor; {color of line}
    Case Byte Of
      0: ( Scale: Double );
      1: ( Width: Double ); // <0 is in points, >0 is in real units
  End;

  { fill style record }
  TEzBrushStyle = Packed Record
    Pattern: Word; { hatch pattern 0= no fill, 1=solid, etc. }
    Case Byte Of
      0: ( Color: TColor;
           Scale: Double;
           Angle: Double );
      1: ( ForeColor: TColor;
           BackColor: TColor );
  End;

  { the font style }
  TEzFontStyle = Packed Record
    Name: String[LF_FACESIZE - 1];
    //CharSet: TFontCharSet;
    Style: TFontStyles;
    Color: TColor;
    Angle: Single;
    Height: Double; // <0 is in points, >0 is in real units
  End;

  PTransformParams = ^TEzTransformParams;
  TEzTransformParams = Packed Record
    VisualWindow: TEzRect;
    MidPoint: TEzPoint;
    XScale, YScale: Double;
  End;

  { TEzCanvasRegionStacker }
  TEzCanvasRegionStacker = Class( TObject )
  Private
    FRegions: Array[1..5] Of HRgn; // 5 = maximum stacked regions depth
    FCanvas: TCanvas; // the canvas that is stacking regions
    FCount: Integer; // current count of stacked regions
  Public
    Procedure Push( Canvas: TCanvas; Rgn: HRgn );
    Procedure Pop( Canvas: TCanvas );
    Procedure PopAll( Canvas: TCanvas );
  End;

  { Graphic Transformer class - used for transforming from
    world coordinate to device coords and viceversa - abreviated TEzGrapher }
  TEzActiveDevice = ( adScreen, adPrinter );

  TEzGrapher = Class( TObject )
  Private
    FViewPortRect: TEzRect;
    FDevice: TEzActiveDevice;
    { To handle the previous views }
    FHistoryList: TList;
    FMaxHistoryCount: Integer;
    FInUpdate: Boolean;

    { To save/restore the canvas attribs }
    FOldPenStyle: TPenStyle;
    FOldPenMode: TPenMode;
    FOldPenWidth: Integer;
    FOldPenColor: TColor;
    FOldBrushStyle: TBrushStyle;
    FOldBrushColor: TColor;
    FCanvasRegionStacker: TEzCanvasRegionStacker;

    { this data is used for optimum performance in drawing entities
      BeginOptimizer...ClearOptimizer...EndOptimizer }
    FVisiblePoints: TEzVector;
    FFirstClipPts: TEzVector;
    FDevicePoints: TEzPointList;
    FParts: TIntegerList;
    FIsFullInside: TBits;
    FInOptimizer: Boolean;

    FOnChange: TNotifyEvent;
    Procedure Delete( Index: Integer );
    Procedure Push;
    Function GetHistoryCount: Integer;
  Public
    {DPI of devices}
    ScreenDpiX, ScreenDpiY: Integer;
    PrinterDpiX, PrinterDpiY: Integer;
    OriginalParams: TEzTransformParams;
    CurrentParams: TEzTransformParams;

    {methods}
    Constructor Create( MaxHistoryCount: Integer; ADevice: TEzActiveDevice );
    Destructor Destroy; Override;
    Procedure Assign( Source: TEzGrapher );
    Procedure Pop;
    Procedure Clear;
    Function CanPop: Boolean;
    Procedure Zoom( Const Factor: Double );
    Procedure SetViewPort( Const ALeft, ATop, ARight, ABottom: Double );
    Procedure Window( Const Xi, Xf, Yi, Yf: Double );
    Procedure SetWindow( Const Xi, Xf, Yi, Yf: Double );
    //procedure ResetWindow(const Xi, Xf, Yi, Yf: Double);
    Procedure SetViewTo( Const ViewWin: TEzRect );
    Procedure ReCentre( Const MX, MY: Double );
    {conversion}
    Function PointToReal( Const P: TPoint ): TEzPoint;
    Function RealToPoint( Const P: TEzPoint ): TPoint;
    Function RectToReal( Const ARect: TRect ): TEzRect;
    Function RealToRect( Const ARect: TEzRect ): TRect;
    Function DistToRealX( DistX: Integer ): Double;
    Function DistToRealY( DistY: Integer ): Double;
    Function RealToDistX( Const DistX: Double ): Integer;
    Function RealToDistY( Const DistY: Double ): Integer;
    Function RDistToRealX( Const DistX: Double ): Double;
    Function RDistToRealY( Const DistY: Double ): Double;
    Function RRealToDistX( Const DistX: Double ): Double;
    Function RRealToDistY( Const DistY: Double ): Double;
    Function PointsToDistX( Const Size: Double ): Double;
    Function PointsToDistY( Const Size: Double ): Double;
    Function DistToPointsX( Const Dist: Double ): Double;
    Function DistToPointsY( Const Dist: Double ): Double;
    Function DpiX: Integer;
    Function DpiY: Integer;
    Procedure SaveCanvas( ACanvas: TCanvas );
    Procedure RestoreCanvas( ACanvas: TCanvas );
    { for internal use }
    Function GetSizeInPoints( Const Value: double ): Double;
    Function GetRealSize( value: double ): double;
    Procedure BeginOptimizer( PointsSize, PartsSize : Integer );
    Procedure ClearOptimizer;
    Procedure EndOptimizer;

    {properties}
    Property Device: TEzActiveDevice Read FDevice Write FDevice;
    Property ViewPortRect: TEzRect Read FViewPortRect;
    Property InUpdate: Boolean Read FInUpdate Write FInUpdate;
    Property MaxHistoryCount: Integer Read FMaxHistoryCount Write FMaxHistoryCount;
    Property HistoryCount: Integer Read GetHistoryCount;
    Property CanvasRegionStacker: TEzCanvasRegionStacker Read FCanvasRegionStacker;
    Property InOptimizer: Boolean read FInOptimizer;

    { events }
    Property OnChange: TNotifyEvent Read FOnChange Write FOnChange;
  End;

  TEzChangeVectorEvent = Procedure Of Object;

  { TIntegerList class }

  TIntegerList = Class
  Private
    FList: TList;
    Function Get( Index: Integer ): Integer;
    Procedure Put( Index: Integer; Value: Integer );
    Function GetCapacity: Integer;
    Procedure SetCapacity( Value: Integer );
    Function GetCount: Integer;
    Procedure SetCount( Value: Integer );
  Public
    Constructor Create;
    Destructor Destroy; Override;
    Procedure Assign( AList: TIntegerList );
    Function Add( Item: Integer ): Integer;
    Procedure Clear;
    Procedure Delete( Index: Integer );
    Procedure Insert( Index: Integer; Value: Integer );
    Function IndexofValue( Item: Integer ): Integer;
    Procedure Sort;
    Function Find(Value: Integer; var Index: Integer): Boolean;
    procedure LoadFromStream( Stream: TStream );
    Procedure SaveToStream( Stream: TStream );
    Procedure LoadFromFile( const FileName: string );
    Procedure SaveToFile( const FileName: string );
    Procedure Reindex;

    Property Items[Index: Integer]: Integer Read Get Write Put; Default;
    Property Capacity: Integer Read GetCapacity Write SetCapacity;
    Property Count: Integer Read GetCount Write SetCount;
  End;

  {-----------------------------------------------------------------------------}
  //                   TEzDoubleList
  {-----------------------------------------------------------------------------}

  TEzDoubleList = Class
  Private
    FList: TList;
    Function GetCount: Integer;
    Function GetItem( Index: Integer ): Double;
    Procedure SetItem( Index: Integer; Const Value: Double );
  Public
    Constructor Create;
    Destructor Destroy; Override;
    Function Add( Const Value: Double ): Integer;
    Procedure Clear;
    Procedure Delete( Index: Integer );
    Procedure Insert( Index: Integer; Const Value: Double );
    Procedure Sort;

    Property Count: Integer Read GetCount;
    Property Items[Index: Integer]: Double Read GetItem Write SetItem; Default;
  End;

  { Vector handling -- class implement }
  TEzVector = Class
  Private
    FPoints: PEzPointArray;
    FParts: TIntegerList;
    FLast, FCount: Integer;
    FCanGrow: Boolean;
    FDisableEvents: Boolean;
    FOnChange: TEzChangeVectorEvent;

    Function GetExtension: TEzRect;
    Function Get( Index: Integer ): TEzPoint;
    Procedure Put( Index: Integer; Const Item: TEzPoint );
    Function GetX( Index: Integer ): Double;
    Function GetY( Index: Integer ): Double;
    Procedure PutX( Index: Integer; Const Value: Double );
    Procedure PutY( Index: Integer; Const Value: Double );
    Procedure SetCapacity( Value: Integer );
    function GetAsString: String;
    procedure SetAsString(const Value: string);
    Procedure SetCount(Value: Integer);
  Public
    Constructor Create( Size: Integer );
    Destructor Destroy; Override;

    Procedure Clear;
    Procedure Add( Const Item: TEzPoint );
    Procedure AddPoints( Const Items: Array Of TEzPoint );
    Procedure Delete( Index: Integer );
    Procedure Insert( Index: Integer; Const Item: TEzPoint );
    Procedure Assign( Source: TEzVector );
    Procedure LoadFromStream( Stream: TStream );
    Procedure SaveToStream( Stream: TStream );
    Procedure DrawClosed( Canvas: TCanvas; Const Clip, Extent: TEzRect;
      Grapher: TEzGrapher; Const PenStyle: TEzPenStyle; Const BrushStyle: TEzBrushStyle;
      Const M: TEzMatrix; DrawMode: TEzDrawMode; Bitmap: Graphics.TBitmap );
    Procedure DrawOpened( Canvas: TCanvas; Const Clip, Extent: TEzRect;
      Grapher: TEzGrapher; Const PenStyle: TEzPenStyle; Const M: TEzMatrix;
      DrawMode: TEzDrawMode );
    Procedure DrawWithLineStyle( Canvas: TCanvas; Const Clip: TEzRect;
      Grapher: TEzGrapher; Const PenStyle: TEzPenStyle; Const M: TEzMatrix;
      DrawMode: TEzDrawMode );
    Procedure DrawHatch( Canvas: TCanvas; Const Clip, Extent: TEzRect;
      Grapher: TEzGrapher; Const BrushStyle: TEzBrushStyle; Const M: TEzMatrix;
      DrawMode: TEzDrawMode );
    Function CrossFrame( Const Frm: TEzRect; Const M: TEzMatrix ): Boolean;
    Procedure clipLiangBarsky( Canvas: TCanvas; Const clipArea: TEzRect;
      Grapher: TEzGrapher; Const Matrix: TEzMatrix; ResultVector: TEzVector );
    Function PointOnPolyLine2D( Idx1: Integer; Const P: TEzPoint;
      Var Dist: Double; Const Aperture: Double; Const T: TEzMatrix;
      Const MustClose: Boolean ): Integer;
    Function PointInPolygon2D( Const P: TEzPoint; Var Dist: Double;
      Const Aperture: Double; Const T: TEzMatrix ): Integer;
    Procedure AddPoint( Const AX, AY: Double );
    Procedure RevertDirection;
    Function TravelDistance( Const Distance: Double; Var p: TEzPoint;
      Var Index1, Index2: Integer ): Boolean;
    Function IsEqualTo( Vector: TEzVector ): Boolean;
    procedure SplitEquidistant(const Source: TEzVector; NumSegs: Integer;
      IndexList: TIntegerList; WidthList: TEzDoubleList);

    Property X[Index: Integer]: Double Read GetX Write PutX;
    Property Y[Index: Integer]: Double Read GetY Write PutY;
    Property Count: Integer Read FCount Write SetCount;
    Property Size: Integer Read FLast;
    Property CanGrow: Boolean Read FCanGrow Write FCanGrow;
    Property DisableEvents: Boolean Read FDisableEvents Write FDisableEvents;
    Property Extension: TEzRect Read GetExtension;
    Property Points[Index: Integer]: TEzPoint Read Get Write Put; Default;
    Property Parts: TIntegerList Read FParts;
    Property Capacity: Integer Read FLast Write SetCapacity;
    Property AsString: string read GetAsString write SetAsString;

    Property OnChange: TEzChangeVectorEvent Read FOnChange Write FOnChange;

  End;

  TEzPointList = Class
  Private
    FPoints: PPointArray;
    FLast, FCount: Integer;
    FCanGrow: Boolean;
    Function Get( Index: Integer ): TPoint;
    Procedure Put( Index: Integer; Const Item: TPoint );
    Function GetX( Index: Integer ): Integer;
    Function GetY( Index: Integer ): Integer;
    Procedure PutX( Index: Integer; Value: Integer );
    Procedure PutY( Index: Integer; Value: Integer );
    Procedure SetCapacity( Value: Integer );
  Public
    Constructor Create( Size: Integer );
    Destructor Destroy; Override;

    Procedure Clear;
    Procedure Add( Const Item: TPoint );
    Procedure Delete( Index: Integer );
    Procedure Insert( Index: Integer; Const Item: TPoint );
    Procedure AddPoint( AX, AY: Integer );
    Function IsEqual(Index1, Index2: Integer): Boolean;

    Property X[Index: Integer]: Integer Read GetX Write PutX;
    Property Y[Index: Integer]: Integer Read GetY Write PutY;
    Property Count: Integer Read FCount;
    Property Size: Integer Read FLast;
    Property CanGrow: Boolean Read FCanGrow Write FCanGrow;
    Property Points[Index: Integer]: TPoint Read Get Write Put; Default;
    Property Capacity: Integer Read FLast Write SetCapacity;

  End;

{ Useful functions }
Function BuildTransformationMatrix( const sx,sy,phi,tx,ty : double;
  const refPt: TEzPoint ): TEzMatrix;
procedure matrix3x3PreMultiply(const m: TEzMatrix; var t: TEzMatrix);
Function EqualMatrix2D( Const M1, M2: TEzMatrix ): Boolean;
Function EqualRect2D( Const R1, R2: TEzRect ): Boolean;
Function EqualPoint2D( Const P1, P2: TEzPoint ): Boolean;
Function FuzzEqualPoint2D( Const P1, P2: TEzPoint ): Boolean;
Function Point2D( Const AX, AY: Double ): TEzPoint;
Function Rect2D( Const AXmin, AYmin, AXmax, AYmax: Double ): TEzRect;
Function ReorderRect2D( Const R: TEzRect ): TEzRect;
Function ReorderRect( Const R: TRect ): TRect;