GIS小系统代码.docVIP

由于时间的原因，没时间写了，只实现了，放大，缩小漫游，划点线面，图例显示，御载图层，坐标实时跟踪显示等功能，其他的看着办吧{抄书也可以} Dim dc As New MapObjects2.DataConnection Dim lyr As New MapObjects2.MapLayer Dim fname As String Dim fnames() As String Dim flag As Integer Dim flagdian As Integer 做点标记 Dim flagline As Integer 线标记 Dim flagduo As Integer 多边形标记 Dim juxing As Integer 矩形标记 Dim p As MapObjects2.Point 划点变量 Dim pts As New MapObjects2.Points 定义点集,划点 Dim pts1 As New MapObjects2.Points 定义点集划线 Dim sym1 As New Symbol Dim g_line As New MapObjects2.Line 划线 Dim retenglej As MapObjects2.Rectangle 划矩形 Dim ployxing As New MapObjects2.Polygon Private Sub Form_Load() flag = -1 给Toba控件选择做标记 flagdian = -1 flagline = -1 flagduo = -1 juxing = -1 End Sub Private Sub GISOPENFILE_Click() dlg.Filter = *.shp|*.shp|*.dbf|*.dbf dlg.Flags = cdlOFNAllowMultiselect Or cdlOFNExplorer dlg.ShowOpen dlg.InitDir = CurDir dc.Database = dlg.InitDir If Not dc.Connect Then Exit Sub fname = dlg.FileName fnames() = Split(fname, Chr(0)) Max = UBound(fnames()) If Max 0 Then For i = 1 To Max Set lyr.GeoDataset = dc.FindGeoDataset(fnames(i)) Map1.Layers.Add lyr Map2.Layers.Add lyr Set lyr = Nothing Next i ElseIf Max = 0 Then fname = dlg.FileTitle Set lyr.GeoDataset = dc.FindGeoDataset(fname) Map1.Layers.Add lyr Map2.Layers.Add lyr Set lyr = Nothing End If End Sub Private Sub huadian_Click() flagdian = 1 End Sub Private Sub huaduobianxing_Click() flagduo = 1 End Sub Private Sub huajuxing_Click() juxing = 1 End Sub Private Sub huaxian_Click() flagline = 1 End Sub Private Sub legend1_AfterSetLayerVisible(Index As Integer, isVisible As Boolean) Map1.Refresh End Sub Private Sub Map1_AfterLayerDraw(ByVal Index As Integer, ByVal canceled As Boolean, ByVal hDC As stdole.OLE_HANDLE) legend1.setMapSource Map1 legend1.LoadLege