⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 mapxcontainer.pas

📁 此代码是关于mapgis的在
💻 PAS
📖 第 1 页 / 共 5 页
字号:
      const Standalone:Boolean; ActionId:Integer):feature; overload;
    function AddMultiPoint(Points:CMapXPoints; mstyle:OleVariant;
      const Standalone:Boolean; ActionId:Integer):feature; overload;
    {增加线对象}
    function AddLine(const x1, y1, x2, y2: Double; mstyle:OleVariant;
      const Standalone:Boolean; ActionId:Integer):feature; overload;
    function AddLine(Parts:TMapPartList; mstyle:OleVariant;
      const Standalone:Boolean; ActionId:Integer):feature; overload;
    function AddLine(Parts:CMapXParts; mstyle:OleVariant;
      const Standalone:Boolean; ActionId:Integer):feature; overload;
    {增加圆对象}
    function AddCircle(const x, y, r: Double;
      mstyle:OleVariant; const Standalone:Boolean; ActionId:Integer):feature;
    {增加矩形线框}
    function AddRectLine(const x1, y1, x2, y2: Double;
      mstyle:OleVariant; const Standalone:Boolean; ActionId:Integer):feature;
    {增加圆形区域}
    function AddCircleRegion(const x, y, r: Double;
      mstyle:OleVariant; const Standalone:Boolean; ActionId:Integer):feature;
    {绘制正多边形区域}
    function AddSRegion(const x, y, r:Double; const s:Integer;
      mstyle:OleVariant; const Standalone:Boolean; ActionId:Integer):feature;
    {绘制CircularRegion}
    function AddCircularRegion(const _Type:Smallint;
      const x, y, r:Double; const s:Integer;
      mstyle:OleVariant; const Standalone:Boolean; ActionId:Integer):feature;
    {增加椭圆对象}
    function AddEllipticalRegion(const x1, y1, x2, y2:Double;
      const s:Integer; mstyle:OleVariant; const Standalone:Boolean;
      ActionId:Integer):feature;
    {增加矩形面对象}
    function AddRectangle(const x1, y1, x2, y2: Double; const Caption:string;
      mstyle:OleVariant; const Standalone:Boolean; ActionId:Integer):feature;
    {增加多边形对象}
    function AddRegion(Parts:TMapPartList; mstyle:OleVariant;
      const Standalone:Boolean; ActionId:Integer):feature; overload;
    function AddRegion(Parts:CMapXParts; mstyle:OleVariant;
      const Standalone:Boolean; ActionId:Integer):feature; overload;
    {创建动态文字对象,动态文字对象可以编辑}
    function AddText(const x, y: Double; const Caption:string;
      mstyle:OleVariant; const Standalone:Boolean; ActionId:Integer):feature;
    {插入图块}
    procedure AddBlock(const FileName:string);
    {从结果集加载图形}
    function LoadFeaturesFromDataSet(RomateDS: TCustomADODataSet;
      LocalDS:CMapXDataSet; MapFields:TMapFieldList):CMapXLayer;
    {保存到结果集}
    procedure SaveFeaturesToDataSet(RomateDS: TCustomADODataSet;
      LocalDS:CMapXDataSet; MapFields:TMapFieldList);
    {保存图层到表}
    procedure SaveFeaturesToTable(RomateDS:TADOQuery; LocalDS:CMapXDataSet;
      const ADBType:TDBType; const TableName:string);
    {从表加载图形}
    procedure LoadFeaturesFromTable(RomateDS:TADOQuery;
      const TableName:string; MapFields:TMapFieldList);
    //----------------------------------------------------------------------//
    {区域转为线框}
    function AddLineFromRegion(fts:Feature; mstyle:OleVariant):feature;
    procedure AddLinesFromSelectedRegions;
    {线框转为区域}
    function AddRegionFromLine(fts:Feature; mstyle:OleVariant):feature;
    procedure AddRegionsFromSelectedLines;
    //----------------------------------------------------------------------//
    {图形是否相交}
    function TestCross(fts1, fts2: Feature):Boolean;
    {取得图形交点坐标}
    function GetCrossPoint(fts1, fts2: Feature):Feature;
    //----------------------------------------------------------------------//
    {全选}
    procedure SelectAll;
    {取消选择}
    procedure UnSelectAll;
    {反选}
    procedure InvertSelection;
    //----------------------------------------------------------------------//
    {复制}
    procedure Copy;
    {剪切}
    procedure Cut;
    {粘贴}
    procedure Paste;
    {删除图形}
    procedure DeleteFeature(ft:Feature; ActionId:Integer);
    {删除选择图形}
    procedure DeleteSelectedFeatures;
    {删除所有图形}
    procedure DeleteAllFeatures;
    {A+B运算}
    function CombineSelectedShapes:Feature;
    {切断区域或线}
    procedure BreakFeatureLineOrRegion(sFt:Feature); overload;
    procedure BreakFeatureLineOrRegion(sFts:Features); overload;
    {分解运算}
    procedure SeparateFeature(ft:Feature);
    {紧缩图层
      miPackGraphics = $00000001;
      miRebuildGraphics = $00000002;
      miPackIndex = $00000004;
      miRebuildIndex = $00000008;
      miPackData = $00000010;
      miPackCompactDB = $00000020;
      miPackAll = $00000015;}
    procedure Pack(const PackType:Integer);
    //----------------------------------------------------------------------//
    {显示属性对话框}
    procedure ShowPropDialog(Ft:Feature);
    //----------------------------------------------------------------------//
    {是否有结果集}
    function HasDataSet:Boolean;
    {是否存在TAB结果集}
    function GetTABDataSet:CMapXDataSet;
    {给图层关联TAB结果集}
    procedure AddTABDataSet(const ADataSetName:string);
    {给图层关联ADO结果集}
    procedure AddADODataSet(const KeyFieldName:string; AQueryObj:TADOQuery);
    //----------------------------------------------------------------------//
    {地图管理者}
    property MapManager:TMapManager read FMapManager write FMapManager;
    {地图对象}
    property MapX:TMapXObject read GetMapX;
    {当前编辑的图层}
    property Layer:CMapXLayer read FLayer write FLayer;
    {标注文本样式}
    property LabelStyle:Style read GetLabelStyle;
    {标注位置}
    property LabelPosition:TLabelPosition read GetLabelPosition
      write SetLabelPosition;
    {分析图形、创建属性对话框}
    property OnCtrlPropDialog:TMapXFeatureEvent read FOnCtrlPropDialog
      write FOnCtrlPropDialog;
    {删除图形前}
    property BeforeDeleteFeature:TBeforeDeleteMapXFeature
      read FBeforeDeleteFeature write FBeforeDeleteFeature;
    {粘贴每一个图形触发的事件}
    property OnFeatureCreate:TMapXFeatureEvent read FOnFeatureCreate
      write FOnFeatureCreate;
  end;
  
  TLayersManager=class
  private
    FMapX: TMapXObject;
    function GetActiveLayer: CMapXLayer;
    procedure SetActiveLayer(const Value: CMapXLayer);
    procedure InitComFields(Flds:Fields; MapFields:TMapFieldList);
  protected
    property MapX:TMapXObject read FMapX write FMapX;
  public
    procedure GetLayerNames(List:TStrings);
    {从文件创建图层}
    function CreateLayerFromFile(const LayerName, FileName:string;
      const Index:Integer; const bAddData:Boolean):CMapXLayer;
    {从文件创建一组图层}
    procedure CreateLayersFromFiles(List:TStrings; const FromIndex:Integer;
      const bAddData:Boolean);
    {创建默认临时图层}
    function CreateDefaultTempLayer(const LayerName:string;
      const Index:Integer):CMapXLayer;
    {创建一般临时图层}
    function CreateCustomTempLayer(const LayerName:string;
      MapFields:TMapFieldList; const Index:Integer;
      const bAddData:Boolean):CMapXLayer;
    {创建永久图层}
    function CreateCustomTableLayer(const LayerName, FilePath:string;
      MapFields:TMapFieldList; const Index:Integer;
      const bAddData:Boolean):CMapXLayer;
    {从结果集创建标记图层,该结果集中存储着标记的X、Y、商业数据}
    function CreateSymbolLayerFromDataSet(const LayerName, DataSetName,
      XFieldName, YFieldName, KeyFieldName, TabFileName:string;
      DS:TCustomADODataSet):CMapXLayer;
    function CreateNormalLayerFromDataSetAndLayer(const LayerName, DataSetName,
      KeyFieldName:string; DS:TCustomADODataSet):CMapXLayer;
    {从结果集和本地图层数据创建标记图层,该结果集中存储着标记的商业数据,图层
    中存储着标记的X、Y、样式。注意图层数据中所有图形都将显示出来,对于没有记录
    的标记,其商业数据为空白记录。}
    function CreateSymbolLayerFromDataSetAndLayer(const LayerName, DataSetName,
      RefColumn, KeyFieldName, TabFileName:string; DS:TCustomADODataSet):CMapXLayer;
    {创建内存图层}
    function CreateUserDrawLayer(const LayerName:string):CMapXLayer;
    {保存图层}
    function CopyLayer(ALyr:Layer; const DataSetIndex:Word;
      const FileName:string; const StructOnly:Boolean;
      const Index:Integer; const bAddData:Boolean;
      const AddFtsType:Integer):CMapXLayer;
    {将一个图层的数据加入到另一个图层,前提条件:属性表结构相同}
    procedure UnionFeature(ToLayer, FromLayer:Layer; const DataSetIndex:Word;
      const strWhere:string; const AddFtsType:Integer);
    {用名称取得图层的索引号}
    function IndexByName(const LayerName:string):Integer;
    {用名称取得图层对象}
    function FindByName(const LayerName:string):CMapXLayer;
    {用图层对象索引}
    function IndexByLayer(ALyr:Layer):Integer;
    {移出所有图层}
    procedure RemoveAll;
    {移出指定图层}
    procedure Remove(const Index:Integer);
    {用名称移出图层}
    procedure RemoveByName(const LayerName:string);
    {移动图层}
    procedure Move(const FromIndex, ToIndex:Integer);
    procedure MoveToTop(const Index:Integer);
    procedure MoveToBottom(const Index:Integer);
    {合并图层}
    procedure Merge(const LayerIndexes:string);
    {压缩图层}
    procedure Pack(const PackType:Integer);
    {活动图层}
    property ActiveLayer:CMapXLayer read GetActiveLayer write SetActiveLayer;
  end;

  TFeatureClass=class
  private
    FFeatureListCanChanged: Boolean;
    FTableStructCanChanged: Boolean;
    FFeatureClassName: string;
    FFields: TMapFieldList;
    FFeatureList: TBusinessFeatureList;
    FParams: TStrings;
    FScript: string;
  public
    constructor Create;
    destructor Destroy;override;
    {从流加载配置}
    procedure LoadFromStream(Stream:TStream);
    {保存配置到流}
    procedure SaveToStream(Stream:TStream);
    {图形类名称}
    property FeatureClassName:string read FFeatureClassName
      write FFeatureClassName;
    {描述信息}
    property Script:string read FScript write FScript;
    {表结构是否可以变化}
    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;
  end;
  
  TFeatureClassList=class
  private
    FList:TList;
    function GetItemCount:Integer;
    function GetItem(Index:Integer):TFeatureClass;
  public
    constructor Create;
    destructor Destroy;override;
    procedure Add(Value:TFeatureClass);overload;
    function Add:TFeatureClass;overload;
    procedure Insert(const Index:Integer;Value:TFeatureClass);overload;
    function Insert(const Index:Integer):TFeatureClass;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]:TFeatureClass read GetItem;
  end;
  {所有地图控制工具的管理者类,使那些零散的地图控制类集中到一起,
  便于调用}
  TMapCtrlTools=class(TComponent)
  private
    FMapX: TMapXObject;
    Fm_Layers: TLayersManager;
    Fm_Map: TMapManager;
    Fm_Layer: TLayerManager;
    procedure SetMapX(const Value: TMapXObject);
  protected
    procedure RegisterSymbols;
  public
    constructor Create(AOwner:TComponent);override;
    destructor Destroy;override;
    {MapX控件}
    property MapX:TMapXObject read FMapX write SetMapX;
    {地图控制类}
    property m_Map:TMapManager read Fm_Map;
    {图层控制类}
    property m_Layer:TLayerManager read Fm_Layer;
    {图层列表控制类}
    property m_Layers:TLayersManager read Fm_Layers;
  end;

implementation

uses
  BusinessDialogs, StreamIOAPIs, WinFileSystem, MapXAPIs;

  
{ TMapManager }

constructor TMapManager.Create;
begin
  inherited Create;

  FUserStyles:=TStyleInfoList.Create;
  FSysStyles:=TStyleInfoList.Create;

  FSysTools:=TToolList.Create;
//  FSysTools.MapManager := Self;

  FUserTools:=TToolList.Create;
//  FUserTools.MapManager := Self;

  FAddFeatureToolUsedEventProces:=TObjectMethodList.Create;
  FAnnotationAddedEventProces:=TObjectMethodList.Create;
  FAnnotationChangedEventProces:=TObjectMethodList.Create;
  FClickEventProces:=TObjectMethodList.Create;
  FDataMismatchEventProces:=TObjectMethodList.Create;
  FDblClickEventProces:=TObjectMethodList.Create;

  FDrawUserLayerEventProces:=TObjectMethodList.Create; 
  FMouseDownEventProces:=TObjectMethodList.Create;
  FMouseMoveEventProces:=TObjectMethodList.Create;
  FMouseUpEventProces:=TObjectMethodList.Create;
  FMouseWheelEventProces:=TObjectMethodList.Create;
  FRequestDataEventProces:=TObjectMethodList.Create;
  FResolveDataBindEventProces:=TObjectMethodList.Create;
  FResolveDataBindExEventProces:=TObjectMethodList.Create;
  FSelectionChangedEventProces:=TObjectMethodList.Create;
  FStartDragEventProces:=TObjectMethodList.Create;
  FThemeModifyRequestedEventProces:=TObjectMethodList.Create;
  FToolUsedEventProces:=TObjectMethodList.Create;
  FSelectionDeletedEventProces:=TObjectMethodList.Create;
end;

destructor TMapManager.Destroy;
begin
  if MapX<>nil then
  begin
    MapX.OnKeyDown:=nil;
    MapX.OnKeyPress:=nil;
    MapX.OnKeyUp:=nil;
    
    MapX.OnMouseDown:=nil;
    MapX.OnMouseMove:=nil;
    MapX.OnMouseUp:=nil;

    MapX.OnDragDrop:=nil;
    MapX.OnDragOver:=nil;
    MapX.OnEndDrag:=nil;

    MapX.OnEnter:=nil;
    MapX.OnExit:=nil;
  end;

  FAddFeatureToolUsedEventProces.Free;
  FAnnotationAddedEventProces.Free;
  FAnnotationChangedEventProces.Free;
  FClickEventProces.Free;
  FDataMismatchEventProces.Free;
  FDblClickEventProces.Free;

  FDrawUserLayerEventProces.Free;
  FMouseDownEventProces.Free;
  FMouseMoveEventProces.Free;
  FMouseUpEventProces.Free;
  FMouseWheelEventProces.Free;
  FRequestDataEventProces.Free;
  FResolveDataBindEventProces.Free;
  FResolveDataBindExEventProces.Free;
  FSelectionChangedEventProces.Free;
  FStartDragEventProces.Free;
  FThemeModifyRequestedEventProces.Free;
  FToolUsedEventProces.Free;
  FSelectionDeletedEventProces.Free;

  FSysTools.Free;
  FUserTools.Free;

  FUserStyles.Free;
  FSysStyles.Free;
  
  inherited Destroy;
end;

procedure TMapManager.DoMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  i:Integer;
  pProc:TMouseEvent;
begin
  for i:=0 to FMouseDownEventProces.Count-1 do
  begin
    pProc:=TMouseEvent(FMouseDownEventProces.Items[i].Method);
    pProc(Sender, Button, Shift, X, Y);
  end;
end;

procedure TMapManager.DoMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  i:Integer;
  pProc:TMouseMoveEvent;
begin
  for i:=0 to FMouseMoveEventProces.Count-1 do
  begin
    pProc:=TMouseMoveEvent(FMouseMoveEventProces.Items[i].Method);
    pProc(Sender, Shift, X, Y);
  end;
end;

procedure TMapManager.DoMouseUp(Sender: TObject; Button: TMouseButton;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -