mapxapis.pas

此代码是关于mapgis的在

unit MapXAPIs;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
  Dialogs, MapXLib_TLB, OleCtrls, MapXBase, Registry, DB, ADODB, DBTools;

//-------------------------------------------------------------------------//
//                             视图显示　　　　　　　　　　　　　　　　　  //
//-------------------------------------------------------------------------//
procedure GoToFeature(MapX:TMapXObject; ft:Feature; bFill:Boolean;
  Seed:Double);
procedure GoToFeatures(MapX:TMapXObject; fts:Features; bFill:Boolean;
  Seed:Double);
procedure GoToSelection(MapX:TMapXObject; st:Selection);
procedure GoToLayers(MapX:TMapXObject);
procedure GoToLayer(MapX:TMapXObject; Lyr:Layer);
//-------------------------------------------------------------------------//
//                             图层设置　　　　　　　　　　　　　　　　　  //
//-------------------------------------------------------------------------//
//检测图层编辑状态//
procedure CheckLayerModifyState(ALyr:Layer);
//取得图层索引号//
function GetLayerIndex(MapX:TMapXObject; ALyr:Layer):Integer; overload;
//用图层名称取得索引号
function GetLayerIndex(MapX:TMapXObject; LayerName:string):Integer; overload;
//图层是否存在//
function LayerExists(MapX:TMapXObject; const LayerName:string):Boolean;
//-------------------------------------------------------------------------//
//                             选择管理　　　　　　　　　　　　　　　　　  //
//-------------------------------------------------------------------------//
//判断图形是否被选择//
function FeatureSelected(ft:Feature):Boolean;
//图层图形全部选择//
procedure SelectAll(MapX:TMapXObject; ALyr:Layer; const bAutoRefresh:Boolean=True); overload;
//地图图形全部选择//
procedure SelectAll(MapX:TMapXObject; const bAutoRefresh:Boolean=True); overload;
//选择图形集合//
procedure SelectFeatures(MapX:TMapXObject; ALyr:Layer; Fts:Features;
  const bAutoRefresh:Boolean=True);
//选择图形//
procedure SelectFeature(MapX:TMapXObject; Ft:Feature; const bAutoRefresh:Boolean=True);
//图层图形反选//
procedure InvertSelection(MapX:TMapXObject; ALyr:Layer; const bAutoRefresh:Boolean=True); overload;
//地图图形反选//
procedure InvertSelection(MapX:TMapXObject; const bAutoRefresh:Boolean=True); overload;
//图层取消选择//
procedure ClearSelection(MapX:TMapXObject; ALyr:Layer; const bAutoRefresh:Boolean=True); overload;
//地图取消选择//
procedure ClearSelection(MapX:TMapXObject; const bAutoRefresh:Boolean=True); overload;
//-------------------------------------------------------------------------//
//                             图形管理　　　　　　　　　　　　　　　　　  //
//-------------------------------------------------------------------------//
//平移图形//
//procedure OffestFeatures(fts:Features);
//删除所有图形//
procedure DeleteAllShapes(MapX:TMapXObject; ALyr:Layer; const bAutoRefresh:Boolean=True);
//是否可以增加点//
function ShapeCanAddPoint(Ft:Feature; PartIndex:Integer):Boolean;
//是否可是删除点//
function ShapeCanDeletePoint(Ft:Feature; PartIndex:Integer):Boolean;
//是否可以编辑点//
function ShapeCanEditPoint(Ft:Feature; PartIndex:Integer):Boolean;
//取得点//
function GetShapePoint(Ft:Feature; const PartIndex, PointIndex:Integer):Point;
//在Selction取得第一个指定类型的图元//
function GetFirstShapeInSelction(ASelection:Selection; const ShapeType:Integer):Feature;
//左对齐//
procedure AlignLeft(ASelection:Selection);
//右齐//
procedure AlignRight(ASelection:Selection);
//上齐//
procedure AlignTop(ASelection:Selection);
//下齐//
procedure AlignBottom(ASelection:Selection);
//居中齐//
procedure AlignCenter_X(ASelection:Selection);
procedure AlignCenter_Y(ASelection:Selection);
//平移//
procedure OffestShapes(ASelection:Selection; const dx, dy:Double);
//增加图形//
function AddCopyFeature(ToLayer:Layer; Ft:Feature; ds:CMapXDataSet;
  const bAddData:Boolean):Feature;
//-------------------------------------------------------------------------//
//                             样式设置　　　　　　　　　　　　　　　　    //
//-------------------------------------------------------------------------//
//设置样式//
function PickStyle(mstyle:OleVariant; const pm:TPickMethod):Boolean;
//设置地图样式//
function EditMapStyle(MapX:TMapXObject; const pm:TPickMethod;
  const bEffectAllLayers, bEffectAllFeatures:Boolean):Boolean;
//设置图层样式//
function EditLayerStyle(Lyr:Layer; const pm:TPickMethod;
  const bEffectAllFeatures:Boolean):Boolean;
//取得图形的PickMethod//
function GetFeaturePickMethod(ft:Feature):TPickMethod;
//把样式具体到每一个图元//
function EditFeatureStyle(ft:Feature):Boolean;
//自定义符号//
procedure LoadSymbolBitmap(const SourceFile, SymbolPath:string);
procedure LoadSymbolBitmaps(Files:TStrings; SymbolPath:string); overload;
procedure LoadSymbolBitmaps(UserPath:string; const ForceCopy:Boolean); overload;
//符号是否存在//
function SymbolBitmapExists(SymbolPath, SymbolName:string):Boolean;
//从线样式获取多边形线样式//
procedure ConfigLineStyleFromRegionStyle(ToStyle, FromStyle:Style);
//从多边形线样式获取线样式//
procedure ConfigRegionStyleFromLineStyle(ToStyle, FromStyle:Style);
//-------------------------------------------------------------------------//
//                             GeoDictionary 　　　　　　　　　　　　　　  //
//-------------------------------------------------------------------------//
//取得MapX路径//
function GetMapXPath:string;
//取得MapX图标路径//
function GetMapXBitmapPath:string;
//GeoDictionary，用于定位.DCT文件//
function GetGeoDictionaryFile:string;
function SetGeoDictionaryFile(const FileName:string):Boolean;
//SearchPaths，其值是缺省的数据目录，用于定位.GST文件或.TAB文件，可以是多个目录，之间用逗号隔开//
function GetGeoDictionaryFileSearchPath(List:TStrings):Boolean;
function SetGeoDictionaryFileSearchPath(List:TStrings):Boolean;
//-------------------------------------------------------------------------//
//                             结果集管理  　　　　　　　　　　　　　　　  //
//-------------------------------------------------------------------------//
function ToComFieldType(Value: TMapFieldType):Integer;
function ToMapFieldType(Value: Integer):TMapFieldType; overload;
function ToMapFieldType(Value: TDataType):TMapFieldType; overload;
procedure InitRowValuesFromStruct(Rvs:CMapXRowValues; FromFields:CMapXFields;
  ToDs:CMapXDataset);
function CreateRowValuesFromStruct(FromFields:CMapXFields;
  ToDs:CMapXDataset):CMapXRowValues;
function GetFeatureRowValues(Ft:Feature; ds:CMapXDataset):CMapXRowValues;
procedure InitRowValuesFromDataSet(rvs: TMapRowValueList; Fds:CMapXFields); overload;
procedure InitRowValuesFromDataSet(rvs: TMapRowValueList; RomateDS: TADOQuery); overload;
procedure LoadMapFields(Fds:CMapXFields; MapFields: TMapFieldList); overload;
procedure LoadMapFields(RomateDS: TADOQuery; MapFields: TMapFieldList); overload;
procedure CreateRomateTable(RomateDS: TADOQuery; const ADBType:TDBType;
  const TableName: string; MapFields: TMapFieldList);
//-------------------------------------------------------------------------//
//                             图形编辑　　　　　　　　　　　　　　　　　  //
//-------------------------------------------------------------------------//
//取得图形类型//
procedure GetShapeTypes(Fts:Features; List:TStrings);
//是否可以转换为线//
function CanRegionToLine(Fts:Features):Boolean;
//判断图形是否可以合并//
function CanCombine(Fts:Features):Boolean;
//合并图形，如果是多边形和线，则自动转化为线//
function CombineSelectedShapes(MapX:TMapXObject; ALyr:Layer):Feature;
//取得最近的点//
function GetNearestLine(Ft:Feature; const mX, mY, mW: Double; var PartIndex,
  PointIndex:Integer; var pt0:TAny2DPoint):Boolean;
//-------------------------------------------------------------------------//
//                             杂项设置　　　　　　　　　　　　　　　　　  //
//-------------------------------------------------------------------------//
function GetMethodGlobalAddress(Obj: TObject; const MethodName:string;
  var PMethod:TMethod):Boolean;

  
implementation

uses
  BusinessDialogs, WinFileSystem, StringOperations;

procedure GoToFeature(MapX:TMapXObject; ft:Feature; bFill:Boolean;
  Seed:Double);
var
  OldAutoRedraw:Boolean;
  Rect:CMapXRectangle;
begin
  if bFill then
  begin
    Rect:=CoRectangle.Create;
    case ft.type_ of
      miFeatureTypeSymbol:
        Rect.Set_(ft.Point.X-Seed, ft.Point.Y-Seed, ft.Point.X+Seed, ft.Point.Y+Seed);
      miFeatureTypeRegion,
      miFeatureTypeLine,
      miFeatureTypeText,
      miFeatureTypeMixed,
      miFeatureTypeMultipoint:begin
        Rect:=ft.Bounds;
        Rect.Set_(Rect.XMin-Seed, Rect.YMin-Seed, Rect.XMax+Seed, Rect.YMax+Seed);
      end;
    end;
    MapX.Bounds:=Rect;
  end
  else begin
    OldAutoRedraw:=MapX.AutoRedraw;
    try
      MapX.AutoRedraw := False;
      MapX.CenterX := ft.CenterX;
      MapX.CenterY := ft.CenterY;
    finally
      MapX.AutoRedraw := OldAutoRedraw;
      MapX.Refresh;
    end;
  end;
end;

procedure GoToFeatures(MapX:TMapXObject; fts:Features; bFill:Boolean;
  Seed:Double);
begin
  if fts.Count=1 then
    GoToFeature(MapX, fts.Item[1], True, Seed)
  else
    MapX.Bounds:=fts.Bounds;
end;

procedure GoToSelection(MapX:TMapXObject; st:Selection);
begin
  MapX.Bounds:=st.Bounds;
end;

procedure GoToLayers(MapX:TMapXObject);
begin
  MapX.Bounds := MapX.Layers.Bounds;
end;

procedure GoToLayer(MapX:TMapXObject; Lyr:Layer);
begin
  MapX.Bounds:=Lyr.Bounds;
end;

procedure CheckLayerModifyState(ALyr:Layer);
begin
  if ALyr=nil then
    WarningAbort('提示', '请选择要编辑的图层！');
  if not ALyr.Editable then
    WarningAbort('提示', '请设置图层为编辑状态！');
end;

function GetLayerIndex(MapX:TMapXObject; ALyr:Layer):Integer;
var
  i:Integer;
begin
  Result:=-1;
  for i:=1 to MapX.Layers.Count do
    if MapX.Layers.Item[i]=ALyr then
    begin
      Result:=i;
      Exit;
    end;
end;

function GetLayerIndex(MapX:TMapXObject; LayerName:string):Integer;
var
  i:Integer;
begin
  Result:=-1;
  for i:=1 to MapX.Layers.Count do
    if AnsiCompareText(MapX.Layers.Item[i].Name, LayerName)=0 then
    begin
      Result:=i;
      Exit;
    end;
end;

function LayerExists(MapX:TMapXObject; const LayerName:string):Boolean;
begin
  Result:=GetLayerIndex(MapX, LayerName)<>-1;
end;

function FeatureSelected(ft:Feature):Boolean;
var
  i:Integer;
  ALyr:Layer;
begin
  Result:=False;
  ALyr:=ft.Layer;
  for i:=1 to ALyr.Selection.Count do
    if ALyr.Selection.Item[i]=ft then
    begin
      Result:=True;
      Break;
    end;
end;

procedure SelectAll(MapX:TMapXObject; ALyr:Layer; const bAutoRefresh:Boolean);
var
  OldAutoRedraw:Boolean;
begin
  OldAutoRedraw:=MapX.AutoRedraw;
  if bAutoRefresh then
    MapX.AutoRedraw := False;
  ALyr.Selection.SelectAll(miSelectionNew);
  if bAutoRefresh then
  begin
    MapX.AutoRedraw := OldAutoRedraw;
    MapX.Refresh;
  end;
end;

procedure SelectAll(MapX:TMapXObject; const bAutoRefresh:Boolean);
var
  i:Integer;
  lyr:Layer;
  OldAutoRedraw:Boolean;
begin
  OldAutoRedraw:=MapX.AutoRedraw;
  if bAutoRefresh then
    MapX.AutoRedraw := False;
  for i:=1 to MapX.Layers.Count do
  begin
    lyr:=MapX.Layers.Item[i];
    if (lyr.Selectable)and(lyr.type_=miLayerTypeNormal)and(lyr.Visible) then
      lyr.Selection.SelectAll(miSelectionNew);
  end;
  if bAutoRefresh then
  begin
    MapX.AutoRedraw := OldAutoRedraw;
    MapX.Refresh;
  end;
end;

procedure SelectFeatures(MapX:TMapXObject; ALyr:Layer; Fts:Features; const bAutoRefresh:Boolean);
var
  OldAutoRedraw:Boolean;
begin
  OldAutoRedraw:=MapX.AutoRedraw;
  if bAutoRefresh then
    MapX.AutoRedraw := False;

  ALyr.Selection.ClearSelection;
  if Fts.Count>0 then
    ALyr.Selection.Add(Fts);

  if bAutoRefresh then
  begin
    MapX.AutoRedraw := OldAutoRedraw;
    MapX.Refresh;
  end;
end;

procedure SelectFeature(MapX:TMapXObject; Ft:Feature; const bAutoRefresh:Boolean=True);
var
  OldAutoRedraw:Boolean;
  ALyr:Layer;
begin
  ALyr:=Ft.Layer;
  if ALyr<>nil then
  begin
    OldAutoRedraw:=MapX.AutoRedraw;
    if bAutoRefresh then
      MapX.AutoRedraw := False;

    ALyr.Selection.ClearSelection;
    ALyr.Selection.Add(Ft);

    if bAutoRefresh then
    begin
      MapX.AutoRedraw := OldAutoRedraw;
      MapX.Refresh;
    end;
  end;
end;

procedure InvertSelection(MapX:TMapXObject; ALyr:Layer; const bAutoRefresh:Boolean);
var
  i:Integer;
  allfts:Features;
  myfts:Features;
  OldAutoRedraw:Boolean;
begin
  OldAutoRedraw:=MapX.AutoRedraw;
  if bAutoRefresh then
    MapX.AutoRedraw := False;
  allfts:=ALyr.AllFeatures;
  myfts:=ALyr.NoFeatures;
  for i:=1 to allfts.Count do
    if not FeatureSelected(allfts.Item[i]) then
      myfts.Add(allfts.Item[i]);
  ALyr.Selection.ClearSelection;
  ALyr.Selection.Add(myfts);
  if bAutoRefresh then
  begin
    MapX.AutoRedraw := OldAutoRedraw;
    MapX.Refresh;
  end;
end;

procedure InvertSelection(MapX:TMapXObject; const bAutoRefresh:Boolean);
var
  i:Integer;
  lyr:Layer;
  OldAutoRedraw:Boolean;
begin
  OldAutoRedraw:=MapX.AutoRedraw;
  if bAutoRefresh then
    MapX.AutoRedraw := False;
  for i:=1 to MapX.Layers.Count do
  begin
    lyr:=MapX.Layers.Item[i];
    if lyr.Selectable then
      InvertSelection(MapX, lyr);
  end;
  if bAutoRefresh then
  begin
    MapX.AutoRedraw := OldAutoRedraw;
    MapX.Refresh;
  end;
end;

procedure ClearSelection(MapX:TMapXObject; ALyr:Layer; const bAutoRefresh:Boolean);
var
  OldAutoRedraw:Boolean;
begin
  OldAutoRedraw:=MapX.AutoRedraw;
  if bAutoRefresh then
    MapX.AutoRedraw := False;
  ALyr.Selection.ClearSelection;
  if bAutoRefresh then
  begin
    MapX.AutoRedraw := OldAutoRedraw;
    MapX.Refresh;
  end;
end;

procedure ClearSelection(MapX:TMapXObject; const bAutoRefresh:Boolean);
var
  i:Integer;
  lyr:Layer;
  OldAutoRedraw:Boolean;
begin
  OldAutoRedraw:=MapX.AutoRedraw;
  if bAutoRefresh then
    MapX.AutoRedraw := False;
  for i:=1 to MapX.Layers.Count do
  begin
    lyr:=MapX.Layers.Item[i];
    if lyr.type_=miLayerTypeNormal then
      lyr.Selection.ClearSelection;
  end;
  if bAutoRefresh then
  begin
    MapX.AutoRedraw := OldAutoRedraw;
    MapX.Refresh;
  end;
end;

procedure DeleteAllShapes(MapX:TMapXObject; ALyr:Layer; const bAutoRefresh:Boolean);
var
  i:Integer;
  fts:Features;
  OldAutoRedraw:Boolean;
begin
  OldAutoRedraw:=MapX.AutoRedraw;
  if bAutoRefresh then
    MapX.AutoRedraw := False;
  fts:=ALyr.AllFeatures;
  for i:=fts.Count downto 1 do
    ALyr.DeleteFeature(fts.Item[i]);
  if bAutoRefresh then
  begin
    MapX.AutoRedraw := OldAutoRedraw;
    MapX.Refresh;
  end;
end;

function ShapeCanAddPoint(Ft:Feature; PartIndex:Integer):Boolean;
begin
  if not Ft.Layer.Editable then