i=lstLayers.ListIndex+1
Map1.Layers.MoveTolstLayers.ListIndex,i
Map1.Refresh
lstLayers.Clear
ForEachlyrInMap1.Layers
lstLayers.AddItemlyr.Name
Nextlyr
lstLayers.Selected（i）=True
EndIf
EndSub
实验五取消图层调入和动态跟踪层
1.实验目的
掌握取消图层调入
掌握动态跟踪层的使用
2.实验内容
‘取消图层调入，运行时设置Map.CancelAction=moCancelMap
添加一个command1按钮。
增加事件Command1_Click（）。
添加在运行时添加图层的代码
添加事件Map1_DrawingCanceled（）
PrivateSubMap1_DrawingCanceled（）
MsgBox"thelayer（orlayers）hasbeencanceled!
"
EndSub
‘TrackingLayer动态跟踪
DimptAsNewMapObjects2.Point
'convertthepointtomapcoordinates
Setpt=Map1.ToMapPoint（X,Y）
'addanewevent
Map1.TrackingLayer.AddEventpt,symIndex
实验六缓冲区
1.实验目的
掌握使用缓冲区功能
2.实验内容
PrivateSubForm_Load（）
Map1.TrackingLayer.SymbolCount=2
WithMap1.TrackingLayer.Symbol（0）
.SymbolType=moPointSymbol
.Style=moCircleMarker
.Color=moRed
.Size=3
EndWith
WithMap1.TrackingLayer.Symbol
（1）
.SymbolType=moFillSymbol
.Style=moGrayFill
.Color=moRed
.OutlineColor=moRed
EndWith
EndSub
PrivateSubMap1_AfterTrackingLayerDraw（ByValhDCAsstdole.OLE_HANDLE）
Dimsym1AsNewMapObjects2.Symbol
sym1.SymbolType=moFillSymbol
sym1.Style=moTransparentFill
sym1.OutlineColor=moBlack
Map1.DrawShapeMap1.FullExtent,sym1
EndSub
查看各顶点的M属性
地图数据：
ynroadsm.shp
DimlineAsNewMapObjects2.line
DimrecsAsNewMapObjects2.Recordset
DimrecCountAsInteger
DimiAsInteger
List1.Clear
Setrecs=Map1.Layers（0）.Records
recCount=recs.Count
Fori=0TorecCount-1
List1.AddItem"线段:
"&i+1
Setline=recs（"Shape"）.Value
outputMeasuresline
Nexti
PrivateSuboutputMeasures（aLineAsMapObjects2.line）
DimitemCountAsInteger
DimpartLineAsMapObjects2.Points
DimiAsInteger
ForEachpartLineInaLine.Parts
Fori=0TopartLine.Count-1Step1
'Noofverticesintotal
itemCount=itemCount+1
WithpartLine.Item（i）
List1.AddItem"Item:
"&i&","&itemCount&Chr（9）&"X:
"&Format（.X,
"##.00"）&Chr（9）&"Y:
"&Format（.Y,"#.00"）&Chr（9）&"M:
"&Format（.Measure,
"##.00"）
EndWith
Nexti
NextpartLine
EndSub
实验七控件坐标和地图坐标
1.实验目的
掌握控件坐标和地图坐标转化的一般方法
学习地图距离获取的一般方法
2.实验内容
1.控件坐标与地图坐标
添加数据Chinaprj.shp
PrivateSubMap1_MouseDown（ButtonAsInteger,ShiftAsInteger,XAsSingle,YAsSingle）
Form1.Refresh
Form1.CurrentX=0
Form1.CurrentY=200
Print"当前鼠标坐标X：
"&X&vbTab&vbTab&"Y:
"&Y
Print
DimptAsMapObjects2.Point
Setpt=Map1.ToMapPoint（X,Y）
Print"当前地图坐标X:
"&pt.X&vbTab&"Y:
"&pt.Y
Print
PrintMap1.Height&vbTab&vbTab&Map1.Width
EndSub
2.控件距离与地图距离
PrivateSubMap1_MouseDown（ButtonAsInteger,ShiftAsInteger,XAsSingle,YAsSingle）
DimmyplAsNewMapObjects2.Line
Setmypl=Map1.TrackLine
Map1.TrackingLayer.AddEventmypl,0
Print"地图距离为:
"&mypl.Length
Print"控件距离为:
"&Map1.FromMapDistance（mypl.Length）
EndSub
3.Projection
China.shp
PrivateSubCommand1_Click（）
DimmycsAsNewMapObjects2.GeoCoordSys
mycs.Type=moGeoCS_Beijing1954
DimmypjcsAsNewMapObjects2.ProjCoordSys
mypjcs.Type=moProjCS_Beijing1954GK_13
SetMap1.Layers（0）.CoordinateSystem=mycs
SetMap1.CoordinateSystem=mypjcs
EndSub
PrivateSubMap1_MouseDown（ButtonAsInteger,ShiftAsInteger,XAsSingle,YAsSingle）
DimmyptAsMapObjects2.Point
Setmypt=Map1.ToMapPoint（X,Y）
Text1.Text="Xis"&mypt.X&"Yis"&mypt.Y
EndSub
实验八地图投影
1.实验目的
掌握如何判断地图是否投影
掌握如何更改地图投影
2.实验内容
判断有没有投影
添加数据china和chinaprj调整顺序观察结果
PrivateSubCommand1_Click（）
DimmycorsysAsObject
DimmymaplayerAsMapObjects2.MapLayer
Setmymaplayer=Map1.Layers（0）
Setmycorsys=mymaplayer.CoordinateSystem
IfmycorsysIsNothingThen
MsgBox"图形为地理坐标系或地图参数未设置"
Else
Ifmycorsys.IsProjectedThen
MsgBox"图形为投影坐标系"
Printmymaplayer.CoordinateSystem.Type
Printmymaplayer.CoordinateSystem.Name
Printmymaplayer.CoordinateSystem.ReturnDescription
Text1.Text=mymaplayer.CoordinateSystem.ReturnDescription
EndIf
EndIf
EndSub
2．更改投影
添加数据country和world30
PrivateSubCommand1_Click（）
DimCSMapAsNewMapObjects2.ProjCoordSys
CSMap.Type=moProjCS_World_WinkelI
DimCSMapLayerAsNewMapObjects2.GeoCoordSys
CSMapLayer.Type=moGeoCS_WGS1984
SetMap1.Layers（0）.CoordinateSystem=CSMapLayer
SetMap1.Layers
（1）.CoordinateSystem=CSMapLayer
SetMap1.CoordinateSystem=CSMap
Map1.Extent=Map1.FullExtent
EndSub
PrivateSubCommand2_Click（）
DimCSMapAsNewMapObjects2.GeoCoordSys
CSMap.Type=moGeoCS_WGS1984
SetMap1.CoordinateSystem=CSMap
Map1.Extent=Map1.FullExtent
EndSub
PrivateSubCommand3_Click（）
DimCSMapAsNewMapObjects2.ProjCoordSys
CSMap.Type=moProjCS_World_Robinson
SetMap1.CoordinateSystem=CSMap
Map1.Extent=Map1.FullExtent
EndSub
3.投影转换，坐标转换
第一个图添加数据countryworld30china第二个图添加数据china
DimmyGTAsNewMapObjects2.GeoTransformation
DimgcsBJ54AsNewMapObjects2.GeoCoordSys
DimmyprjBJ54AsNewMapObjects2.ProjCoordSys
DimgcsWGS84AsNewMapObjects2.GeoCoordSys
DimmyPt1,myPt2AsNewMapObjects2.Point
PrivateSubForm_Load（）
'beginsomepredeclear
myprjBJ54.Type=moProjCS_Beijing1954GK_17
gcsBJ54.Type=moGeoCS_Beijing1954
gcsWGS84.Type=moGeoCS_WGS1984
SetmyGT.FromGeoCoordSys=gcsBJ54
SetmyGT.ToGeoCoordSys=gcsWGS84
myGT.Direction=moDirection_Forward
myGT.Name="BJ54_To_WGS1984"
myGT.Method=moMethod_PositionVector
myGT.SetParametermoParm_DeltaX,24
myGT.SetParametermoParm_DeltaY,-123
myGT.SetParametermoParm_DeltaZ,-94
myGT.SetParametermoParm_RotationX,-0.02
myGT.SetParametermoParm_RotationY,-0.25
myGT.SetParametermoParm_RotationZ,-0.13
myGT.SetParametermoParm_DeltaScale,1
'beginmap1
SetMap1.Layers（0）.CoordinateSystem=gcsWGS84
SetMap1.Layers
（1）.CoordinateSystem=gcsWGS84
SetMap1.Layers
（2）.CoordinateSystem=gcsWGS84
IfMap1.CoordinateSystemIsNothingThen
SetMap1.CoordinateSystem=gcsWGS84
EndIf
'beginmap2
SetMap2.Layers（0）.CoordinateSystem=gcsWGS84
IfMap2.CoordinateSystemIsNothingThen
SetMap2.CoordinateSystem=myprjBJ54
EndIf
EndSub
PrivateSubMap1_MouseDown（ButtonAsInteger,ShiftAsInteger,XAsSingle,YAsSingle）
SetmyPt1=Map1.ToMapPoint（X,Y）
Map1.TrackingLayer.AddEventmyPt1,0
SetmyPt2=Map2.CoordinateSystem.Transform（Map1.CoordinateSystem,myPt1,,myGT）
Map2.TrackingLayer.AddEventmyPt2,0
PrintmyPt1.X&"";myPt1.Y
PrintmyPt2.X&"";myPt2.Y
EndSub
实验九文件状态的查询
1.实验目的
掌握文件状态的查询的一般方法
2.实验内容
1.显示文件状态、复习动态加载数据
加载数据world30，拷贝china到程序运行目录
PrivateSubCommand1_Click（）
DimmyrcsAsNewMapObjects2.Recordset
DimmygeodsAsNewMapObjects2.GeoDataset
DimmydcAsNewMapObjects2.DataConnection
mydc.Databas
升级会员 