Dim i As Layer
Dim f As Feature
Dim parnode As Node
TreeView1.Nodes.Clear
For Each i In Map1.Layers
If i.Selection.Count > 0 Then
Set parnode = TreeView1.Nodes.Add(, , i.Name, i.Name)
parnode.Expanded = True
For Each f In i.Selection
TreeView1.Nodes.Add parnode, tvwChild, parnode.Key & f.Name, f.Name
Next
End If
Next
End Sub



Private 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)
Select Case ToolNum
Case AREATOOLSEARCH
On Error Resume Next
Map1.MapUnit = miUnitMeter
Dim ftrs As Features
Dim Pt As New Point
Dim a As Double, i As Integer
TreeView1.Nodes.Clear
a = InputBox("請輸入查詢范圍的半徑（單位：米）", "范圍查詢")
If a = 0 Then Exit Sub
Pt.Set x1, y1
For i = 1 To Map1.Layers.Count
Set ftrs = Map1.Layers(i).SearchWithinDistance(Pt, a, miUnitMeter, miSearchTypePartiallyWithin)
Map1.Layers(i).Selection.Replace ftrs
Next
End Select

End Sub

Private Sub Map2_MapInitialized()
Set Map2.Bounds = Map2.Layers.Bounds
End Sub


Private Sub mbsearch_Click()
Dim lyR As Layer
Dim findobj As MapXLib.Find
Dim a As String
Dim i As Integer
Dim Fdat As FindFeature
Dim layerds As Dataset
Dim fid As MapXLib.Field
On Error Resume Next
TreeView1.Nodes.Clear
For Each lyR In Map1.Layers
Map1.DataSets.Add miDataSetLayer, lyR, lyR.Name
Next
a = InputBox("請輸入模糊查詢目標", "模糊查詢")
For i = 1 To Map1.Layers.Count
Set findobj = Map1.Layers(i).Find
Set layerds = Map1.DataSets.Item(Map1.Layers(i).Name)
Dim X As MapXLib.Field
Set findobj.FindDataset = Formmain.Map1.DataSets(Map1.Layers(i).Name)
For Each fid In layerds.Fields
Set findobj.FindField = findobj.FindDataset.Fields(fid)
Set Fdat = findobj.Search(a)
Map1.Layers(i).Selection.Replace Fdat
Next
Next
'If Fdat = Null Then MsgBox "沒有找到任何數據！", , "提示"
Formmain.Map1.DataSets.RemoveAll
End Sub

Private Sub menuexit_Click()
End
End Sub

Private Sub menulayerbz_Click()
Form3.Show
End Sub

Private Sub menulayercontrol_Click()
Map1.Layers.LayersDlg
Map1.Refresh
End Sub

Private Sub menulayeropen_Click()
Dim sfile As String
With CM1
On Error Resume Next
.DialogTitle = "加載圖層"
.Filter = "MapInfo Tables (*.tab)|*.tab"
.CancelError = True
.ShowOpen
   If Err.Number = 32755 Then Exit Sub
sfile = .filename
End With
If Map1.GeoSet = "" Then
MsgBox "請先打開或加載一個地圖集", , "警告"
Exit Sub
End If
On Error Resume Next
Map1.Layers.Add sfile
End Sub

Private Sub menulayeropengst_Click()
Dim sfile As String
With CM1
On Error Resume Next
.DialogTitle = "加載圖層集"
.Filter = "MapX GeoSet (*.gst)|*.gst"
.CancelError = True
.ShowOpen
If Err.Number = 32755 Then Exit Sub
sfile = .filename
End With
  If sfile = Map1.GeoSet Then
  MsgBox "請務重復加載同一個地圖集", , "警告"
  Exit Sub
  End If
Map1.Layers.AddGeoSetLayers sfile
End Sub

Private Sub menulayerremove_Click()
Form1.Show
End Sub

Private Sub menulayerview_Click()
Form2.Show
End Sub

Private Sub menumapclose_Click()
Map1.GeoSet = ""
TreeView1.Nodes.Clear
End Sub

Private Sub menumapopen_Click()
  Dim filepath As String
    Dim filename As String
    On Error Resume Next
    CM1.DialogTitle = "打開文件"
    CM1.DefaultExt = "gst"
    CM1.Filter = "MapX GeoSet(*.gst)|*.gst"
    CM1.CancelError = True
    CM1.Action = 1
  If Err.Number = 32755 Then Exit Sub
  If CM1.filename = Map1.GeoSet Then
  MsgBox "請務重復打開同一個地圖", , "警告"
  Exit Sub
  End If
Map1.GeoSet = CM1.filename
End Sub

Private Sub menumapsave_Click()
    If Map1.GeoSet = "" Then
    MsgBox "當前沒有地圖，無需保存", , "警告"
    Exit Sub
    End If
    Dim filepath As String
    Dim filename As String
    On Error Resume Next
    CM1.DialogTitle = "保存地圖集"
    CM1.DefaultExt = "gst"
    CM1.Filter = "MapX GeoSet (*.gst)|*.gst"
    CM1.CancelError = True
    filename = CM1.FileTitle
    filepath = CM1.filename
    filename = Left(filename, InStr(filename, ".") - 1)
    Map1.SaveMapAsGeoset filename, filepath
End Sub

Private Sub menuselectnotall_Click()
    Dim lyrs As MapXLib.Layer
    For Each lyrs In Formmain.Map1.Layers
         lyrs.Selection.ClearSelection
    Next
    Set lyrs = Nothing
End Sub

Private Sub menuviewalllayer_Click()
Map1.Bounds = Map1.Layers.Bounds
End Sub

Private Sub menutoolarrow_Click()
Map1.CurrentTool = miArrowTool
End Sub

Private Sub menutoolpan_Click()
Map1.CurrentTool = miPanTool
End Sub

Private Sub menutoolzoomin_Click()
Map1.CurrentTool = miZoomInTool
End Sub

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


Private Sub movelayers_Click()
Form4.Show
End Sub

Private Sub othersave_Click()

    If Map1.GeoSet = "" Then
    MsgBox "當前沒有地圖，無需保存", , "警告"
    Exit Sub
    End If
     Dim filepath As String
    Dim filename As String
    On Error Resume Next
    CM1.DialogTitle = "保存地圖集"
    CM1.DefaultExt = "gst"
    CM1.Filter = "MapX GeoSet (*.gst)|*.gst"
    CM1.CancelError = True
    CM1.Flags = &H2
    CM1.Action = 2
   If Err.Number = 32755 Then Exit Sub
    filename = CM1.FileTitle
    filepath = CM1.filename
    filename = Left(filename, InStr(filename, ".") - 1)
    Map1.SaveMapAsGeoset filename, filepath
End Sub


Private Sub outmapbmp_Click()
    If Map1.GeoSet = "" Then
    MsgBox "當前沒有地圖，無法輸出地圖", , "警告"
    Exit Sub
    End If
    Dim filepath As String
    On Error Resume Next
    CM1.DialogTitle = "輸出BMP地圖"
    CM1.DefaultExt = "bmp"
    CM1.Filter = "BMP格式(*.bmp)|*.bmp"
    CM1.CancelError = True
    CM1.Flags = &H2
    CM1.Action = 2
   If Err.Number = 32755 Then Exit Sub
    filepath = CM1.filename
    Map1.ExportMap filepath, miFormatBMP
End Sub

Private Sub outmapgif_Click()
    If Map1.GeoSet = "" Then
    MsgBox "當前沒有地圖，無法輸出地圖", , "警告"
    Exit Sub
    End If
    Dim filepath As String
    On Error Resume Next
    CM1.DialogTitle = "輸出GIF地圖"
    CM1.DefaultExt = "gif"
    CM1.Filter = "GIF格式(*.gif)|*.gif"
    CM1.CancelError = True
    CM1.Flags = &H2
    CM1.Action = 2
   If Err.Number = 32755 Then Exit Sub
    filepath = CM1.filename
    Map1.ExportMap filepath, miFormatGIF
End Sub

Private Sub outmapjpg_Click()
    If Map1.GeoSet = "" Then
    MsgBox "當前沒有地圖，無法輸出地圖", , "警告"
    Exit Sub
    End If
    Dim filepath As String
    On Error Resume Next
    CM1.DialogTitle = "輸出JPG地圖"
    CM1.DefaultExt = "jpg"
    CM1.Filter = "JPG格式(*.jpg)|*.jpg"
    CM1.CancelError = True
    CM1.Flags = &H2
    CM1.Action = 2
   If Err.Number = 32755 Then Exit Sub
    filepath = CM1.filename
    Map1.ExportMap filepath, miFormatJPEG
End Sub

Private Sub outmaptif_Click()
    If Map1.GeoSet = "" Then
    MsgBox "當前沒有地圖，無法輸出地圖", , "警告"
    Exit Sub
    End If
    Dim filepath As String
    On Error Resume Next
    CM1.DialogTitle = "輸出TIF地圖"
    CM1.DefaultExt = "tif"
    CM1.Filter = "TIF格式(*.tif)|*.tif"
    CM1.CancelError = True
    CM1.Flags = &H2
    CM1.Action = 2
   If Err.Number = 32755 Then Exit Sub
    filepath = CM1.filename
    Map1.ExportMap filepath, miFormatTIF
End Sub

Private Sub regiongg_Click()
Set teststyle = Map1.DefaultStyle
teststyle.PickRegion
Set Map1.DefaultStyle = teststyle
End Sub


Private Sub symbolgg_Click()
Set teststyle = Map1.DefaultStyle
teststyle.PickSymbol
Set Map1.DefaultStyle = teststyle
End Sub

Private Sub textgg_Click()
Set teststyle = Map1.DefaultStyle
teststyle.PickText
Set Map1.DefaultStyle = teststyle
End Sub

Private Sub Toolbar2_ButtonClick(ByVal Button As MSComctlLib.Button)
On Error Resume Next
Select Case Button.Key
Case "toolbarsave"
menumapsave_Click
Case "toolbaropen"
menumapopen_Click
Case "searchpoin"
dwsearchpoint_Click
Case "toolbarprint"
Map1.CurrentTool = miArrowTool
Case "zoomin"
Map1.CurrentTool = miZoomInTool
Case "zoomout"
Map1.CurrentTool = miZoomOutTool
Case "pan"
Map1.CurrentTool = miPanTool
Case "alllayers"
Map1.Bounds = Map1.Layers.Bounds
Case "notallselect"
menuselectnotall_Click
Case "controllayers"
menulayercontrol_Click
Case "searchdistan"
Map1.CurrentTool = 1
Case "aboutme"
frmAbout.Show
End Select
End Sub


Private Sub Map1_MapViewChanged()
Dim tempFea As MapXLib.Feature
Dim tempPnts As MapXLib.Points
Dim tempStyle As MapXLib.Style
Map2.GeoSet = Map1.GeoSet
Map1.Title.Visible = False
Map2.Title.Visible = False
If Map1.GeoSet = "" Then
menutool.Enabled = False
menulayer.Enabled = False
menusearch.Enabled = False
Else
menutool.Enabled = True
menulayer.Enabled = True
menusearch.Enabled = True
End If
Set m_TempLayer = Map2.Layers.CreateLayer("T_tempLayer") '給Map2增加臨時圖層
If m_TempLayer.AllFeatures.Count = 0 Then
'設置矩形邊框樣式
Set tempStyle = New MapXLib.Style
tempStyle.RegionPattern = miPatternNoFill
tempStyle.RegionBorderColor = 255
tempStyle.RegionBorderWidth = 2
'在臨時圖層添加大小為Map1的邊界的Rectangle對象
Set tempFea = Map2.FeatureFactory.CreateRegion(Map1.Bounds, tempStyle)
Set m_Fea = m_TempLayer.AddFeature(tempFea)
Set tempStyle = Nothing
Else '根據Map1的視野變化改變矩形邊框的大小和位置
With m_Fea.Parts.Item(1)
.RemoveAll
.AddXY Map1.Bounds.XMin, Map1.Bounds.YMin
.AddXY Map1.Bounds.XMax, Map1.Bounds.YMin
.AddXY Map1.Bounds.XMax, Map1.Bounds.YMax
.AddXY Map1.Bounds.XMin, Map1.Bounds.YMax
End With
m_Fea.Update
End If
End Sub

'下面代碼和"API方式實現"的一樣
Private Sub Map2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim MapX As Double
Dim MapY As Double
bDown = True
Map2.ConvertCoord X, Y, MapX, MapY, miScreenToMap
Map1.CenterX = MapX
Map1.CenterY = MapY

End Sub

Private Sub Map2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim MapX As Double
Dim MapY As Double
If bDown Then
Map2.ConvertCoord X, Y, MapX, MapY, miScreenToMap
Map1.CenterX = MapX
Map1.CenterY = MapY
End If
End Sub

Private Sub Map2_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
bDown = False
End Sub