form1.frm

本软件系统是使用GIS控件MapX在Visual Basic集成开发环境下开发的具有基本GIS功能的一个例子程序,基本功能有:选择,放大,缩小,平移量距离,自动标注等.

      EndProperty
      BeginProperty Map.Layers.Layer1.LabelProperties.Style.SymbolFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "MS Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Map.Layers.Layer1.LabelProperties.Style.LineStyle=   1
      Map.Layers.Layer1.LabelProperties.Style.LineWidth=   1
      Map.Layers.Layer2.HasFileSpec=   -1  'True
      Map.Layers.Layer2.Skip=   0   'False
      Map.Layers.Layer2.Path=   "F:\China-Data\PRC_CTYB.TAB"
      Map.Layers.Layer2.Name=   "中国中小城市"
      Map.Layers.Layer2.Visible=   -1  'True
      Map.Layers.Layer2.Selectable=   -1  'True
      Map.Layers.Layer2.Editable=   0   'False
      Map.Layers.Layer2.ShowNodes=   0   'False
      Map.Layers.Layer2.ShowCentroids=   0   'False
      Map.Layers.Layer2.ShowLineDirection=   0   'False
      Map.Layers.Layer2.AutoLabel=   0   'False
      Map.Layers.Layer2.DrawLabelsAfter=   0   'False
      Map.Layers.Layer2.ZoomLayering=   -1  'True
      Map.Layers.Layer2.ZoomMin=   0
      Map.Layers.Layer2.ZoomMax=   5000
      Map.Layers.Layer2.DoOverrideStyle=   0   'False
      Map.Layers.Layer2.LabelProperties.LabelMax=   100
      Map.Layers.Layer2.LabelProperties.Overlap=   0   'False
      Map.Layers.Layer2.LabelProperties.Duplicate=   -1  'True
      Map.Layers.Layer2.LabelProperties.Offset=   2
      Map.Layers.Layer2.LabelProperties.LineType=   2
      Map.Layers.Layer2.LabelProperties.Zoom=   0   'False
      Map.Layers.Layer2.LabelProperties.ZoomMin=   0
      Map.Layers.Layer2.LabelProperties.ZoomMax=   10000
      Map.Layers.Layer2.LabelProperties.Visible=   -1  'True
      Map.Layers.Layer2.LabelProperties.Position=   5
      Map.Layers.Layer2.LabelProperties.Parallel=   -1  'True
      Map.Layers.Layer2.LabelProperties.LabelAlong=   1
      Map.Layers.Layer2.LabelProperties.PartialSegments=   0   'False
      Map.Layers.Layer2.LabelProperties.Style.TextFontBackColor=   16777215
      Map.Layers.Layer2.LabelProperties.Style.SymbolChar=   0
      BeginProperty Map.Layers.Layer2.LabelProperties.Style.TextFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "System"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      BeginProperty Map.Layers.Layer2.LabelProperties.Style.SymbolFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "MS Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Map.Layers.Layer2.LabelProperties.Style.LineStyle=   1
      Map.Layers.Layer2.LabelProperties.Style.LineWidth=   1
      Map.Layers.Layer3.HasFileSpec=   -1  'True
      Map.Layers.Layer3.Skip=   0   'False
      Map.Layers.Layer3.Path=   "F:\China-Data\PRC_HIWY.TAB"
      Map.Layers.Layer3.Name=   "中国高速公路"
      Map.Layers.Layer3.Visible=   -1  'True
      Map.Layers.Layer3.Selectable=   -1  'True
      Map.Layers.Layer3.Editable=   0   'False
      Map.Layers.Layer3.ShowNodes=   0   'False
      Map.Layers.Layer3.ShowCentroids=   0   'False
      Map.Layers.Layer3.ShowLineDirection=   0   'False
      Map.Layers.Layer3.AutoLabel=   0   'False
      Map.Layers.Layer3.DrawLabelsAfter=   0   'False
      Map.Layers.Layer3.ZoomLayering=   0   'False
      Map.Layers.Layer3.ZoomMin=   0
      Map.Layers.Layer3.ZoomMax=   0
      Map.Layers.Layer3.DoOverrideStyle=   0   'False
      Map.Layers.Layer3.LabelProperties.LabelMax=   100
      Map.Layers.Layer3.LabelProperties.Overlap=   0   'False
      Map.Layers.Layer3.LabelProperties.Duplicate=   0   'False
      Map.Layers.Layer3.LabelProperties.Offset=   2
      Map.Layers.Layer3.LabelProperties.LineType=   2
      Map.Layers.Layer3.LabelProperties.Zoom=   0   'False
      Map.Layers.Layer3.LabelProperties.ZoomMin=   0
      Map.Layers.Layer3.LabelProperties.ZoomMax=   10000
      Map.Layers.Layer3.LabelProperties.Visible=   -1  'True
      Map.Layers.Layer3.LabelProperties.Position=   2
      Map.Layers.Layer3.LabelProperties.Parallel=   -1  'True
      Map.Layers.Layer3.LabelProperties.LabelAlong=   1
      Map.Layers.Layer3.LabelProperties.PartialSegments=   0   'False
      Map.Layers.Layer3.LabelProperties.Style.TextFontBackColor=   16777215
      Map.Layers.Layer3.LabelProperties.Style.SymbolChar=   0
      BeginProperty Map.Layers.Layer3.LabelProperties.Style.TextFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "System"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      BeginProperty Map.Layers.Layer3.LabelProperties.Style.SymbolFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "MS Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Map.Layers.Layer3.LabelProperties.Style.LineStyle=   1
      Map.Layers.Layer3.LabelProperties.Style.LineWidth=   1
      Map.Layers.Layer4.HasFileSpec=   -1  'True
      Map.Layers.Layer4.Skip=   0   'False
      Map.Layers.Layer4.Path=   "F:\China-Data\prc.TAB"
      Map.Layers.Layer4.Name=   "prc"
      Map.Layers.Layer4.Visible=   -1  'True
      Map.Layers.Layer4.Selectable=   -1  'True
      Map.Layers.Layer4.Editable=   0   'False
      Map.Layers.Layer4.ShowNodes=   0   'False
      Map.Layers.Layer4.ShowCentroids=   0   'False
      Map.Layers.Layer4.ShowLineDirection=   0   'False
      Map.Layers.Layer4.AutoLabel=   0   'False
      Map.Layers.Layer4.DrawLabelsAfter=   0   'False
      Map.Layers.Layer4.ZoomLayering=   0   'False
      Map.Layers.Layer4.ZoomMin=   0
      Map.Layers.Layer4.ZoomMax=   0
      Map.Layers.Layer4.DoOverrideStyle=   0   'False
      Map.Layers.Layer4.LabelProperties.LabelMax=   100
      Map.Layers.Layer4.LabelProperties.Overlap=   0   'False
      Map.Layers.Layer4.LabelProperties.Duplicate=   -1  'True
      Map.Layers.Layer4.LabelProperties.Offset=   2
      Map.Layers.Layer4.LabelProperties.LineType=   0
      Map.Layers.Layer4.LabelProperties.Zoom=   0   'False
      Map.Layers.Layer4.LabelProperties.ZoomMin=   0
      Map.Layers.Layer4.LabelProperties.ZoomMax=   10000
      Map.Layers.Layer4.LabelProperties.Visible=   -1  'True
      Map.Layers.Layer4.LabelProperties.Position=   0
      Map.Layers.Layer4.LabelProperties.Parallel=   -1  'True
      Map.Layers.Layer4.LabelProperties.LabelAlong=   1
      Map.Layers.Layer4.LabelProperties.PartialSegments=   0   'False
      Map.Layers.Layer4.LabelProperties.Style.TextFontBackColor=   16777215
      Map.Layers.Layer4.LabelProperties.Style.SymbolChar=   0
      BeginProperty Map.Layers.Layer4.LabelProperties.Style.TextFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "System"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      BeginProperty Map.Layers.Layer4.LabelProperties.Style.SymbolFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "MS Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Map.Layers.Layer4.LabelProperties.Style.LineStyle=   1
      Map.Layers.Layer4.LabelProperties.Style.LineWidth=   1
      Map.NumericCoordSys.ProjectionInfo=   "Form1.frx":055A
      Map.DisplayCoordSys.ProjectionInfo=   "Form1.frx":068A
      Map.Zoom        =   5266.79999999998
      Map.CenterX     =   107.16155312434
      Map.CenterY     =   29.8409987333364
      FeatureEditMode =   1
   End
   Begin VB.Menu mnuFile 
      Caption         =   "文件"
      Begin VB.Menu mnuFileGrp 
         Caption         =   "打开..."
         Index           =   0
      End
      Begin VB.Menu mnuFileGrp 
         Caption         =   "-"
         Index           =   1
      End
      Begin VB.Menu mnuFileGrp 
         Caption         =   "退出"
         Index           =   2
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private Sub Form_Load()
    Dim lyr As MapXLib.Layer
    
    Map1.GeoSet = App.Path + "\mdb\prc.gst"
    Map1.Title = ""
    ' Add all layers to listbox
    For Each lyr In Map1.Layers
        If lyr.DataSets.Count = 0 Then
            Combo1.AddItem lyr.Name
            Map1.DataSets.Add miDataSetLayer, lyr, lyr.Name
            lyr.AutoLabel = True
        End If
    Next
    
    Map1.CreateCustomTool 1, miToolTypePoint, miIconCursor
    Combo1.ListIndex = 0
    Set lyr = Nothing
End Sub

Private Sub Form_Resize()
    Map1.Left = Me.ScaleLeft
    Map1.Width = Me.ScaleWidth
    Map1.Top = Me.ScaleTop + Toolbar1.Height + 20
    Map1.Height = Me.ScaleHeight
End Sub

Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

 Dim Lon As Double
 Dim lat As Double
 Dim fs As Features
 Dim pnt As New Point
 
 Set findLayer = Map1.Layers(Combo1.Text)
 
 If Map1.CurrentTool = 1 Then
   Map1.ConvertCoord X, Y, Lon, lat, miScreenToMap
   
   
   
   
   pnt.Set Lon, lat
   Set fs = Map1.Layers(Combo1.Text).SearchAtPoint(pnt)
   
   If fs.Count > 0 Then
    frmmap.PrcName = Trim(fs(1).KeyValue)
    frmmap.Show 1
   Else
     MsgBox "没找到哦！！！！", vbInformation + vbOKOnly, "提示"
   End If
 End If
 
End Sub

Private Sub mnuFileGrp_Click(Index As Integer)
    Select Case Index
    Case 0 '//打开
       
    Case 2 '//退出
        Unload Me
    Case Else
    End Select
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
    Select Case Button.Index
    Case 1 '//放大
        Map1.CurrentTool = miSelectTool
    
    Case 2 '//缩小
        Map1.CurrentTool = miZoomInTool
        
    Case 3 '//平移
        Map1.CurrentTool = miZoomOutTool
        
    Case 4
        Map1.CurrentTool = miPanTool
        
    Case 5
        Map1.CurrentTool = 1
        
    Case 7
        Call Map1.ZoomTo(5263, 113.3897, 30.97492)
        
'        MsgBox Map1.CenterX & Map1.CenterY
        
    Case Else
    End Select
    
End Sub