mdifrmmain.frm

用VB开发的巡检系统基于MAPINFo用VB开发的巡检系统基于MAPINFo很好的

        '* no map is open. Disable the "Close Layer" menu item
        'frmMain.mnuFileClose.Enabled = False

        '使选择工具有效,其它无效
        MapInfo.RunMenuCommand M_TOOLS_SELECTOR
    End If
    
    mnu1000_1003.Enabled = thereIsAMap
    mnu1000_1004.Enabled = thereIsAMap
    mnu1000_1005.Enabled = thereIsAMap
    mnu1000_1006.Enabled = thereIsAMap
'    mnu1000_1007.Enabled = thereIsAMap
    mnu1000_1008.Enabled = thereIsAMap
    mnu1000_1009.Enabled = thereIsAMap

'    mnu1000_1010.Enabled = thereIsAMap
'    mnu1000_1011.Enabled = thereIsAMap
'    mnu1000_1012.Enabled = thereIsAMap

    Call EnabledMenuAndToolbar
    If (thereIsAMap = True) Then
        MapInfo.Do "Set Map XY Units ""degree"" Distance Units ""km"" Area Units ""sq m"""
        'MapInfo.Do "Set Map XY Units ""m"" Distance Units ""km"" Area Units ""sq m"""
    End If
End Sub

Private Sub SetToolBarValue0()
    tbarMain.Buttons("Select").Value = 1
    MapInfo.RunMenuCommand M_TOOLS_SELECTOR
    tbarMain.Buttons("Move").Value = 0
    tbarMain.Buttons("ZoomIn").Value = 0
    tbarMain.Buttons("ZoomOut").Value = 0
    ''tbarMain.Buttons("ChangeView").Value = 0
    tbarMain.Buttons("SelectRect").Value = 0
    tbarMain.Buttons("SelectCircle").Value = 0
    tbarMain.Buttons("SelectCreatePoly").Value = 0
'    tbarMain.Buttons("SelectPoly").Value = 0
    tbarMain.Buttons("LayerControl").Value = 0
    tbarMain.Buttons("Ruler").Value = 0
    tbarMain.Buttons("ManMark").Value = 0
    
    tbarMain.Buttons("Info_Point").Value = 0
    tbarMain.Buttons("Symbol").Value = 0
    tbarMain.Buttons("Line").Value = 0
    tbarMain.Buttons("PolyLine").Value = 0
    tbarMain.Buttons("Arc").Value = 0
    tbarMain.Buttons("Polygon").Value = 0
    tbarMain.Buttons("Ellipse").Value = 0
    tbarMain.Buttons("Rectangle").Value = 0
    tbarMain.Buttons("RoundedRectangle").Value = 0
    tbarMain.Buttons("Text").Value = 0
    tbarMain.Buttons("ReShape").Value = 0
    tbarMain.Buttons("AddNode").Value = 0
    
    tbarMain.Buttons("SymbolStyle").Value = 0
    tbarMain.Buttons("LineStyle").Value = 0
    tbarMain.Buttons("RegionStyle").Value = 0
    tbarMain.Buttons("TextStyle").Value = 0
End Sub

Private Sub MDIForm_Unload(Cancel As Integer)

'MapInfo.RunMenuCommand M_FILE_EXIT

MapInfo.RunMenuCommand M_FILE_CLOSE_ALL

If Not (MapInfo Is Nothing) Then
    MapInfo.SetCallback Nothing
End If

Set MapInfo = Nothing
Set theResponder = Nothing

On Error Resume Next
Kill (App.Path + "\Track.tmp")

End

'ShutdownMapInfoConnection


End Sub

Private Sub mnu1000_1001_Click()
'新建表
MapInfo.RunMenuCommand 101
End Sub

Private Sub mnu1000_1002_Click()
'打开表
'MapInfo.RunMenuCommand 102
    Dim I As Integer ', TableName As String
    
    On Error GoTo err_lab
'

'''''''''''刘登杰
Dim TableName As String
Dim FileSpec As String
FileSpec = MapInfo.Eval("FileOpenDlg("""","""",""TAB"",""打开表"")")

If FileSpec = "" Then Exit Sub

If FileSpec <> "" Then
  TableName = MapInfo.Eval("PathToTableName$(""" + FileSpec + """)")
  MapInfo.Do ("Open Table """ + FileSpec + """ As " + TableName)

''''''''''''''''''刘登杰

'    RightIndex = ".TAB"
'    If (InStr(LeftRightIndex, RightIndex) <= 0) Then
'        LeftRightIndex = "*.TAB"
'    End If
'    If (TheInPathTabOrWor = "") Then
'        TheInPathTabOrWor = TheInstallPath + "地图数据\"
'    End If
'    FrmOpen.Show 1
'    If (nTabOrWor = 0) Then Exit Sub

'    For I = 1 To nTabOrWor
'        TheInFile = TheInPathTabOrWor + TabOrWor(I)
'        '表名
'        TableName = TabOrWor(I)
'        TableName = Left(TableName, Len(TableName) - 4)
'        '开表
'        MapInfo.Do "Open Table """ & TheInFile & """ as " & TableName
        
        If MapInfo.Eval("TableInfo(" & TableName & "," & TAB_INFO_MAPPABLE & ")") = "F" Then
            iMapper = 0
        Else
            iMapper = 1
        End If

        Call BrowserAddCreateTable(TableName, iMapper)
'    Next I
    ReDim TabOrWor(1 To 1)
    nTabOrWor = 0
    Exit Sub
    
    End If ''''''''''''''
    
err_lab:
    MsgBox Err.Description, vbInformation, "提示"
End Sub

Private Sub mnu1000_1003_Click()
'关闭表
'MapInfo.RunMenuCommand 103
On Error GoTo Error
    MapInfo.RunMenuCommand M_FILE_CLOSE
    CloseSelectedLayer
    If (mapWinID = 0) Then
        Unload ActiveForm
        Call UpdateMenuAndToolbar(False)
    Else
        Call SetToolBarValue0
    End If
Error:
End Sub

Private Sub mnu1000_1004_Click()
'全部关闭
'MapInfo.RunMenuCommand 104

    Dim Button As ComctlLib.Button
    
    On Error GoTo Error
    MapInfo.RunMenuCommand M_FILE_CLOSE_ALL
    Do
        Unload ActiveForm
        If (ActiveForm Is Nothing) Then Exit Do
    Loop
Error:
    mapWinID = 0
    BrowserWinID = 0
    SelectEarthQuakeTable = ""
    thereIsAMap = False
    Call UpdateMenuAndToolbar(False)
End Sub

Private Sub mnu1000_1005_Click()
'保存表
MapInfo.RunMenuCommand 105
End Sub

Private Sub mnu1000_1006_Click()
'另存表为...
MapInfo.RunMenuCommand 106
End Sub


Private Sub mnu1000_1008_Click()
'保存工作空间
MapInfo.RunMenuCommand 109
End Sub

Private Sub mnu1000_1009_Click()
'另存窗口
MapInfo.RunMenuCommand 609
End Sub

Private Sub mnu1000_1010_Click()
'页面设置
MapInfo.RunMenuCommand 111
End Sub

Private Sub mnu1000_1011_Click()
'打印
MapInfo.RunMenuCommand 112
End Sub

Private Sub mnu1000_1012_Click()

On Error Resume Next

Kill (App.Path & "\Track.tmp") '物理删除临时文件

'退出
'
'mnu1000_1004_Click '全部关闭
''
'Set gblRs = Nothing
'If gblCn.State = 1 Then gblCn.Close
'Shutdown
'End

Unload Me

End Sub

Private Sub mnu1000_1013_Click()
'打开工作空间
On Error Resume Next
RightIndex = ".WOR"
If (InStr(LeftRightIndex, RightIndex) <= 0) Then
    LeftRightIndex = "*.WOR"
End If
If (TheInPathTabOrWor = "") Then
    TheInPathTabOrWor = TheInstallPath + "地图数据\"
End If
FrmOpen.Show 1
If (nTabOrWor = 0) Then Exit Sub
Call mnu1000_1004_Click '全部关闭
TheWorFile = TheInPathTabOrWor + TabOrWor(1)
Call LoadNewForm
ActiveForm.WindowState = 2
MapInfo.Do "Run Application """ & TheWorFile & """"
MapInfo.Do "Set Window Legend Parent " & ActiveForm.hwnd & " Position(6,5) Width 2  Height 2 hide"
MapInfo.Do "Set Legend "
thereIsAMap = True
mapWinID = CLng(MapInfo.Eval("FrontWindow()"))
MapInfo.Do "Set CoordSys Earth Projection 1,0"
Call UpdateMenuAndToolbar(True)
ActiveForm.Caption = Left(TabOrWor(1), Len(TabOrWor(1)) - 4) + " Map"
End Sub

Private Sub mnu10000_10001_Click()
'跟踪制定
frmGpsTrack.Show
End Sub

Private Sub mnu10000_10002_Click()

'轨迹回放
frmShowTrack.Show
End Sub

Private Sub mnu2000_2001_Click()
'撤消
MapInfo.RunMenuCommand 201
End Sub

Private Sub mnu2000_2002_Click()
'剪切
MapInfo.RunMenuCommand 202
End Sub

Private Sub mnu2000_2003_Click()
'复制
MapInfo.RunMenuCommand 203
End Sub

Private Sub mnu2000_2004_Click()
'粘贴
MapInfo.RunMenuCommand 204
End Sub

Private Sub mnu2000_2005_Click()
'清除
MapInfo.RunMenuCommand 205
End Sub

Private Sub mnu2000_2006_Click()
'只清除地图对象
MapInfo.RunMenuCommand 206
End Sub

Private Sub mnu2000_2007_Click()
'整形
MapInfo.RunMenuCommand 1601
End Sub

Private Sub mnu2000_2008_Click()
'获取信息
MapInfo.RunMenuCommand 207
End Sub

Private Sub mnu3000_3001_Click()
'图层控制
MapInfo.RunMenuCommand 801
Call EnabledMenuAndToolbar
End Sub

Private Sub mnu3000_3002_Click()
'选择对象
MapInfo.RunMenuCommand 1701
End Sub

Private Sub mnu3000_3003_Click()
'放大
MapInfo.RunMenuCommand 1705
End Sub

Private Sub mnu3000_3004_Click()
'缩小
MapInfo.RunMenuCommand 1706
End Sub

Private Sub mnu3000_3005_Click()
'漫游
MapInfo.RunMenuCommand 1702
End Sub

Private Sub mnu3000_3006_Click()
'全图显示
MapInfo.RunMenuCommand M_MAP_ENTIRE_LAYER '807
End Sub

Private Sub mnu3000_3007_Click()
'距离量算
MapInfo.RunMenuCommand 1710
'MapInfo.RunMenuCommand M_TOOLS_RULER
MapInfo.Do "Set Window Ruler Parent " & ActiveForm.hwnd & " Show"
tbarMain.Buttons("Ruler").Value = 1
End Sub

Private Sub mnu3000_3008_Click()
'面积量算
'MapInfo.RunMenuCommand 0
CalArea
End Sub

Private Sub mnu4000_4001_Click()
'查看对象属性
'MapInfo.RunMenuCommand 301
'frmObjectInfo.Show
tbarMain.Buttons("Select").Value = 0
tbarMain.Buttons("Info_Point").Value = 1
MapInfo.Do "Run Menu Command ID 2001"
'MapInfo.Do "Run Menu Command ID 1707"
End Sub

Private Sub mnu4000_4002_Click()
'SQL选择
MapInfo.RunMenuCommand 302
End Sub

Private Sub mnu4000_4003_Click()
'计算统计值
MapInfo.RunMenuCommand 309
End Sub

Private Sub mnu5000_5001_Click()
'转入...
MapInfo.RunMenuCommand 401
End Sub

Private Sub mnu5000_5002_Click()
'转出...
MapInfo.RunMenuCommand 402
End Sub

Private Sub mnu5000_5003_Click()
'维护--(下一级)
End Sub

Private Sub mnu5000_5004_Click()
'表结构
MapInfo.RunMenuCommand 404
End Sub

Private Sub mnu5000_5005_Click()
'删除表
MapInfo.RunMenuCommand 409
End Sub

Private Sub mnu5000_5006_Click()