frmmain.frm

GIS+VB开发. GIS+VB开发.

Set fs = CreateObject("Scripting.FileSystemObject")
If fs.FileExists(App.Path + "\MapSearch.ini") Then
'  Open App.Path + "\MapSearch.ini" For Input As #1
'  Do While Not EOF(1)
'  Line Input #1, StrA
'  If Left(Trim(StrA), 12) = "DefaultPath=" Then
'    StrB = Right(Trim(StrA), Len(Trim(StrA)) - 12)
'    If StrB = "\Maps" Then
'      MyFilePath = App.Path + StrB
'    Else
'      MyFilePath = StrB
'    End If
'  End If
'  If Left(Trim(StrA), 12) = "DefaultName=" Then MyFileName = Right(Trim(StrA), Len(Trim(StrA)) - 12)
'  Loop
'  Close 1
stra = App.Path + "\MapSearch.ini"
StrB = GetProfile(stra, "Options", "DefaultPath")
If StrB = "\Maps" Then
   MyFilePath = App.Path + StrB
Else
  MyFilePath = StrB
End If
MyFileName = GetProfile(stra, "Options", "DefaultName")
  If fs.FileExists(MyFilePath + "\" + MyFileName) Then
    Call LoadGST
    FrmMain.Caption = "电子地图查询系统----" + MyMap.Title
    LoadDefault = True
  Else
    MsgBox "缺省地图不存在，请检查安装目录或重新安装。"
    filedefaultmenu.Enabled = False
    LoadDefault = False
    Exit Function
  End If
Else
  MsgBox "设置文件不存在，请重新安装"
  LoadDefault = False
End If
End Function

Private Sub popaboutmenu_Click()
helpaboutmenu_Click
End Sub

Private Sub popgotomenu_Click()
searchgotomenu_Click
End Sub

Private Sub poplayermenu_Click()
searchlayermenu_Click
End Sub

Private Sub poppanmenu_Click()
toolpanmenu_Click
End Sub

Private Sub popscalemenu_Click()
searchscalemenu_Click
End Sub

Private Sub popzoominmenu_Click()
toolzoominmenu_Click
End Sub

Private Sub popzoomoutmenu_Click()
toolzoomoutmenu_Click
End Sub

Private Sub searchadvmenu_Click()
FrmSearchAdv.Show 0, FrmMain
End Sub

Private Sub searchareamenu_Click()
CheckPress (16)
GetMapUnit
MyMap.CurrentTool = 202
End Sub

Private Sub searchblurmenu_Click()
SSTab1.Tab = 1
SSTab2.Tab = 0
Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
Text1.SetFocus
End Sub

Private Sub searchboundmenu_Click()
SSTab1.Tab = 1
SSTab2.Tab = 1
Text3.SelStart = 0
Text3.SelLength = Len(Text1.Text)
Text3.SetFocus
End Sub

Private Sub searchdistancemenu_Click()
CheckPress (15)
MyMap.CurrentTool = 201
End Sub

Private Sub searchgotomenu_Click()
FrmGoto.Show 1, FrmMain
End Sub

Private Sub searchinfomenu_Click()
CheckPress (14)
FrmInfo.Show 0, FrmMain
MyMap.CurrentTool = 203
End Sub

Private Sub searchlayermenu_Click()
FrmViewLayer.Show 1, FrmMain
End Sub

Private Sub searchscalemenu_Click()
FrmScale.Show 1, FrmMain
End Sub

Private Sub selectcirclemenu_Click()
CheckPress (11)
MyMap.CurrentTool = miRadiusSelectTool
End Sub

Private Sub selectnonemenu_Click()
Dim lyrs As MapXLib.Layer
For Each lyrs In MyMap.Layers
    lyrs.Selection.ClearSelection
Next
Set lyrs = Nothing
MyMap.Refresh
End Sub

Private Sub selectpointmenu_Click()
CheckPress (9)
MyMap.CurrentTool = miSelectTool
End Sub

Private Sub selectpolymenu_Click()
CheckPress (12)
MyMap.CurrentTool = miPolygonSelectTool
End Sub

Private Sub selectrectmenu_Click()
CheckPress (10)
MyMap.CurrentTool = miRectSelectTool
End Sub

Private Sub setlayermenu_Click()
LayerControl
End Sub

Private Sub setsearchmenu_Click()
FrmSearchSet.Show 1, FrmMain
End Sub

Private Sub setsystemmenu_Click()
FrmSys.Show 1, FrmMain
End Sub

Private Sub SSTab2_Click(PreviousTab As Integer)
Dim ii As Integer
If SSTab2.Tab = 1 Then
  For ii = 1 To Combo1.ListCount
    If Combo1.List(ii - 1) = GetMapUnit Then Combo1.ListIndex = ii - 1
  Next ii
  Combo2.ListIndex = 0
End If
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Index
Case "1"
  fileopenmenu_Click
Case "2"
  filesavemenu_Click
Case "3"
  fileprintmenu_Click
Case "5"
  toolpanmenu_Click
Case "6"
  toolzoominmenu_Click
Case "7"
  toolzoomoutmenu_Click
Case "8"
  toolzoomallmenu_Click
Case "9"
  selectpointmenu_Click
Case "10"
  selectrectmenu_Click
Case "11"
  selectcirclemenu_Click
Case "12"
  selectpolymenu_Click
Case "13"
  selectnonemenu_Click
Case "14"
  searchinfomenu_Click
Case "15"
  searchdistancemenu_Click
Case "16"
  searchareamenu_Click
Case "17"
  LayerControl
Case "19"
  FrmAbout.Show 1, FrmMain
End Select
End Sub

Private Sub toolpanmenu_Click()
CheckPress (5)
MyMap.CurrentTool = miPanTool
End Sub

Private Function CheckPress(ChkNum As Integer)
'本函数作用是将选择按钮按下，其他按钮全部弹起
Dim ii As Integer
For ii = 5 To 16
Toolbar1.Buttons(ii).Value = tbrUnpressed
If ii = ChkNum Then Toolbar1.Buttons(ii).Value = tbrPressed
Next ii
End Function

Private Sub toolzoomallmenu_Click()
MyMap.Bounds = MyMap.Layers.Bounds
End Sub

Private Sub toolzoominmenu_Click()
CheckPress (6)
MyMap.CurrentTool = miZoomInTool
End Sub

Private Sub toolzoomoutmenu_Click()
CheckPress (7)
MyMap.CurrentTool = miZoomOutTool
End Sub

Private Function LoadGST()
'调入地图集
MyMap.Layers.RemoveAll
Eagle.Layers.RemoveAll
MyMap.GeoSet = ""
Eagle.GeoSet = ""
Set m_Fea = Nothing
Set m_TempLayer = Nothing
Dim fs
Dim StrPath As String
Set fs = CreateObject("Scripting.FileSystemObject")
If fs.FileExists(MyFilePath + "\" + MyFileName) Then
MyMap.GeoSet = MyFilePath + "\" + MyFileName
MyMap.Title.Visible = False
Eagle.GeoSet = MyFilePath + "\" + MyFileName
Eagle.Title.Visible = False
Eagle.Bounds = Eagle.Layers.Bounds
Set m_TempLayer = Eagle.Layers.CreateLayer("T_tempLayer", , 1) '给eagle增加临时图层
LayerList
MyMapUnit = MyMap.MapUnit
Else
MsgBox "调入地图错误"
Call fileclosemenu_Click
Exit Function
End If
TreeView2.Nodes.Clear
Unload FrmSearchAdv
Unload FrmInfo
SSTab1.Tab = 0
SSTab2.Tab = 0
End Function

Private Function LayerList()
'图层列表
Dim NodX As Node, NodY As Node
Dim ii As Integer, stra As String
TreeView1.Nodes.Clear
Set NodX = TreeView1.Nodes.Add(, , "GST", MyMap.Title)
NodX.EnsureVisible
NodX.Checked = True
For ii = 1 To MyMap.Layers.Count
  stra = MyMap.Layers.Item(ii).Name
  Set NodY = TreeView1.Nodes.Add(NodX.Index, tvwChild, stra, stra)
  NodY.EnsureVisible
  If Eagle.Layers.Item(stra).Visible Then NodY.Checked = True
Next ii
End Function


Private Sub TreeView1_NodeCheck(ByVal Node As MSComctlLib.Node)
Dim ii As Integer
If Node.key = "GST" And Node.Checked Then
  For ii = 2 To TreeView1.Nodes.Count
    TreeView1.Nodes.Item(ii).Checked = True
    Eagle.Layers(TreeView1.Nodes.Item(ii).Text).Visible = True
  Next ii
End If
If Node.key = "GST" And Not Node.Checked Then
  For ii = 2 To TreeView1.Nodes.Count
    TreeView1.Nodes.Item(ii).Checked = False
    Eagle.Layers(TreeView1.Nodes.Item(ii).Text).Visible = False
  Next ii
End If
If Node.key <> "GST" And Node.Checked Then
Eagle.Layers(Node.Text).Visible = True
End If
If Node.key <> "GST" And Not Node.Checked Then
Eagle.Layers(Node.Text).Visible = False
End If
End Sub

Private Function LayerControl()
'图层控制
Dim ii As Integer, inta As Integer, MyFlag As Boolean, jj As Integer
MyNewList.Clear
inta = Eagle.Layers.Count
For ii = 2 To inta
  If Eagle.Layers.Item(TreeView1.Nodes.Item(ii).Text).Visible = False Then MyNewList.AddItem TreeView1.Nodes.Item(ii).Text
  Eagle.Layers.Remove (TreeView1.Nodes.Item(ii).Text)
Next ii
MyMap.Layers.LayersDlg
For ii = 1 To MyMap.Layers.Count
  Eagle.Layers.Add MyMap.Layers.Item(ii).FileSpec, ii + 1
  MyFlag = False
  For jj = 1 To MyNewList.ListCount
    If MyMap.Layers.Item(ii).Name = MyNewList.List(jj - 1) Then MyFlag = True
  Next jj
  If MyFlag Or MyMap.Layers.Item(ii).Visible = False Then Eagle.Layers.Item(MyMap.Layers.Item(ii).Name).Visible = False
Next ii
Eagle.Bounds = Eagle.Layers.Bounds
LayerList
End Function

Private Function SelectList()
'选择列表
TreeView2.Nodes.Clear
SSTab1.Tab = 1
Dim MyLayer As MapXLib.Layer
Dim MyFeature As MapXLib.Feature
Dim NodFather As Node, NodChild As Node
For Each MyLayer In MyMap.Layers
  If MyLayer.Selection.Count > 0 Then
  Set NodFather = TreeView2.Nodes.Add(, , MyLayer.Name, MyLayer.Name)
    For Each MyFeature In MyLayer.Selection
      Set NodChild = TreeView2.Nodes.Add(NodFather, tvwChild, MyFeature.Layer + "|||" + MyFeature.FeatureKey, MyFeature.Name)
      NodChild.EnsureVisible
    Next
  End If
Next
End Function

Public Function GetMapUnit() As String
'获取地图单位
Select Case MyMapUnit
Case 0
  GetMapUnit = "Mile"
  MyMapAreaUnit = "SquareMile"
  MyMap.AreaUnit = miUnitSquareMile
Case 1
  GetMapUnit = "KiloMeter"
  MyMapAreaUnit = "SquareKiloMeter"
  MyMap.AreaUnit = miUnitSquareKilometer
Case 2
  GetMapUnit = "Inch"
  MyMapAreaUnit = "SquareInch"
  MyMap.AreaUnit = miUnitSquareInch
Case 3
  GetMapUnit = "Foot"
  MyMapAreaUnit = "SquareFoot"
  MyMap.AreaUnit = miUnitSquareFoot
Case 4
  GetMapUnit = "Yard"
  MyMapAreaUnit = "SquareYard"
  MyMap.AreaUnit = miUnitSquareYard
Case 5
  GetMapUnit = "MilliMeter"
  MyMapAreaUnit = "SquareMilliMeter"
  MyMap.AreaUnit = miUnitSquareMillimeter
Case 6
  GetMapUnit = "CentiMeter"
  MyMapAreaUnit = "SquareCentiMeter"
  MyMap.AreaUnit = miUnitSquareCentimeter
Case 7
  GetMapUnit = "Meter"
  MyMapAreaUnit = "SquareMeter"
  MyMap.AreaUnit = miUnitSquareMeter
Case 8
  GetMapUnit = "SurveyFoot"
  MyMapAreaUnit = "SquareSurveyFoot"
  MyMap.AreaUnit = miUnitSquareSurveyFoot
Case 9
  GetMapUnit = "NauticalMile"
  MyMapAreaUnit = "SquareNauticalMile"
  MyMap.AreaUnit = miUnitSquareNauticalMile
Case 10
  GetMapUnit = "Twip"
  MyMapAreaUnit = "SquareTwip"
  MyMap.AreaUnit = miUnitSquareTwip
Case 11
  GetMapUnit = "Point"
  MyMapAreaUnit = "SquarePint"
  MyMap.AreaUnit = miUnitSquarePoint
Case 12
  GetMapUnit = "Pica"
  MyMapAreaUnit = "SquarePica"
  MyMap.AreaUnit = miUnitSquarePica
Case 13
  GetMapUnit = "Degree"
  MyMapAreaUnit = "SquareDegree"
  MyMap.AreaUnit = miUnitSquareDegree
Case 30
  GetMapUnit = "Link"
  MyMapAreaUnit = "SquareLink"
  MyMap.AreaUnit = miUnitSquareLink
Case 31
  GetMapUnit = "Chain"
  MyMapAreaUnit = "SquareChain"
  MyMap.AreaUnit = miUnitSquareChain
Case 32
  GetMapUnit = "Rod"
  MyMapAreaUnit = "SquareRod"
  MyMap.AreaUnit = miUnitSquareRod
End Select
End Function

Private Sub TreeView2_NodeClick(ByVal Node As MSComctlLib.Node)
Dim NodX As Node, NodY As Node, NodZ As Node
Dim TempLayer As MapXLib.Layer
Dim TempDataset As MapXLib.Dataset, TempFeature As MapXLib.Feature, TempField As MapXLib.Field
On Error Resume Next
If InStr(Node.key, "|||") <> 0 Then
  'MsgBox Left(Node.Key, InStr(Node.Key, "|||") - 1) + "///" + Right(Node.Key, Len(Node.Key) - InStr(Node.Key, "|||") - 2)
  FrmInfo.Show 0, FrmMain
  FrmInfo.TreeInfo.Nodes.Clear
  Set NodX = FrmInfo.TreeInfo.Nodes.Add(, , , Left(Node.key, InStr(Node.key, "|||") - 1))
  NodX.EnsureVisible
    Set TempLayer = MyMap.Layers.Item(Left(Node.key, InStr(Node.key, "|||") - 1))
    Set TempDataset = MyMap.DataSets.Add(miDataSetLayer, TempLayer)
    Set TempFeature = TempLayer.GetFeatureByKey(Right(Node.key, Len(Node.key) - InStr(Node.key, "|||") - 2))
    MyMap.CenterX = TempFeature.CenterX
    MyMap.CenterY = TempFeature.CenterY
    Set NodY = FrmInfo.TreeInfo.Nodes.Add(NodX, tvwChild, , TempFeature.Name)
    For Each TempField In TempDataset.Fields
    Set NodZ = FrmInfo.TreeInfo.Nodes.Add(NodY, tvwChild, , TempField.Name + "：" + CStr(TempDataset.Value(Right(Node.key, Len(Node.key) - InStr(Node.key, "|||") - 2), TempField.Name)))
    NodZ.EnsureVisible
    Next
    'NodY.Expanded = False
End If
End Sub