mapxcontainer.pas

此代码是关于mapgis的在

unit MapXContainer;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, OleCtrls, MapXLib_TLB, Math, DB, ADODB, MapXBase,
  MapXStyles, MapXConsts, StoreManager, DBTools;



const
  PROC_MOUSEDOWN        = 1;
  PROC_MOUSEMOVE        = 2;
  PROC_MOUSEUP          = 3;
  PROC_TOOLUSED         = 4;
  PROC_DBLCLICK         = 5;
  PROC_SELECTIONCHANGED = 6;
  PROC_DRAWUSERLAYER    = 7;

const
  EditorName      = 'TextEditor';
  EditorMinWidth  = 50;
  ErrorSingleLine = '本次操作只能选择一条折线！';

const
  UNION_FEATURE_NONE       = 0;
  UNION_FEATURE_ALL        = 1;
  UNION_FEATURE_SELECTED   = 2;
  UNION_FEATURE_QUERY      = 3;
  
type
  TMapXSelectionDeleted=procedure (ASender:TObject;
    EditLayer:CMapXLayer) of object;

  TFeatureClass=class;
  
  TMapManager=class;

  TFeatureEditMode=(emFeature,
                    emNode,
                    emMoveDuplicateNodes,
                    emDeleteDuplicateNodes,
                    emEditModeAddNode);

  TMapManager=class
  private
    FAddFeatureToolUsedEventProces:TObjectMethodList;
    FAnnotationAddedEventProces:TObjectMethodList;
    FAnnotationChangedEventProces:TObjectMethodList;
    FClickEventProces:TObjectMethodList;
    FDataMismatchEventProces:TObjectMethodList;
    FDblClickEventProces:TObjectMethodList;

    FDrawUserLayerEventProces:TObjectMethodList; 
    FMouseDownEventProces:TObjectMethodList;
    FMouseMoveEventProces:TObjectMethodList;
    FMouseUpEventProces:TObjectMethodList;
    FMouseWheelEventProces:TObjectMethodList;
    FRequestDataEventProces:TObjectMethodList;
    FResolveDataBindEventProces:TObjectMethodList;
    FResolveDataBindExEventProces:TObjectMethodList;
    FSelectionChangedEventProces:TObjectMethodList;
    FStartDragEventProces:TObjectMethodList;
    FThemeModifyRequestedEventProces:TObjectMethodList;

    FToolUsedEventProces:TObjectMethodList;
    FSelectionDeletedEventProces:TObjectMethodList;

    FSysTools: TToolList;
    FUserTools: TToolList;
    FMapX: TMapXObject;
    FUserStyles: TStyleInfoList;
    FAnimateLayer: CMapXLayer;
    FSysStyles: TStyleInfoList;
    function TypeIdToListInstance(const TypeId:Integer):TObjectMethodList;
    function GetFeatureEditMode: TFeatureEditMode;
    procedure SetFeatureEditMode(const Value: TFeatureEditMode);
  public
    //-------------------------------------------------------------------//
    {复制的图形}
    CopyFts:Features;
    //-------------------------------------------------------------------//
    constructor Create;
    destructor Destroy;override;
    //-------------------------------------------------------------------//
    procedure DoAddFeatureToolUsed(ASender: TObject;
      ToolNum: Smallint; Flags: Integer; const Feature: IDispatch; bShift,
      bCtrl: WordBool; var EnableDefault: WordBool);
    procedure DoAnnotationAdded(ASender: TObject;
      const Annotation: IDispatch);
    procedure DoAnnotationChanged(ASender: TObject;
      ChangeType: Smallint; const Annotation: IDispatch;
      var EnableDefault: WordBool);
    procedure DoClick(Sender: TObject);
    procedure DoDataMismatch(ASender: TObject;
      const DataSetName: WideString; Row: Integer;
      var GeoFieldValue: WideString);
    procedure DoDblClick(Sender: TObject);
    //还有14个事件没有处理//
    procedure DoDrawUserLayer(ASender: TObject;
      const Layer: IDispatch; hOutputDC, hAttributeDC: Cardinal;
      const RectFull, RectInvalid: IDispatch);
    procedure DoMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure DoMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure DoMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure DoMouseWheel(ASender: TObject; Flags: Integer;
      zDelta: Smallint; var X, Y: Single; var EnableDefault: WordBool);
    procedure DoRequestData(ASender: TObject;
      const DataSetName: WideString; Row: Integer; Field: Smallint;
      var Value: OleVariant; var Done: WordBool);
    procedure DoResolveDataBind(ASender: TObject; Flag,
      NumMatches: Smallint; Matches: OleVariant; var Choice: Smallint;
      var Cancel: WordBool);
    procedure DoResolveDataBindEx(ASender: TObject; Flag,
      NumMatches: Smallint; Matches: OleVariant; var Choice: Smallint;
      var Cancel: WordBool);
    procedure DoSelectionChanged(Sender: TObject);
    procedure DoStartDrag(Sender: TObject;
      var DragObject: TDragObject);
    procedure DoThemeModifyRequested(ASender: TObject;
      const Theme: IDispatch);
    procedure DoToolUsed(ASender: TObject; ToolNum: Smallint; X1,
      Y1, X2, Y2, Distance: Double; Shift, Ctrl: WordBool;
      var EnableDefault: WordBool);
    procedure DoBeforeSelectionDeleted(ASender: TObject; EditLayer:CMapXLayer);
    //-------------------------------------------------------------------//
    {转换为地图上的坐标}
    procedure ToMapPoint(const vX, vY:Integer; var mX, mY:Double);
    {转换为视图上的坐标}
    procedure ToViewPoint(const mX, mY:Double; var vX, vY:Integer);
    {转换为地图上的长度}
    function ToMapLength(const Len:Integer):Double;
    {转换为屏幕上的长度}
    //-------------------------------------------------------------------//
    {注册方法}
    procedure RegisterEventProc(Obj:TObject; const P:Pointer;
      const TypeId:Integer);
    {取消方法注册}
    procedure UnRegisterEventProc(Obj:TObject; const P:Pointer;
      const TypeId:Integer);
    //-------------------------------------------------------------------//
    {用Style索引号取得Style接口对象}
    function GetStyleByUserId(UserId:Integer):Style;
    {清空剪贴板}
    procedure ClearClipboard;
    {从GeoDataSet加载}
    procedure LoadMapFromGeoset(const FileName:string);
    {保存为GeoDataSet}
    procedure SaveMapAsGeoset(const FileName:string);
    {保存为图象格式}
    procedure SaveMapAsImage(ImageCfg:TMapImageConfig);
    {是否处于选择状态}
    function InSelectMode:Boolean;
    {取得单一选择图层}
    function GetSingleSelectedLayer:CMapXLayer;
    {取得工具对象}
    function GetToolObjectByToolId(const aToolId:Integer):TBaseMapTool;
    {取得当前工具对象}
    function GetCurrentToolObject:TBaseMapTool;
    //-------------------------------------------------------------------//
    {缩放到图层外接矩形}
    procedure ViewLayerMap(aLayer:CMapXLayer);
    {缩放到图层类}
    procedure ViewFeatureClass(AGroup:TFeatureClass);
    {全部显示}
    procedure ViewGlobalMap;
    {缩放到前图}
    procedure ViewBeforeMap;
    {缩放到初始图}
    procedure ViewInitMap;
    //-------------------------------------------------------------------//
    procedure SelectAll;
    procedure ClearSelection;
    procedure InvertSelection;
    //-------------------------------------------------------------------//
    function GetFirstSelectLayer:CMapXLayer;
    function Copy:Boolean;
    //-------------------------------------------------------------------//
    property MapX:TMapXObject read FMapX write FMapX;
    {系统动态图层}
    property AnimateLayer:CMapXLayer read FAnimateLayer write FAnimateLayer;
    {系统工具列表}
    property SysTools:TToolList read FSysTools;
    {用户工具列表}
    property UserTools:TToolList read FUserTools;
    {用户Style列表}
    property UserStyles:TStyleInfoList read FUserStyles;
    {系统Style列表}
    property SysStyles:TStyleInfoList read FSysStyles;
    {图形编辑模式}
    property FeatureEditMode:TFeatureEditMode read GetFeatureEditMode write SetFeatureEditMode;
  end;

  TMapBlock = class
    procedure SaveToStream(Stream:TStream);
    procedure LoadFromStream(Stream:TStream);
  end;

  TMapBlockList = class
  private
    FList:TList;
    function GetItemCount:Integer;
    function GetItem(Index:Integer):TMapBlock;
  public
    constructor Create;
    destructor Destroy;override;
    procedure Add(Value:TMapBlock);overload;
    function Add:TMapBlock;overload;
    procedure Insert(const Index:Integer;Value:TMapBlock);overload;
    function Insert(const Index:Integer):TMapBlock;overload;
    procedure Delete(const Index:Integer);
    procedure Clear;
    procedure LoadFromStream(Stream:TStream);
    procedure SaveToStream(Stream:TStream);
    property ItemCount:Integer read GetItemCount;
    property Items[Index:Integer]:TMapBlock read GetItem;
  end;
  {该类用于保存系统图层的连接信息}
  TMapLinkInfo = class
  private
    FLayer: CMapXLayer;
    FLayerName: string;
    FCaption: string;
  public
    procedure SaveToStream(Stream:TStream);
    procedure LoadFromStream(Stream:TStream);
    {图层名称}
    property LayerName:string read FLayerName write FLayerName;
    {标题}
    property Caption:string read FCaption write FCaption;
    {图层对象}
    property Layer:CMapXLayer read FLayer write FLayer;
  end;
  {该类用于保存系统图层列表信息}
  TMapLinkInfoList = class
  private
    FList:TList;
    function GetItemCount:Integer;
    function GetItem(Index:Integer):TMapLinkInfo;
  public
    constructor Create;
    destructor Destroy;override;
    procedure Add(Value:TMapLinkInfo);overload;
    function Add:TMapLinkInfo;overload;
    procedure Insert(const Index:Integer;Value:TMapLinkInfo);overload;
    function Insert(const Index:Integer):TMapLinkInfo;overload;
    procedure Delete(const Index:Integer);
    procedure Clear;
    procedure LoadFromStream(Stream:TStream);
    procedure SaveToStream(Stream:TStream);
    property ItemCount:Integer read GetItemCount;
    property Items[Index:Integer]:TMapLinkInfo read GetItem;
  end;
  {用户图形类：例如：公路、铁路、汽车、房屋等}
  TBusinessFeature = class
  private
    FFeatureName: string;
    FFeatureType: TShapeType;
    FStyleId: Integer;
  public
    procedure LoadFromStream(Stream:TStream);
    procedure SaveToStream(Stream:TStream);
    property FeatureName:string read FFeatureName write FFeatureName;
    property FeatureType:TShapeType read FFeatureType write FFeatureType;
    property StyleId:Integer read FStyleId write FStyleId;
  end;

  TBusinessFeatureList = class
  private
    FList:TList;
    function GetItemCount:Integer;
    function GetItem(Index:Integer):TBusinessFeature;
  public
    constructor Create;
    destructor Destroy;override;
    procedure Add(Value:TBusinessFeature);overload;
    function Add:TBusinessFeature;overload;
    procedure Insert(const Index:Integer;Value:TBusinessFeature);overload;
    function Insert(const Index:Integer):TBusinessFeature;overload;
    procedure Delete(const Index:Integer);
    procedure Clear;
    procedure LoadFromStream(Stream:TStream);
    procedure SaveToStream(Stream:TStream);
    property ItemCount:Integer read GetItemCount;
    property Items[Index:Integer]:TBusinessFeature read GetItem;
  end;

  TLayerConfigInfo=class
  private
    FLayerName: string;
    FTableName: string;
    FFeatureClassId: Integer;
    FFields: TMapFieldList;
    FFeatureListCanChanged: Boolean;
    FTableStructCanChanged: Boolean;
    FFeatureList: TBusinessFeatureList;
    FParams: TStrings;
    FIsSystem: Boolean;
  public
    constructor Create;
    destructor Destroy;override;
    {图层名称}
    property LayerName:string read FLayerName write FLayerName;
    {商业表名称}
    property TableName:string read FTableName write FTableName;
    {图形类编号，图形类是给一组具有相同业务属性的图层进行的归类}
    property FeatureClassId:Integer read FFeatureClassId write FFeatureClassId;
    {表结构是否可以变化}
    property TableStructCanChanged:Boolean read FTableStructCanChanged write FTableStructCanChanged;
    {字段列表，如果图形类允许异构表结构，则可以修改，否则不可以修改}
    property Fields:TMapFieldList read FFields;
    {支持的商业图形列表是否可以修改}
    property FeatureListCanChanged:Boolean read FFeatureListCanChanged write FFeatureListCanChanged;
    {支持的商业图形类型，如果图层类允许变动商业图形列表，则可以修改，否则不可以修改}
    property FeatureList:TBusinessFeatureList read FFeatureList;
    {图层参数}
    property Params:TStrings read FParams;
    {是否为系统图层}
    property IsSystem:Boolean read FIsSystem write FIsSystem;
  end;

  TLayerManager=class;
  
  TMapFeatureStoreManager=class(TStoreManager)
  private
    FFt: Feature;
    FStoreManager: TStoreManager;
    FFtType: Integer;
    FLayerManager: TLayerManager;
    FFontStyle: TFontStyleInfo;
    FLineStyle: TLineStyleInfo;
    FRegionStyle: TRegionStyleInfo;
    FSymBmpStyle: TSymbolBitmapStyleInfo;
    FSymFontStyle: TSymbolFontStyleInfo;
    FSymVertorStyle: TSymbolVectorSytleInfo;
    FFeatureStyle: CMapXStyle;
    procedure CreateRegionFromStream(Stream:TStream);
    procedure CreateLineFromStream(Stream:TStream);
    procedure CreateSymbolFromStream(Stream:TStream);
    procedure CreateTextFromStream(Stream:TStream);
    procedure CreateMultiPointFromStream(Stream:TStream);
    procedure SaveRegionToStream(Stream:TStream);
    procedure SaveLineToStream(Stream:TStream);
    procedure SaveSymbolToStream(Stream:TStream);
    procedure SaveTextToStream(Stream:TStream);
    procedure SaveMultiPointToStream(Stream:TStream);
    procedure SetFt(const Value: Feature);
  public
    constructor Create;
    destructor Destroy; override;
    procedure SaveToStream(Stream:TStream); override;
    procedure LoadFromStream(Stream:TStream); override;
    property Ft:Feature read FFt write SetFt;
    property FtType:Integer read FFtType write FFtType;
    property LayerManager: TLayerManager read FLayerManager write FLayerManager;
    property StoreManager: TStoreManager read FStoreManager;
  end;
  //图形事件//
  TMapXFeatureEvent=procedure (Sender:TObject; ActionId:Integer;
    Ft:Feature) of object;
  //图形集合事件//
  TMapXFeaturesEvent=procedure (Sender:TObject; ActionId:Integer;
    Fts:Features) of object;
  //选择集合事件//
  TMapXSelectionEvent=procedure (Sender:TObject; Sel:Selection) of object;
  //图形被删除前事件//
  TBeforeDeleteMapXFeature=procedure (Sender:TObject; Ft:Feature;
    ActionId:Integer; var Cancel:Boolean) of object;
  //标签位置//
  TLabelPosition=(lpCC, lpTL, lpTC,
                  lpTR, lpCL, lpCR,
                  lpBL, lpC,  lpBR);
  
  TLayerManager=class
  private
    FLayer: CMapXLayer;
    FMapManager: TMapManager;
    FOnCtrlPropDialog: TMapXFeatureEvent;
    FOnFeatureCreate: TMapXFeatureEvent;
    FBeforeDeleteFeature: TBeforeDeleteMapXFeature;
    function GetLabelPosition: TLabelPosition;
    procedure SetLabelPosition(const Value: TLabelPosition);
    function GetLabelStyle: Style;
    function GetMapX: TMapXObject;
    procedure ConfigParts(Dest, Source: CMapXParts);
  public
    constructor Create;
    destructor Destroy;override;
    //----------------------------------------------------------------------//
    {取得Style的COM对象}
    function GetStyleComObject(mstyle:OleVariant):Style;
    {用Style索引号取得Style接口对象}
    function GetStyleByUserId(UserId:Integer):Style;
    {设置图层的标注文本样式}
    procedure SetLabelStyle(AFontStyle:TFontStyleInfo);
    //----------------------------------------------------------------------//
    {增加图形}
    function AddFeature(ft:Feature; Rvs:OleVariant;
      ActionId:Integer):Feature;
    {增加点对象}
    function AddSymbol(const x, y: Double; mstyle:OleVariant;
      const Standalone:Boolean; ActionId:Integer):feature;
    {增加多点对象}
    function AddMultiPoint(Points:TMapPointList; mstyle:OleVariant;