ezpreview.pas

很管用的GIS控件

unit EzPreview;

{$I EZ_FLAG.PAS}
interface

Uses
  SysUtils, Classes, Windows, StdCtrls, Controls, Graphics, Printers, ExtCtrls,
  EzBaseExpr, EzLib, EzSystem, EzBase, EzRtree, EzBaseGIS, EzEntities, ezimpl;

Type

  { TEzGISItem }
  TEzGISItem = Class( TCollectionItem )
  Private
    FGIS: TEzBaseGIS;
  Protected
    Function GetDisplayName: String; Override;
    Function GetCaption: String;
  Public
    Procedure Assign( Source: TPersistent ); Override;
  Published
    Property GIS: TEzBaseGIS Read FGIS Write FGIS;
  End;

  { TEzGISList }
  TEzGISList = Class( TOwnedCollection )
  Private
    Function GetItem( Index: Integer ): TEzGISItem;
    Procedure SetItem( Index: Integer; Value: TEzGISItem );
  Public
    Constructor Create( AOwner: TPersistent );
    Function Add: TEzGISItem;
    Property Items[Index: Integer]: TEzGISItem Read GetItem Write SetItem; Default;
  End;

  TEzPaperSize = ( psPrinter,
                   psLetter,
                   psLegal,
                   psLedger,
                   psStatement,
                   psExecutive,
                   psA3,
                   psA4,
                   psA5,
                   psB3,
                   psB4,
                   psB5,
                   psFolio,
                   psQuarto,
                   ps10x14,
                   ps11x17,
                   psCsize,
                   psUSStdFanfold,
                   psGermanStdFanfold,
                   psGermanLegalFanfold,
                   ps6x8,
                   psFoolscap,
                   psLetterPlus,
                   psA4Plus,
                   psCustom );


  {----------------------------------------------------------------------------}
  {                  The preview viewport                                      }
  {----------------------------------------------------------------------------}

  TEzPreviewBox = Class( TEzBaseDrawBox )
  Private
    FGISList: TEzGISList;
    FPaperSize: TEzPaperSize;
    FPaperPen: TPen;
    FPaperBrush: TBrush;
    FShadowPen: TPen;
    FShadowBrush: TBrush;
    FShowShadow: Boolean;
    FOrientation: TPrinterOrientation;
    FPrinterPaperWidth: Double;
    FPrinterPaperHeight: Double;
    FCustomPaperWidth: Double;
    FCustomPaperHeight: Double;
    FShowPrinterMargins: Boolean;
    FPrinterMarginLeft: Double;
    FPrinterMarginRight: Double;
    FPrinterMarginTop: Double;
    FPrinterMarginBottom: Double;
    FPaperUnits: TEzScaleUnits;
    FPaperShp: TEzRectangle;
    FShadowShp: TEzRectangle;
    FMarginLeftShp: TEzPolyLine;
    FMarginRightShp: TEzPolyLine;
    FMarginTopShp: TEzPolyLine;
    FMarginBottomShp: TEzPolyLine;
    FPrintMode: TEzPrintMode;
    Procedure DestroyShapes;
    Function GetPrintablePageWidth: Double;
    Function GetPrintablePageHeight: Double;
    Function GetMarginLeft: Double;
    Function GetMarginTop: Double;
    Function GetMarginBottom: Double;
    Function GetMarginRight: Double;
    Function GetPaperWidth: Double;
    Function GetPaperHeight: Double;
    Procedure SetPaperHeight( Const Value: Double );
    Procedure SetPaperSize( Const Value: TEzPaperSize );
    Procedure SetPaperWidth( Const Value: Double );
    Procedure SetShowShadow( Value: Boolean );
    Procedure CreatePaperShapes;
    Procedure SetPaperPen( Value: TPen );
    Procedure SetPaperBrush( Value: TBrush );
    Procedure SetShadowPen( Value: TPen );
    Procedure SetShadowBrush( Value: TBrush );
    Procedure SetPaperShapeAttributes;
    Procedure SetOrientation( Value: TPrinterOrientation );
    Procedure SetGISList( Value: TEzGISList );
    function GetAbout: TEzAbout;
    procedure SetAbout(const Value: TEzAbout);
{$IFDEF BCB}
    Function GetGISList: TEzGISList;
    Function GetPaperSize: TEzPaperSize;
    Function GetOrientation: TPrinterOrientation;
    Function GetShowPrinterMargins: Boolean;
    Procedure SetShowPrinterMargins(Value: Boolean);
    Function GetPaperUnits: TEzScaleUnits;
    Procedure SetPaperUnits(Value: TEzScaleUnits);
    Function GetPrintMode: TEzPrintMode;
    Procedure SetPrintMode(Value: TEzPrintMode);
    Function GetPaperPen: TPen;
    Function GetPaperBrush: TBrush;
    Function GetShadowPen: TPen;
    Function GetShadowBrush: TBrush;
    Function GetShowShadow: Boolean;
    function GetMarginBottomShp: TEzPolyLine;
    function GetMarginLeftShp: TEzPolyLine;
    function GetMarginRightShp: TEzPolyLine;
    function GetMarginTopShp: TEzPolyLine;
    function GetPaperShp: TEzRectangle;
    function GetShadowShp: TEzRectangle;
{$ENDIF}
  Protected
    Procedure Loaded; Override;
    Procedure UpdateViewport( WCRect: TEzRect ); Override;
  Public
    Constructor Create( AOwner: TComponent ); Override;
    Destructor Destroy; Override;
    Procedure ZoomToPaper;
    procedure ZoomToFit;
    Procedure Print;
    Procedure ConfigurePaperShapes;
    Procedure CreateNewEditor;
    Procedure PopulateFrom( Symbol: TEzSymbol );
    Procedure PopulateTo( Symbol: TEzSymbol );
    Procedure AddMap( Index: Integer;
                      Const OutX, OutY, WidthOut, HeightOut,
                      PlottedUnits, DrawingUnits, CoordX, CoordY: Double;
                      IsAtCenter: Boolean );

    Property PrintablePageWidth: Double Read GetPrintablePageWidth;
    Property PrintablePageHeight: Double Read GetPrintablePageHeight;
    Property PaperShp: TEzRectangle {$IFDEF BCB} Read GetPaperShp {$ELSE} Read FPaperShp {$ENDIF};
    Property ShadowShp: TEzRectangle {$IFDEF BCB} Read GetShadowShp {$ELSE} Read FShadowShp {$ENDIF};
    Property MarginLeftShp: TEzPolyLine {$IFDEF BCB} Read GetMarginLeftShp {$ELSE}Read FMarginLeftShp {$ENDIF};
    Property MarginRightShp: TEzPolyLine {$IFDEF BCB} Read GetMarginRightShp {$ELSE} Read FMarginRightShp {$ENDIF};
    Property MarginTopShp: TEzPolyLine {$IFDEF BCB} Read GetMarginTopShp {$ELSE} Read FMarginTopShp {$ENDIF};
    Property MarginBottomShp: TEzPolyLine {$IFDEF BCB} Read GetMarginBottomShp {$ELSE} Read FMarginBottomShp {$ENDIF};
    Property MarginLeft: Double Read GetMarginLeft;
    Property MarginTop: Double Read GetMarginTop;
    Property MarginRight: Double Read GetMarginRight;
    Property MarginBottom: Double Read GetMarginBottom;
  Published
    Property About: TEzAbout read GetAbout write SetAbout;
    Property GISList: TEzGISList Read {$IFDEF BCB}GetGISList{$ELSE}FGISList{$ENDIF} Write SetGISList;
    Property PaperSize: TEzPaperSize Read {$IFDEF BCB}GetPaperSize{$ELSE}FPaperSize{$ENDIF} Write SetPaperSize;
    Property PaperWidth: Double Read GetPaperWidth Write SetPaperWidth;
    Property PaperHeight: Double Read GetPaperHeight Write SetPaperHeight;
    Property Orientation: TPrinterOrientation Read {$IFDEF BCB}GetOrientation{$ELSE}FOrientation{$ENDIF} Write SetOrientation;
    Property ShowPrinterMargins: Boolean Read {$IFDEF BCB}GetShowPrinterMargins{$ELSE}FShowPrinterMargins{$ENDIF} Write {$IFDEF BCB}SetShowPrinterMargins{$ELSE}FShowPrinterMargins{$ENDIF};
    Property PaperUnits: TEzScaleUnits Read {$IFDEF BCB}GetPaperUnits{$ELSE}FPaperUnits{$ENDIF} Write {$IFDEF BCB}SetPaperUnits{$ELSE}FPaperUnits{$ENDIF};
    Property PrintMode: TEzPrintMode Read {$IFDEF BCB}GetPrintMode{$ELSE}FPrintMode{$ENDIF} Write {$IFDEF BCB}SetPrintMode{$ELSE}FPrintMode{$ENDIF};
    Property PaperPen: TPen Read {$IFDEF BCB}GetPaperPen{$ELSE}FPaperPen{$ENDIF} Write SetPaperPen;
    Property PaperBrush: TBrush Read {$IFDEF BCB}GetPaperBrush{$ELSE}FPaperBrush{$ENDIF} Write SetPaperBrush;
    Property ShadowPen: TPen Read {$IFDEF BCB}GetShadowPen{$ELSE}FShadowPen{$ENDIF} Write SetShadowPen;
    Property ShadowBrush: TBrush Read {$IFDEF BCB}GetShadowBrush{$ELSE}FShadowBrush{$ENDIF} Write SetShadowBrush;
    Property ShowShadow: Boolean Read {$IFDEF BCB}GetShowShadow{$ELSE}FShowShadow{$ENDIF} Write SetShowShadow Default True;

    { inherited properties }
    Property NumDecimals;
    Property DelayShowHint;
    Property PartialSelect;
    Property StackedSelect;
    Property NoPickFilter;
    Property SnapToGuidelines;
    Property SnapToGuidelinesDist;
    Property ScreenGrid;
    Property GridInfo;
    Property RubberPen;
    Property ScrollBars;
    Property FlatScrollBar;

    { events to be published in descendants }
    Property OnGridError;
    Property OnHScroll;
    Property OnVScroll;
    Property OnHChange;
    Property OnVChange;

    Property OnBeginRepaint;
    Property OnEndRepaint;
    Property OnMouseMove2D;
    Property OnMouseDown2D;
    Property OnMouseUp2D;

    Property OnPaint;

    { drawbox specific events }
    Property OnEntityDblClick;
    Property OnBeforeInsert;
    Property OnAfterInsert;
    Property OnBeforeSelect;
    Property OnAfterSelect;
    Property OnAfterUnSelect;
    Property OnZoomChange;
    Property OnEntityChanged;
    Property OnShowHint;
    Property OnSelectionChanged;
  End;

  {-------------------------------------------------------------------------------}
  //                  Mosaic view BOX
  {-------------------------------------------------------------------------------}

  TEzPageAdvance = ( padvNone, padvLeft, padvRight, padvUp, padvDown );

  TEzMosaicView = Class( TEzBaseDrawBox )
  Private
    FParentView: TEzPreviewBox;
    FInnerColor: TColor;
    FOuterColor: TColor;
    FShowInverted: Boolean;
    FPrintedInnerColor: TColor;
    FPrintedOuterColor: TColor;
    FX1List: TEzDoubleList;
    FY1List: TEzDoubleList;
    FX2List: TEzDoubleList;
    FY2List: TEzDoubleList;
    FSavedDrawLimit: Integer;
    Procedure SetParentView( Const Value: TEzPreviewBox );
    Function FindGis: TEzBaseGis;
    function GetAbout: TEzAbout;
    procedure SetAbout(const Value: TEzAbout);
{$IFDEF BCB}
    Function GetX1List: TEzDoubleList;
    Function GetY1List: TEzDoubleList;
    Function GetX2List: TEzDoubleList;
    Function GetY2List: TEzDoubleList;
    Function GetShowInverted: boolean;
    procedure SetShowInverted(Value: boolean);
    Function GetPrintedInnerColor: TColor;
    procedure SetPrintedInnerColor(Value: TColor);
    Function GetPrintedOuterColor: TColor;
    procedure SetPrintedOuterColor(Value: TColor);
    Function GetInnerColor: TColor;
    procedure SetInnerColor(Value: TColor);
    Function GetOuterColor: TColor;
    procedure SetOuterColor(Value: TColor);
    Function GetParentView: TEzPreviewBox;
{$ENDIF}
  Protected
    Procedure Notification( AComponent: TComponent; Operation: TOperation ); Override;
    Procedure UpdateViewport( WCRect: TEzRect ); Override;
  Public
    Constructor Create( AOwner: TComponent ); Override;
    Destructor Destroy; Override;

    Procedure BeginRepaint; Override;
    Procedure EndRepaint; Override;
    Function GetPreviewEntity(var Layer: TEzBaseLayer; var Recno: Integer) : TEzEntity;
    Function CurrentPrintArea(Ent: TEzEntity; Advance: TEzPageAdvance): TEzRect;
    Procedure GoAdvance( Advance: TEzPageAdvance );
    procedure AddCurrentToPrintList;
    procedure ClearPrintList;

    Property X1List: TEzDoubleList read {$IFDEF BCB}GetX1List{$ELSE}FX1List{$ENDIF};
    Property Y1List: TEzDoubleList read {$IFDEF BCB}GetY1List{$ELSE}FY1List{$ENDIF};
    Property X2List: TEzDoubleList read {$IFDEF BCB}GetX2List{$ELSE}FX2List{$ENDIF};
    Property Y2List: TEzDoubleList read {$IFDEF BCB}GetY2List{$ELSE}FY2List{$ENDIF};
  Published
    Property About: TEzAbout read GetAbout write SetAbout;
    Property ShowInverted: Boolean {$IFDEF BCB}Read GetShowInverted Write SetShowInverted{$ELSE}Read FShowInverted Write FShowInverted{$ENDIF};
    Property PrintedInnerColor: TColor Read {$IFDEF BCB}GetPrintedInnerColor Write SetPrintedInnerColor{$ELSE}FPrintedInnerColor Write FPrintedInnerColor{$ENDIF} default clRed;
    Property PrintedOuterColor: TColor Read {$IFDEF BCB}GetPrintedOuterColor Write SetPrintedOuterColor{$ELSE}FPrintedOuterColor Write FPrintedOuterColor{$ENDIF} default clBlack;
    Property InnerColor: TColor Read {$IFDEF BCB}GetInnerColor Write SetInnerColor{$ELSE}FInnerColor Write FInnerColor{$ENDIF} default clGreen;
    Property OuterColor: TColor Read {$IFDEF BCB}GetOuterColor Write SetOuterColor{$ELSE}FOuterColor Write FOuterColor{$ENDIF} default clBlack;
    Property ParentView: TEzPreviewBox Read {$IFDEF BCB}GetParentView{$ELSE}FParentView{$ENDIF} Write SetParentView;

    { inherited }
    //Property ScreenScaleBar;
    Property ShowMapExtents;
    Property ShowLayerExtents;

    { inherited }

    Property OnBeginRepaint;
    Property OnEndRepaint;
    Property OnMouseMove2D;
    Property OnMouseDown2D;
    Property OnMouseUp2D;

    Property OnPaint;

    { drawbox specific events }
    Property OnZoomChange;

  End;


  { TEzHRuler }
  TEzHRuler = Class( TPaintBox )
  Private
    FPreviewBox: TEzPreviewBox;
    FLastMousePosInRuler: TPoint;
    FRubberPenColor: TColor;
    FMarksColor: TColor;
    FBoxOnPaint: TNotifyEvent;
    FBoxOnMouseMove: TMouseMoveEvent;
    Procedure SetPreviewBox( Value: TEzPreviewBox );
    Procedure DrawRulerPosition( p: TPoint; AMode: TPenMode );
    Procedure SetRubberPenColor( Const Value: TColor );
    Procedure SetMarksColor( Const Value: TColor );
    Procedure MyOnPaint( Sender: TObject );
    Procedure MyOnMouseMove( Sender: TObject; Shift: TShiftState;
      X, Y: Integer );
    function GetAbout: TEzAbout;
    procedure SetAbout(const Value: TEzAbout);
  {$IFDEF BCB} (*_*)
    function GetMarksColor: TColor;
    function GetPreviewBox: TEzPreviewBox;
    function GetRubberPenColor: TColor;
  {$ENDIF}
  Protected
    Procedure Notification( AComponent: TComponent; Operation: TOperation ); Override;
    Procedure Paint; Override;
  Public
    Constructor Create( AOwner: TComponent ); Override;
  Published
    Property About: TEzAbout read GetAbout write SetAbout;
    Property PreviewBox: TEzPreviewBox
      read {$IFDEF BCB} GetPreviewBox {$ELSE} FPreviewBox {$ENDIF}
      write SetPreviewBox; (*_*)
    Property RubberPenColor: TColor
      read {$IFDEF BCB} GetRubberPenColor {$ELSE} FRubberPenColor {$ENDIF}
      write SetRubberPenColor; (*_*)
    Property MarksColor: TColor
      read {$IFDEF BCB} GetMarksColor {$ELSE} FMarksColor {$ENDIF}
      write SetMarksColor; (*_*)
  End;

  { TEzVRuler }
  TEzVRuler = Class( TPaintBox )
  Private
    FPreviewBox: TEzPreviewBox;
    FLastMousePosInRuler: TPoint;
    FRubberPenColor: TColor;
    FMarksColor: TColor;
    FBoxOnPaint: TNotifyEvent;
    FBoxOnMouseMove: TMouseMoveEvent;
    Procedure SetPreviewBox( Value: TEzPreviewBox );
    Procedure DrawRulerPosition( p: TPoint; AMode: TPenMode );
    Procedure SetRubberPenColor( Const Value: TColor );
    Procedure SetMarksColor( Const Value: TColor );
    Procedure MyOnPaint( Sender: TObject );
    Procedure MyOnMouseMove( Sender: TObject; Shift: TShiftState;
      X, Y: Integer );
    function GetAbout: TEzAbout;
    procedure SetAbout(const Value: TEzAbout);
  {$IFDEF BCB} (*_*)
    function GetMarksColor: TColor;
    function GetPreviewBox: TEzPreviewBox;
    function GetRubberPenColor: TColor;
  {$ENDIF}
  Protected
    Procedure Notification( AComponent: TComponent; Operation: TOperation ); Override;
    Procedure Paint; Override;
  Public
    Constructor Create( AOwner: TComponent ); Override;
  Published
    Property About: TEzAbout read GetAbout write SetAbout;
    Property PreviewBox: TEzPreviewBox
      read {$IFDEF BCB} GetPreviewBox {$ELSE} FPreviewBox {$ENDIF}
      write SetPreviewBox; (*_*)
    Property RubberPenColor: TColor
      read {$IFDEF BCB} GetRubberPenColor {$ELSE} FRubberPenColor {$ENDIF}
      write SetRubberPenColor Default clAqua; (*_*)
    Property MarksColor: TColor
      read {$IFDEF BCB} GetMarksColor {$ELSE} FMarksColor {$ENDIF}
      write SetMarksColor; (*_*)
  End;


implementation

Uses
  EzConsts, EzCADCtrls, EzMiscelEntities, EzShpImport;


{ TEzGISItem }

Procedure TEzGISItem.Assign( Source: TPersistent );
Begin
  If Source Is TEzGISItem Then
  Begin
    FGIS := TEzGISItem( Source ).FGIS;
  End
  Else
    Inherited Assign( Source );
End;

Function TEzGISItem.GetCaption: String;
Begin
  If FGIS = Nil Then
    result := SGISUnassigned
  Else
    result := ExtractFileName( FGIS.FileName );
End;

Function TEzGISItem.GetDisplayName: String;
Begin
  result := GetCaption;
  If Result = '' Then
    Result := Inherited GetDisplayName;
End;

{ TEzGISList }

Constructor TEzGISList.Create( AOwner: TPersistent );
Begin
  Inherited Create( AOwner, TEzGISItem );
End;

Function TEzGISList.Add: TEzGISItem;
Begin
  Result := TEzGISItem( Inherited Add );
End;

Function TEzGISList.GetItem( Index: Integer ): TEzGISItem;
Begin
  Result := TEzGISItem( Inherited GetItem( Index ) );