gis二次开发.docx
《gis二次开发.docx》由会员分享，可在线阅读，更多相关《gis二次开发.docx（21页珍藏版）》请在冰豆网上搜索。
gis二次开发
GIS的二次开发——使用pb调用mapx控件（原创）
///新建图层的函数
//wf_add_layer
oleobjectaLayer,lb_dataset,LayerInfo,Flds
ole_1.object.Geoset='H:
\water_pt_map.gst'
alayer=CreateOleObject
alayer.ConnectToNewObject（"MapX.Layer.5"）
LayerInfo=CreateOleObject
LayerInfo.ConnectToNewObject（"MapX.LayerInfo.5"）
Flds=CreateOleObject
Flds.ConnectToNewObject（"MapX.fields.5"）
Flds.AddStringField（"ID",12）
Flds.AddStringField（"Name",50）
//新建图层
LayerInfo.Type=6
LayerInfo.AddParameter（"NAME",'meteruse'）
LayerInfo.AddParameter（"Fields",Flds）
LayerInfo.AddParameter（"AUTOCREATEDATASET",1）
LayerInfo.AddParameter（"DATASETNAME","PT_WATER"）
alayer=ole_1.object.Layers.Add（LayerInfo,1）
//设置活动图层
ole_1.object.layers.animationlayer=alayer
//
//========================
//name:
wf_add_dot
//dec{3}ldc_x,ldc_y
//
//增加点的函数,分级别显示
//
//time:
20040924
//
//=======================
longll_f
//按照级别设置颜色
ifil_jb=1then
ole_1.object.DefaultStyle.SymbolCharacter=35
ole_1.object.DefaultStyle.SymbolFontColor=RGB（255,0,0）
ole_1.object.DefaultStyle.SymbolFont.Size=12
//ole_1.object.DefaultStyle.SymbolFont="MapSymbols"
ole_1.object.DefaultStyle.textFontColor=RGB（255,0,0）
ole_1.object.DefaultStyle.textFont.Size=12
ole_1.object.DefaultStyle.textFont="宋体"
elseifil_jb=2then
ole_1.object.DefaultStyle.SymbolCharacter=36
ole_1.object.DefaultStyle.SymbolFontColor=RGB（255,255,0）
ole_1.object.DefaultStyle.SymbolFont.Size=11
ole_1.object.DefaultStyle.textFontColor=RGB（255,255,0）
ole_1.object.DefaultStyle.textFont.Size=11
elseifil_jb=3then
ole_1.object.DefaultStyle.SymbolCharacter=37
ole_1.object.DefaultStyle.SymbolFontColor=RGB（255,127,0）
ole_1.object.DefaultStyle.SymbolFont.Size=10
ole_1.object.DefaultStyle.textFontColor=RGB（255,127,0）
ole_1.object.DefaultStyle.textFont.Size=10
endif
inti,n=1
oleobjectf,f2,lb_dataset,flds,rv
oleobjectaLayer
oleobjectm_point
lb_dataset=CreateOleObject
lb_dataset.ConnectToNewObject（"MapX.dataset.5"）
flds=CreateOleObject
flds.ConnectToNewObject（"MapX.fields.5"）
rv=CreateOleObject
rv.ConnectToNewObject（"MapX.rowvalue.5"）
alayer=CreateOleObject//（"mapx.layer.5"）
f=CreateOleObject
f2=CreateOleObject
m_point=CreateOleObject
alayer.ConnectToNewObject（"MapX.Layer.5"）
ll_f=f.ConnectToNewObject（"MapX.Feature.5"）
ll_f=f2.ConnectToNewObject（"MapX.Feature.5"）
ll_f=m_point.ConnectToNewObject（"MapX.point.5"）
aLayer=ole_1.object.layers.item（"meteruse"）
lb_dataset=aLayer.Datasets.Item（"PT_WATER"）
flds=lb_dataset.Fields
aLayer.LabelProperties.Dataset=lb_dataset
aLayer.LabelProperties.DataField=lb_dataset.Fields.Item（"id"）
aLayer.autolabel=true
aLayer.Editable=True
ifis_name<>""andnotisnull（is_name）then
ifil_same_f=1then//已经在地图上存在的移动坐标
f=aLayer.GetFeatureByKey（is_FeatureKey）
f.point.Set（adc_x,adc_y）
f.update（）
else//没有存在的增加之
ole_1.object.AutoRedraw=False
m_point.Set（adc_x,adc_y）
f=ole_1.object.featurefactory.createsymbol（m_point,ole_1.object.defaultstyle）
aLayer.KeyField=Flds.Item
（1）.Name
f.KeyValue=is_name
f2=aLayer.addfeature（f）
is_FeatureKey=f2.FeatureKey
il_same_f=1
endif
aLayer.Refresh
ole_1.object.AutoRedraw=true
endif
//=====================================
//name:
wf_delete_feature
//
//stringas_featruekey
//删除地图上的一个符号
//
//
//20040913
//===================================
oleobjectaLayer
alayer=CreateOleObject//（"mapx.layer.5"）
alayer.ConnectToNewObject（"MapX.Layer.5"）
aLayer=ole_1.object.layers（'meteruse'）
aLayer.DeleteFeature（as_featruekey）
aLayer.refresh
摘要本文介绍了VB中如何利用MapX创建用户定制地图工具，详细地说明了整个创建过程，以及在创建定制工具的过程中所使用的关键方法。
1.前言
随着地理信息系统的发展，国内外已出现了不少GIS（地理信息系统）软件，其中MapX是MapInfo公司的ActiveX控件产品。
由于它是一种基于Windows操作系统的标准控件，因而MapX4.0支持绝大多数标准的可视化开发环境，如：
VisualBasic，Delphi，PowerBuilder，VisualC++等面向对象语言，而且可以使用LotusScript将MapX4.0嵌入到LotusNotes中。
虽然MapX4.0提供了许多标准工具，可以直接使用，但是很多情况下，这些标准工具不能满足实际的需要，这就要求通过定制地图工具来规定工具能完成何种功能，例如画椭圆工具，标尺工具（测线段长度）等等。
下面，笔者就通过一具体实例来介绍一下VB中采用MapX4.0控件制作地图的定制工具。
2.VB环境下MapX编程
利用MapX4.0创建用户定制工具分为以下三步：
2.1创建定制工具
本例创建的是画椭圆工具。
首先，宣称全局常量miAddEllipseTool=1，1就代表了画椭圆这个工具。
然后，在主窗体中创建画椭圆工具。
关键方法（创建定制工具）：
OBJECT.CreateCustomTool（ToolNumber,Type,Cursor,[ShiftCursor],[CtrlCursor],[InfoTips]）
OBJECT（对象）：
Map对象；
ToolNumber（工具号）是创建出代表画椭圆工具的miAddEllipseTool；
Type（类型）：
描述了工具的行为，这个参数取的ToolTypeConstants（工具类型常量）值。
本例，工具是按下鼠标左键到弹上鼠标左键的过程中画椭圆。
本例中取的是miToolTypePoint；
Cursor（指针形状）：
使用该工具时，该工具在地图上显示的形状，该参数从CursorConstants（指针常量）中取值。
本例选用的是miCrossCursor，那么当选择该工具时，该工具将在地图上显示成十字叉形状；
ShiftCursor，CtrlCursor：
这两个参数是可选的，缺省情况时，SHIFT键和CTRL键不起作用；
InfoTips（工具提示）：
Boolean型。
如果要显示工具提示，需要将此参数设为true；缺省值为false。
实际编码：
PublicConstmiAddEllipseTool=1'定制的加椭圆工具
PublicRectX1AsDouble'新加椭圆（所需的矩形）的点1的X（经纬度）坐标
PublicRectY1AsDouble'新加椭圆（所需的矩形）的点1的Y（经纬度）坐标
PublicRectX2AsDouble'新加椭圆（所需的矩形）的点2的X（经纬度）坐标
PublicRectY2AsDouble'新加椭圆（所需的矩形）的点2的Y（经纬度）坐标
PrivateSubForm_Load（）'创建定制工具
Map1.CreateCustomToolmiAddEllipseTool,_
miToolTypePoint,miCrossCursor
EndSub
此时所创建的工具没有任何功能，要工具具备相应的功能由第二步实现。
2.2编写工具句柄（工具具备什么功能）。
当按下鼠标左键时，需要记下椭圆的起始位置；当鼠标右键弹上时，需要记下椭圆的结束位置，这时，画出椭圆。
椭圆将以这两点为矩形的对角线在矩形框中绘制椭圆。
需要特别注意的是，MapX4.0中使用的坐标系统是经/纬度系统，而MouseDOwn，MouseUp事件中的坐标是屏幕坐标，因此，需要将屏幕坐标转化为经/纬度坐标，所画椭圆才能显示在正确的位置上。
关键方法（绘制椭圆）：
OBJECT.CreateEllipticalRegion（Rectangle,[Angle],[Resolution],[Style]）
OBJECT:
FeatureFactory对象；
Rectangle（矩形）：
Rectangle对象，确定了椭圆的大小；
Angle（角度）：
变量，决定椭圆绕中心点旋转的角度；
Resolution（精度）：
变量，椭圆的精度，由多少点构成；
Style（样式）:
变量，定义了所画椭圆的样式，如颜色，线型等。
实际编码：
PrivateSubMap1_MouseDown（ButtonAsInteger,ShiftAsInteger,XAsSingle,YAsSingle）
IfButton=vbLeftButtonAnd（Map1.CurrentTool=miAddEllipseTool）Then
Map1.NumericCoordSys.SetmiLongLat,0
'将屏幕坐标转变为经纬度坐标
Map1.ConvertCoordX,Y,RectX1,RectY1,miScreenToMap
Endif
EndSub
PrivateSubMap1_MouseUp（ButtonAsInteger,ShiftAsInteger,XAsSingle,YAsSingle）
IfButton=vbLeftButtonAnd（Map1.CurrentTool=miAddEllipseTool）Then
'将地图的坐标系统设为经/纬度坐标
Map1.NumericCoordSys.SetmiLongLat,0
'将屏幕坐标转变为经纬度坐标
Map1.ConvertCoordX,Y,RectX2,RectY2,miScreenToMap
'鼠标弹起时，画椭圆
CallAddEllipse（form1,RectX1,RectY1,RectX2,RectY2）
Endif
Endsub
'画椭圆过程
PublicSubAddEllipse（frmAsForm,x1AsDouble,_
y1AsDouble,x2AsDouble,y2AsDouble,EditLayerAsVariant）
DimRECTAsNewMapXLib.Rectangle'画椭圆的矩形框
DimCreatedEllipseAsFeature'所画的椭圆
DimIasinteger,EditLayerasinteger
'设置画椭圆的矩形框
RECT.Setx1,y1,x2,y2
Withfrm.Map1
'创建椭圆
SetCreatedEllipse=.FeatureFactory._
CreateEllipticalRegion（RECT,,500,.DefaultStyle）
'确定哪一层是可编辑层，椭圆只能画在可编辑层上
ForI=1to.map1.layers.count
If.map1.layers（I）.editable=truethen
Editlayer=I
Exitfor
Endif
NextI
'将椭圆添加到所画的图层上
.Layers.Item（EditLayer）.AddFeatureCreatedEllipse
EndWith
EndSub
此时，画椭圆工具具备了画椭圆的功能，运用定制的这个工具由第三步实现。
2.3调用定制工具
'设置当前工具为定制的画椭圆工具
Map1.CurrentTool=miAddEllipse
或Map1.currenttool=1
3.结束语
本例画椭圆时，从鼠标按下，一直到鼠标最后弹起时才可以看到椭圆出现在地图上，这就是说在鼠标移动（MouseMove事件）时，从鼠标按下，到鼠标弹起的中间过程是看不到中间过程的椭圆出现的。
为了实现在鼠标移动时，也可以看到椭圆，那么需要在MouseMove事件中画椭圆，并且，每次画椭圆时删除掉前一次画的椭圆。
这样的运行结果就是看到，从鼠标按下，到鼠标弹起的过程中，随鼠标的移动而有了绘椭圆的变化过程。
另外，本文是以VB5为例，进行的编程，但对于其它语言，如VC++，Delphi等，编程思路和关键方法都是相同的。
上个月去天津做这个项目，加班加点忙乎过了十一，现在项目终于完成了第一阶段，可以闲下来总结一下了。
在做这个项目之前我只是自学了一个月的supermap，不过感觉gis这些东西都是大同小异，没什莫可怕；关键比较郁闷的是本来根本就是做.net，现在却要用vb实在太。
。
。
算了，赶鸭子上架，不会也得会呀！
其实本人对这个实在只能称得上一知半解，学的和用的一样多，不过还是给自己和别人留下点东西吧，也许会有帮助呢：
）
1，设置地图标题（Map1.Title）样式
在打开一个GeoSet时，会自动显示它的标题，如果你的GeoSet没有标题，它会自动添加一个标题。
你可以设置标题的样式，显示出最完美的地图
Map1.Title.Visible=False’是否可见
Map1.Title.Editable=False'是否可编辑
标题位置
Map1.Title.x=Map1.MapScreenWidth-50
Map1.Title.y=2
是否有边界
Map1.Title.Border=False
是否粗体
Map1.Title.TextStyle.TextFont.Bold=True
字体大小
Map1.Title.TextStyle.TextFont.Size=15
是否在文本周围绘制光晕
Map1.Title.TextStyle.TextFontHalo=True
控制文本是否显示背景色
Map1.Title.TextStyle.TextFontOpaque=False
是否在文本下绘制阴影
Map1.Title.TextStyle.TextFontShadow=True
2打开地图的两种方法
a,打开地图集
Map1.GeoSet=”C:
\aa.gst”
在地图集里，你可以给地图加颜色，加标注，限制标注的字体，颜色等。
这些只能保存到地图集，而不能保存到单一的图层里。
所以建议你把图层做成地图集，这样无论是打开还是显示都很方便。
b,打开图层
Fori=1ToUBound（Navigation_DefaultMap_Path）
Map2.Layers.AddNavigation_DefaultMap_Path（i）,i
Next
3添加数据集
mapx的地图和数据是分开的，你要想制作专题图，查看表的内容，取图元的数据，都要先添加数据集。
a,添加图层数据集
Setlyr=curMap.Layers（layerList.Text）
curMap.DataSets.AddmiDataSetLayer,lyr,lyr.Name
b,添加自定义数据集
以下函数是添加一个数据集，sqlstr 是sql语句，DsName是数据集的名称。
注意：
"orderno", 是我在数据库中取的数据集与地图图元的关联。
PrivateFunctionAddJDDs（sqlstrAsString,DsNameAsString）AsBoolean
DimIsRightAsBoolean
IsRight=False
'----------------------添加数据集
OnErrorGoToThemedCreate
'------------是否存在该数据集
DimdsAsMapXLib.Dataset
ForEachdsInMap1.DataSets
Ifds.Name=DsNameThen
Map1.DataSets.Remove（DsName）'删除数据集
ExitFor
EndIf
Next
Setds=Nothing
'------------------加载数据集----------------------------
DimCnAsNewADODB.Connection
DimCmdAsNewADODB.Command
DimrsAsNewADODB.Recordset
DimBindLyrAsNewBindLayer
Cn.CursorLocation=adUseClient
Cn.OpenConStr
SetCmd.ActiveConnection=Cn
Cmd.CommandText=sqlstr
rs.OpenCmd,,adOpenKeyset,adLockOptimistic
BindLyr.LayerType=miBindLayerTypeNormal
Ifrs.RecordCount<>0Then
Map1.DataSets.AddmiDataSetADO,rs,DsName,"orderno",,BindLyr
IsRight=True
Else
MsgBox"无法显示数据,请检查数据是否为空?
"
IsRight=False
EndIf
rs.Close
Setrs=Nothing
Cn.Close
SetCn=Nothing
SetCmd=Nothing
SetBindLyr=Nothing
AddJDDs=IsRight
ExitFunction
'-------------------------------------------------------------------
ThemedCreate:
MsgBox"加载数据集出错！
请检查数据是否正确?
"&Err.Description
升级会员 