frmmain.frm

MapInfo 行业应用源代码

         HelpContextID   =   253
      End
      Begin VB.Menu mnuMapSeparator2 
         Caption         =   "-"
      End
      Begin VB.Menu mnuMapCreateLegend 
         Caption         =   "创建图例..."
         HelpContextID   =   254
      End
      Begin VB.Menu mnuMapSeparator3 
         Caption         =   "-"
      End
      Begin VB.Menu MnuMapChangeView 
         Caption         =   "改变视图"
         HelpContextID   =   255
      End
      Begin VB.Menu mnuMapCopyView 
         Caption         =   "副本视图"
         Enabled         =   0   'False
         HelpContextID   =   256
      End
      Begin VB.Menu menuMapPreviousView 
         Caption         =   "前一视图"
         HelpContextID   =   257
      End
      Begin VB.Menu mnuMapEntireLayer 
         Caption         =   "查看整个图层"
         HelpContextID   =   258
      End
      Begin VB.Menu mnuMapSeparator4 
         Caption         =   "-"
      End
      Begin VB.Menu mnuMapClearCustomLabels 
         Caption         =   "清除自定义标注"
         HelpContextID   =   259
      End
      Begin VB.Menu mnuMapSaveCosmetic 
         Caption         =   "保存装饰图层对象"
         HelpContextID   =   2510
      End
      Begin VB.Menu mnuMapClearCosmetic 
         Caption         =   "清除装饰图层对象"
         HelpContextID   =   2511
      End
      Begin VB.Menu mnuMapSeparator5 
         Caption         =   "-"
      End
      Begin VB.Menu mnuMapSetClip 
         Caption         =   "设置裁减区域"
         HelpContextID   =   2512
      End
      Begin VB.Menu mnuMapCloseClip 
         Caption         =   "关闭裁减区域"
         HelpContextID   =   2513
      End
      Begin VB.Menu mnuMapSeparator6 
         Caption         =   "-"
      End
      Begin VB.Menu mnuMapOptions 
         Caption         =   "地图投影..."
         HelpContextID   =   2514
      End
   End
   Begin VB.Menu mnuWindow 
      Caption         =   "窗口"
      HelpContextID   =   26
      WindowList      =   -1  'True
      Begin VB.Menu mnuWindowBrowserWindow 
         Caption         =   "新建浏览窗口"
         HelpContextID   =   261
         Shortcut        =   {F2}
      End
      Begin VB.Menu mnuWindowNewWindow 
         Caption         =   "新建地图窗口"
         Enabled         =   0   'False
         HelpContextID   =   262
         Shortcut        =   {F3}
      End
      Begin VB.Menu menuWindowStatisticWindow 
         Caption         =   "新建统计图窗口"
         HelpContextID   =   263
         Shortcut        =   {F4}
      End
      Begin VB.Menu menuWindowLayerOut 
         Caption         =   "新建图层输出窗口"
         HelpContextID   =   264
         Shortcut        =   {F5}
      End
      Begin VB.Menu mnuWindowBar1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuWindowCascade 
         Caption         =   "层叠"
         HelpContextID   =   267
      End
      Begin VB.Menu mnuWindowTileHorizontal 
         Caption         =   "横向平铺"
         HelpContextID   =   266
      End
      Begin VB.Menu mnuWindowTileVertical 
         Caption         =   "纵向平铺"
      End
      Begin VB.Menu mnuWindowArrangeIcons 
         Caption         =   "排列图标"
         HelpContextID   =   268
      End
   End
   Begin VB.Menu mnuTools 
      Caption         =   "工具"
      HelpContextID   =   80
      Begin VB.Menu mnuViewToolbar 
         Caption         =   "22.工具栏"
         Checked         =   -1  'True
         HelpContextID   =   814
      End
      Begin VB.Menu mnuViewStatusBar 
         Caption         =   "23.状态栏"
         Checked         =   -1  'True
         HelpContextID   =   815
      End
   End
   Begin VB.Menu mnuClipRegion 
      Caption         =   "裁剪矩形区域"
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim TheInPath As String, TheInFile As String
Dim TheWorFile As String
'处理工作空间的窗体条
Private Sub UpdateTitleWor()
Dim I As Integer, N As Integer, Temp As String

On Error GoTo Error
If thereIsAMap Then
    N = CLng(MapInfo.Eval("MapperInfo(" & mapWinID & "," & MAPPER_INFO_LAYERS & ")"))
    Temp = ""
    For I = 1 To N - 1
        Temp = Temp + MapInfo.Eval("TableInfo(" & I & "," & TAB_INFO_NAME & ")") + ","
    Next I
    Temp = Temp + MapInfo.Eval("TableInfo(" & N & "," & TAB_INFO_NAME & ")")
    ActiveForm.Caption = Temp + " Map"
End If
Error:
End Sub


Private Sub AllQuery_Click()
    MapInfo.RunMenuCommand M_ANALYZE_SELECTALL
End Sub

Private Sub AntiAllQuery_Click()
    MapInfo.RunMenuCommand 311
End Sub


Private Sub CalStastics_Click()
    MapInfo.RunMenuCommand M_ANALYZE_CALC_STATISTICS
End Sub

Private Sub Find_Selection_Click()
    MapInfo.RunMenuCommand M_ANALYZE_FIND_SELECTION
End Sub

Private Sub FindSome_Click()
    MapInfo.RunMenuCommand M_ANALYZE_FIND
End Sub

Private Sub LayerQuery_Click()
    MapInfo.RunMenuCommand M_ANALYZE_SELECT
End Sub

Private Sub MDIForm_Load()
bExitSub = False

TheInstallPath = App.Path + "\"
App.HelpFile = App.Path + "\帮助\MapSIS11.HLP"

InitializeMapInfoConnection

Call LoadStartUpWor

'End启动时调用
Unload frmAbout


End Sub
'更新选单（Menu)和工具条(ToolBar)
Private Sub UpdateMenuAndToolbar(thereIsAMap As Boolean)
    Dim I As Integer

    Call SetToolBarValue0

    tbarMain.Buttons("Select").Enabled = thereIsAMap
    tbarMain.Buttons("Move").Enabled = thereIsAMap
    tbarMain.Buttons("ZoomIn").Enabled = thereIsAMap
    tbarMain.Buttons("ZoomOut").Enabled = thereIsAMap
    ''tbarMain.Buttons("ChangeView").Enabled = thereIsAMap
    tbarMain.Buttons("SelectRect").Enabled = thereIsAMap
    tbarMain.Buttons("SelectCircle").Enabled = thereIsAMap
    tbarMain.Buttons("SelectCreatePoly").Enabled = thereIsAMap
    tbarMain.Buttons("SelectPoly").Enabled = thereIsAMap
    tbarMain.Buttons("AntiSelect").Enabled = thereIsAMap
    tbarMain.Buttons("ManMark").Enabled = thereIsAMap

    tbarMain.Buttons("Symbol").Enabled = thereIsAMap
    tbarMain.Buttons("Line").Enabled = thereIsAMap
    tbarMain.Buttons("PolyLine").Enabled = thereIsAMap
    tbarMain.Buttons("Arc").Enabled = thereIsAMap
    tbarMain.Buttons("Polygon").Enabled = thereIsAMap
    tbarMain.Buttons("Ellipse").Enabled = thereIsAMap
    tbarMain.Buttons("Rectangle").Enabled = thereIsAMap
    tbarMain.Buttons("RoundedRectangle").Enabled = thereIsAMap
    tbarMain.Buttons("Text").Enabled = thereIsAMap
    tbarMain.Buttons("ReShape").Enabled = thereIsAMap
    tbarMain.Buttons("AddNode").Enabled = thereIsAMap
    tbarMain.Buttons("SymbolStyle").Enabled = thereIsAMap
    tbarMain.Buttons("LineStyle").Enabled = thereIsAMap
    tbarMain.Buttons("RegionStyle").Enabled = thereIsAMap
    tbarMain.Buttons("TextStyle").Enabled = thereIsAMap

    If thereIsAMap Then '有图层打开
        '* a map is open. Enable "Close Layer" only if a selection exists in the layer list box
        '    If .lstLayers.ListIndex < 1 Then
        '        .mnuFileClose.Enabled = False   '* map is open, but no tables selected
        '        MapInfo.Do "Alter Menu Item ID 1003 Disable"    '* disable item in shortcut menu
        '    Else
        '        .mnuFileClose.Enabled = True    '* map is open, table is selected
        '        MapInfo.Do "Alter Menu Item ID 1003 Enable"     '* enable item in shortcut menu
        '    End If
        '使选择工具选中
        tbarMain.Buttons("Select").Value = tbrPressed
        MapInfo.RunMenuCommand M_TOOLS_SELECTOR
    Else '没有打开一个图层,
        '* no map is open. Disable the "Close Layer" menu item
        'frmMain.mnuFileClose.Enabled = False

        '使选择工具有效,其它无效
        MapInfo.RunMenuCommand M_TOOLS_SELECTOR
    End If

    mnuFileClose.Enabled = thereIsAMap
    menuAllClose.Enabled = thereIsAMap
    mnuFileSave.Enabled = thereIsAMap
    mnuFileSaveAs.Enabled = thereIsAMap
    menuSaveWor.Enabled = thereIsAMap
    menuSaveAsWor.Enabled = thereIsAMap

    menuSaveWindow.Enabled = thereIsAMap

    menuRecov.Enabled = thereIsAMap
    mnuFilePageSetup.Enabled = thereIsAMap
    mnuFilePrint.Enabled = thereIsAMap

    mnuEdit.Enabled = thereIsAMap
    mnuObjects.Enabled = thereIsAMap
    mnuQuery.Enabled = thereIsAMap
    mnuTable.Enabled = thereIsAMap
    mnuMap.Enabled = thereIsAMap
    mnuWindow.Enabled = thereIsAMap
    
    mnuSaveDefaultWor.Enabled = thereIsAMap

    Call EnabledMenuAndToolbar
    If (thereIsAMap = True) Then
        MapInfo.Do "Set Map XY Units ""degree"" Distance Units ""km"" Area Units ""sq km"""
    End If
End Sub
'打开MapInfo表对话框
Public Sub OpenNewTable()
Dim I As Integer, Error As Integer

On Error GoTo Error

If (MapinfoRunTime = True) Then
    FormNewTables.Show 1
    If (bOKCancel = True) Then
        Call BrowserAddCreateTable(TableName, iMapper)
    End If
    If (iMapper = 1) Then
        MapInfo.Do "Set Map Layer 1 Editable ON"
    End If
    Exit Sub
Else
    MapInfo.RunMenuCommand M_FILE_NEW
End If

TableName = MapInfo.Eval("TableInfo(0," & TAB_INFO_NAME & ")")
I = InStr(TableName, ".")
If (I > 0) Then
    TableName = Left(TableName, I - 1)
End If
I = InStr(TableName, Chr(0))
If (I > 0) Then
    TableName = Left(TableName, I - 1)
End If

If MapInfo.Eval("TableInfo(" & TableName & "," & TAB_INFO_MAPPABLE & ")") = "F" Then
    iMapper = 0
Else
    iMapper = 1
End If

If (thereIsAMap = False) Then
    Call BrowserAddCreateTable(TableName, iMapper)
End If
Error:
End Sub
'打开MapInfo表对话框
Public Sub OpenOldTable()
Dim TheFile As String, TableName As String
Dim I As Integer

On Error GoTo UserCancelled
''If (MapinfoRunTime = True) Then
    dlgOpenTable.Filter = "MapInfo Tables (*.tab)|*.tab"
    dlgOpenTable.FilterIndex = 1

    dlgOpenTable.ShowOpen

    TheFile = dlgOpenTable.FileName
    TheInFile = dlgOpenTable.FileName

    '取表别名
    TableName = dlgOpenTable.FileTitle ' MapInfo.Eval("PathToTableName$( """ & TheFile & """ )")
    TableName = Left(TableName, Len(TableName) - 4)

    '开表
    MapInfo.Do "Open Table """ & TheFile & """ as " & TableName
''Else
''    MapInfo.RunMenuCommand M_FILE_OPEN

''    TableName = MapInfo.Eval("TableInfo(0," & TAB_INFO_NAME & ")")
''    I = InStr(TableName, ".")
''    If (I > 0) Then
''        TableName = Left(TableName, I - 1)
''    End If
''    I = InStr(TableName, Chr(0))
''    If (I > 0) Then
''        TableName = Left(TableName, I - 1)
''    End If
''End If
If MapInfo.Eval("TableInfo(" & TableName & "," & TAB_INFO_MAPPABLE & ")") = "F" Then
    iMapper = 0
Else
    iMapper = 1
End If

Call BrowserAddCreateTable(TableName, iMapper)
UserCancelled:
End Sub
Private Sub MDIForm_Unload(Cancel As Integer)
MapInfo.RunMenuCommand M_FILE_EXIT
ShutdownMapInfoConnection       '* cleanly disconnect from MapInfo
End Sub

Private Sub menuallclose_Click()
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 menuMapCreateThematic_Click()
MapInfo.RunMenuCommand M_MAP_THEMATIC
MapInfo.Do "Set Window Legend  Parent " & ActiveForm.hwnd & " Show"
MapInfo.Do "Set Legend "
End Sub

Private Sub menuMapModifyThematic_Click()
MapInfo.RunMenuCommand M_MAP_MODIFY_THEMATIC
End Sub