List1.Clear
Combo1.Clear
For i = 1 To Map1.Layers.Count
    List1.AddItem Map1.Layers(i).Name
    Combo1.AddItem Map1.Layers(i).Name
    'Form2.Combo1.AddItem Map1.Layers(i).Name
Next i
End Sub

 'Dim buffer As Boolean
Private Sub area_Click()
    Map1.CurrentTool = miSelectTool
    Celiangorbuffer = 1 '觸發selectionchang事件來測量面積
End Sub

Private Sub Combo1_click()
'   Dim pnt As New Point, pnts As New Points
'   Dim ftr As Feature, ftrs As Features
   Dim lyr As Layer, rvs As MapXLib.RowValues
'   Dim infostr As String
   Dim flds As MapXLib.Fields
   Dim fld As MapXLib.Field
   Dim ds As MapXLib.Dataset
  Dim i As Integer
  Dim lyrname As String
  Dim ftrs As MapXLib.Features
  i = Combo1.ListIndex
  Combo2.Clear
  Set lyr = Map1.Layers.Item(i + 1)
  Set ftrs = lyr.AllFeatures
  Set ds = Map1.Datasets.Add(miDataSetLayer, lyr) '數據綁定
  For i = 1 To ftrs.Count
      Set rvs = ds.RowValues(ftrs.Item(i)) 'ftr對象的屬性數據
      lyrname = ds.Fields.Item(1).Name & ":" & rvs.Item(1).Value
      Combo2.AddItem lyrname
  Next i
End Sub

Private Sub Command1_Click() 'ok
   If List1.ListIndex = -1 Then
      MsgBox "請選擇一個圖層"
   Else
      If Map1.Layers.Item(List1.ListIndex + 1).Name = "buffer" Then
          Map1.Layers.Remove (List1.ListIndex + 1)
          listalllayers
          Pbuffer.Checked = False
          Celiangorbuffer = 4
      Else
         Map1.Layers.Remove (List1.ListIndex + 1)
          listalllayers
      End If
  End If
End Sub

Public Sub Command2_Click() 'ok
  Map1.CreateCustomTool infoTool, miToolTypePoint, miCrossCursor
  Map1.CurrentTool = infoTool '激活Toolused事件
End Sub

Private Sub Command5_Click()
  Form2.Show
End Sub

Private Sub end_Click()
  End
End Sub

Private Sub find_Click()
Dim ftrs As MapXLib.Features
 Dim lyr As MapXLib.Layer
 Dim FoundObj As FindFeature
 'Set Map1.Layers("排水結點").Find.RefineLayer = Map1.Layers("排水改")
Set lyr = Map1.Layers(Combo1.Text)
Set FoundObj = Map1.Layers(Combo1.Text).find.Search(List2.Text)
  'Set ftrs = lyr.Search(宿舍 = Text3.Text)
 lyr.Selection.Replace FoundObj
'Set FoundObj = Map1.Layers("宿舍").Find.Search(Text3.Text)
 'Set FoundObj = Map1.Layers("排水結點").Find.Search("02", "sc")


 'If (FoundObj.FindRC Mod 10 = 1) Then
  Map1.Zoom = 0.2
  Map1.CenterX = FoundObj.CenterX
  Map1.CenterY = FoundObj.CenterY
   'FoundObj.Style.RegionColor = RGB(255, 255, 255)
 'Else
   'MsgBox "No exact match found. " + Str$(FoundObj.FindRC)
  ' End If
End Sub

Private Sub Form_Load()
   With Map1
  .Height = 5000
  .Width = 8000
  .Left = 100
  .Top = 450
  End With
  SSTab1.Left = 8200
  SSTab1.Top = 650
  Frame2.Top = 5500
  Frame2.Left = 100
  Form1.WindowState = 2 '最大化窗體
' Map1.CreateCustomTool PolyRulerTool, miToolTypePoly, miCrossCursor
  listalllayers
End Sub

Private Sub line_Click()
   '將會激活ToolUsed事件
  Map1.CurrentTool = PolyRulerTool
  Text1.Text = ""
  PolyRulerToolBengused = True
End Sub

Private Sub List1_Click()  '分層顯示  ok
    If Option1.Value = True Then
        If List1.Selected(List1.ListIndex) = True Then
            Map1.Layers.Item(List1.ListIndex + 1).Visible = True
        End If
    Else
       If List1.Selected(List1.ListIndex) = True Then
          Map1.Layers.Item(List1.ListIndex + 1).Visible = False
       End If
    End If
End Sub

Private Sub litter_Click()
   Form2.Show
   
End Sub

Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
   Text1.Text = ""
   If Map1.CurrentTool = PolyRulerTool Then
    Map1.ConvertCoord x, Y, mousedownmapx, mousedownmapy, miScreenToMap '使屏幕坐標轉化為地圖坐標
   End If
    Text1.Text = ""
End Sub

Private Sub Map1_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single)
' Dim num As Double
' If RulerToolBengused Then '當調用了RulerTool工具后
'     If Map1.CurrentTool = PolyRulerTool Then  '調用自定義的畫折線工具
'        Map1.ConvertCoord x, Y, dblmapx, dblmapy, miScreenToMap '使屏幕坐標轉化為地圖坐標
'        Map1.MapUnit = miUnitMeter
'        num = Map1.Distance(mousedownmapx, mousedownmapy, dblmapx, dblmapy)
'        Text1.Text = Format(num, "###00.000") & "米"
'     End If
' End If
End Sub
Private Sub Map1_PolyToolUsed(ByVal ToolNum As Integer, ByVal Flags As Long, ByVal Points As Object, ByVal bShift As Boolean, ByVal bCtrl As Boolean, EnableDefault As Boolean)
 Dim pts As New MapXLib.Points
 Dim n As Integer, i As Integer
 Dim disSum As Double
 Dim Sum As Double
 Dim X1 As Double, X2 As Double, Y1 As Double, Y2 As Double
 Set pts = Points
 disSum = 0
 If Flags = miPolyToolEnd Then
    For i = 1 To pts.Count - 1
         X1 = pts.Item(i).x
         Y1 = pts.Item(i).Y
         X2 = pts.Item(i + 1).x
         Y2 = pts.Item(i + 1).Y
         Map1.MapUnit = miUnitMeter
         Sum = Map1.Distance(X1, Y1, X2, Y2)
        disSum = Sum + disSum
     Next i
   Text1.Text = Format(disSum, "####.000") & "米"
 End If
End Sub

Private Sub Map1_SelectionChanged()
Dim ftr As Feature, ftrBuffer As Feature
Dim Mydataset As Dataset
Dim Newstyle As MapXLib.Style
Dim Newftr As MapXLib.Feature
Dim lyr As Layer, selc As Selection
Dim x As String  '定義緩沖范圍值x
Dim str As String '判斷是否點到對象
Dim m As Integer '圖層序號
Sumarea = 0: str = ""
Select Case Celiangorbuffer   'Celiang面積 = 1
    Case 1
       For Each lyr In Map1.Layers
           For Each ftr In lyr.Selection
               Set lyr = ftr.Layer  'get layer which is related to the feature
               Set Mydataset = Map1.Datasets.Add(miDataSetLayer, lyr)
               Set rvs = Mydataset.RowValues(ftr)
               Sumarea = Sumarea + rvs.Item(3).Value
           Next
       Next
     If Sumarea = 0 Then
        Text2.Text = ""
    Else
        Text2.Text = Sumarea
    End If
    Case 2  'buffer分析 = 2 (創造一個新的圖層用來分析buffer,圖層在Form_load中)
        For Each lyr In Map1.Layers
           For Each ftr In lyr.Selection
           str = ftr.Name
           Next
        Next
        If str <> "" Then '有對象則緩沖，無對象就不反應
          x = InputBox$("請輸入緩沖區范圍（單位：米）", 輸入框)
             If x <> "" Then '如果按取消按鈕就不作緩沖區分析
                For Each lyr In Map1.Layers
                   For Each ftr In lyr.Selection '得到一個對象ftr
                      Set ftrfac = Map1.FeatureFactory
                      Set ftrBuffer = ftrfac.BufferFeatures(ftr, Val(x), miUnitMeter)
                        '得到一個獨立的緩沖區對象ftrbuffer
                   Next
               Next
              '  x = InputBox$("請輸入緩沖區范圍（單位：米）", 輸入框)
               Set Newftr = Newlyr.AddFeature(ftrBuffer)
                '將緩沖區對象ftrbuffer添加到新圖層中,并且返回一個和 ftrbuffer等價的對象Newftr
               Set Newstyle = Newftr.Style  '將Newftr的Style屬性對象付給style對象
               Newstyle.RegionColor = 0 '改變顏色
               '更新
              Map1.AutoRedraw = False '在作出更改前禁止地圖重繪
              Newlyr.Editable = True
             Set Newftr.Style = Newstyle '將改變后的style重新付給Newftr對象的Style屬性
             Newftr.Update True '此方法使用對 Feature 對象所作更改更新圖層
             Newlyr.Refresh  '此方法將從圖層刷新緩存
             Newlyr.Editable = False
             Map1.AutoRedraw = True
          End If
      End If
    End Select
End Sub

Public Sub Map1_ToolUsed(ByVal ToolNum As Integer, ByVal X1 As Double, ByVal Y1 As Double, ByVal X2 As Double, ByVal Y2 As Double, ByVal Distance As Double, ByVal Shift As Boolean, ByVal Ctrl As Boolean, EnableDefault As Boolean)
   Picture1.Cls
   Select Case ToolNum  '不同的工具都會調用此事件,用ToolNum來區分
          Case infoTool
              pnt.Set X1, Y1   '得到坐標為x1,y1的以點對象
              For Each lyr In Map1.Layers
                  Set ftrs = lyr.SearchAtPoint(pnt)
                  If ftrs.Count > 0 Then
                    Set ds = Map1.Datasets.Add(miDataSetLayer, lyr) '數據綁定
                    fieldstr = ds.Fields.Item(1).Name
                    Set rvs = ds.RowValues(ftrs.Item(1)) 'ftr對象的屬性數據
                    valuestr = rvs.Item(1).Value
                    Set ftr1 = ftrs.Item(1)  '保存對象,便于后面修改屬性數據
                     For i = 1 To ds.Fields.Count
                       infostr = ds.Fields.Item(i).Name & ":" & rvs.Item(i).Value
                       Picture1.Print infostr
'                       a(i) = ds.Fields.Item(i).Name
'                       ': b(i) = rvs.Item(i).Value
                      Next i
                   End If
               Next
   End Select
End Sub

Private Sub more_Click()
   Form2.Show
   Form2.Combo2.Enabled = False
End Sub

Private Sub modify_Click()
  Form2.Show
End Sub

Private Sub New_Click()  'ok
   Dim newlayername As String
   newlayername = InputBox("請輸入新層名(buffer出外)！", "newlayer")
   If newlayername <> "" Then
      Set newlayer = Map1.Layers.CreateLayer(newlayername) '已經添加到map1中了
      listalllayers
   End If
End Sub

Private Sub Open_Click()  'ok
  With CmD1
        .FileName = "*.gst"
        .DialogTitle = "打開文件"
        .Filter = "MapX GeoSet(*.gst)|*.gst"
        .CancelError = True
  End With
  CmD1.ShowOpen
  Map1.Geoset = CmD1.FileName
  listalllayers
End Sub

Private Sub Option1_Click() '分層顯示  ok
   If List1.ListIndex = -1 Then
      MsgBox "請選擇一個圖層"
   Else
      If List1.Selected(List1.ListIndex) = True Then
            Map1.Layers.Item(List1.ListIndex + 1).Visible = True
       End If
   End If
End Sub

Private Sub Option2_Click()  '分層顯示  ok
  If List1.ListIndex = -1 Then
     Option1.SetFocus
  Else
    If List1.Selected(List1.ListIndex) = True Then
            Map1.Layers.Item(List1.ListIndex + 1).Visible = False
    End If
  End If
End Sub

Private Sub pan_Click()
 Map1.CurrentTool = miPanTool

End Sub

Private Sub Pbuffer_Click()  'ok
 Dim ftrs As MapXLib.Features
 Map1.CurrentTool = miSelectTool
 Pbuffer.Checked = Not Pbuffer.Checked
  If Pbuffer.Checked Then
     Celiangorbuffer = 2  '通過調用selectionchange事件得到一個對象
     Set Newlyr = Map1.Layers.CreateLayer("buffer") '創造一個新的圖層，名為buffer
     listalllayers
  Else
    Set ftrs = Newlyr.AllFeatures
    For i = 1 To ftrs.Count
      Newlyr.DeleteFeature (i)
    Next i
     Celiangorbuffer = 0
     Map1.Layers.Remove ("buffer")
  End If
End Sub

Private Sub polyline_Click()
  '將會激活PolyToolUsed事件
  Map1.CurrentTool = PolyRulerTool
 RulerToolBengused = True 'RulerTool工具屏蔽
End Sub




Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
   Select Case Button.Index
          Case 1
              pan_Click
          Case 3
               'Map1.CurrentTool = miSelectTool
               'Celiangorbuffer = 4 '不調用selectionchang事件
          Case 4
               zoomin_Click
          Case 5
               zoomout_Click
          Case 2
   End Select
End Sub

Private Sub zoomin_Click()
  Map1.CurrentTool = miZoomInTool

End Sub

Private Sub zoomout_Click()
  Map1.CurrentTool = miZoomOutTool
End Sub