frmmain.frm

MapInfo 行业应用源代码

Private Sub menuMapPreviousView_Click()
MapInfo.RunMenuCommand M_MAP_PREVIOUS
End Sub

Private Sub menuopenwor_Click()
    On Error Resume Next
    
    RightIndex = ".WOR"
    
    If (InStr(LeftRightIndex, RightIndex) <= 0) Then
        LeftRightIndex = "*.WOR"
    End If
    If (TheInPathTabOrWor = "") Then
        TheInPathTabOrWor = TheInstallPath + "知识库\"
    End If
    
    FrmTAB.Show 1
    
    If (nTabOrWor = 0) Then Exit Sub
    
    Call menuallclose_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"
    'Call UpdateTitleWor
End Sub

Private Sub menurecov_Click()
MapInfo.RunMenuCommand M_FILE_REVERT
End Sub

Private Sub menuSaveAsWor_Click()
    Dim I As Integer, J As Integer, Temp As String
    
    On Error Resume Next
    
    If (Len(TheWorFile) = 0) Then
        TheOutFile = "Temp"
    Else
        For I = Len(TheWorFile) To 1 Step -1
            If (Mid(TheWorFile, I, 1) = "\") Then
                TheOutFile = Right(TheWorFile, Len(TheWorFile) - I)
                Exit For
            End If
        Next I
    End If
    
    dlgOpenTable.DialogTitle = "保存工作空间(保存表)"
    dlgOpenTable.FileName = Left(TheOutFile, Len(TheOutFile) - 4)
    dlgOpenTable.Filter = "*.Wor"
    dlgOpenTable.InitDir = TheMapInfoPath
    dlgOpenTable.FilterIndex = 1
    dlgOpenTable.ShowSave
        
    If (Err <> 32755) Then '打开文件
        TheOutPath = dlgOpenTable.FileName
        TheOutFile = dlgOpenTable.FileTitle
        For I = Len(TheOutPath) To 1 Step -1
            If (Mid(TheOutPath, I, 1) = "\") Then Exit For
        Next I
        TheOutPath = Left(TheOutPath, I)

        DirFile = Dir(TheOutPath + TheOutFile)
        If (DirFile <> "") Then
            I = MsgBox(TheOutPath + TheOutFile + "文件已存在,是否覆盖? ", vbYesNo, "关于保存工作空间(保存表)")
            If (I = vbNo) Then Exit Sub
        End If
        
        mapWinID = CLng(MapInfo.Eval("FrontWindow()"))

        nLayerName = CInt(MapInfo.Eval("MapperInfo(" & mapWinID & ",9)"))
        
        TableName = ""
        For I = 1 To nLayerName
            LayerName = MapInfo.Eval("LayerInfo(" & mapWinID & "," & I & ",1)")
            J = InStr(LayerName, Chr(0))
            If (J > 0) Then LayerName = Left(LayerName, J - 1)
            MapInfo.Do "Commit Table """ & LayerName & """ As """ & TheOutPath + LayerName & ".TAB"" TYPE NATIVE Charset ""WindowsSimpChinese"""
        Next I
        I = InStr(TheOutFile, ".")
        If (I = 0) Then
            TheOutFile = TheOutFile + ".WOR"
        End If
        MapInfo.Do "Save Workspace As """ & TheOutPath + "TempTMP"""
        
        Open TheOutPath + "TempTMP" For Input As #1
        Open TheOutPath + TheOutFile For Output As #2
        Do While Not EOF(1)
            Line Input #1, Temp
            I = InStr(Temp, "\")
            If (I > 0) Then
                For I = Len(Temp) To 1 Step -1
                    If (Mid(Temp, I, 1) = "\") Then Exit For
                Next I
               Temp = "Open Table """ + Right(Temp, Len(Temp) - I)
            End If
            Print #2, Temp
        Loop
        Close (1)
        Close (2)
        Kill TheOutPath + "TempTMP"
    End If
End Sub
Private Sub menusavewindow_Click()
    Dim I As Integer, J As Integer, nLayerName As String, LayerName As String, FileType As String
    ''MapInfo.RunMenuCommand M_FILE_SAVE_WINDOW_AS

    nLayerName = CInt(MapInfo.Eval("MapperInfo(" & mapWinID & "," & MAPPER_INFO_LAYERS & ")"))
    For I = 1 To nLayerName
        LayerName = MapInfo.Eval("TableInfo(" & I & "," & TAB_INFO_NAME & ")")
        J = InStr(LayerName, Chr(0))
        If (J > 0) Then LayerName = Left(LayerName, J - 1)
        Exit For
    Next I
    TheOutFile = ThePublicPicturePath + LayerName + ".JPG"
    
    SaveMap.Show 1
    If (bOKCancel = True) Then
        FileType = Right(TheOutFile, 3)
        Select Case FileType
            Case "WMF"
                FileType = "WMF"
            Case "JPG"
                FileType = "JPEG"
            Case "TIF"
                FileType = "TIFF"
            Case Else
                FileType = "BMP"
        End Select
        On Error GoTo Error
        MapInfo.Do "Save Window  " & mapWinID & " As  """ & TheOutFile & """ Type """ & FileType & """ Width " & mmPaperWidth & " units ""mm"" Height " & mmPaperHeight & " units ""mm"""
        Exit Sub
Error:
        MsgBox "该版本的MapInfo不支持" + FileType + "格式!" + Chr(10) + Chr(13) + "请选用更高版本的MapInfo", vbOKOnly, "关于存储图象!"
    End If
End Sub
Private Sub menusavewor_Click()
    MapInfo.RunMenuCommand M_FILE_SAVE_WORKSPACE
End Sub

Private Sub menuTableColomnUpDate_Click()
MapInfo.RunMenuCommand M_TABLE_UPDATE_COLUMN
End Sub

Private Sub menuTableStruture_Click()
MapInfo.RunMenuCommand M_TABLE_MODIFY_STRUCTURE
End Sub

Private Sub menuWindowLayerOut_Click()
Call LoadNewForm
MapInfo.RunMenuCommand M_WINDOW_LAYOUT

End Sub

Private Sub menuWindowStatisticWindow_Click()
Call LoadNewForm
MapInfo.RunMenuCommand M_WINDOW_GRAPH
End Sub

Private Sub mnuClipRegion_Click()
    Dim TheMapInfoPath As String
    
    TheMapInfoPath = App.Path
    If (Right(TheMapInfoPath, 1) <> "\") Then
        TheMapInfoPath = TheMapInfoPath + "\"
    End If
    
    Call ClipRegionDLL(MapInfo, TheMapInfoPath)
End Sub

Private Sub mnuEditDel_Click()
MapInfo.RunMenuCommand M_EDIT_CLEAR
End Sub

Private Sub mnuEditDelMap_Click()
MapInfo.RunMenuCommand M_EDIT_CLEAROBJ
End Sub

Private Sub mnuEditGetInfo_Click()
MapInfo.RunMenuCommand M_EDIT_GETINFO
End Sub

Private Sub mnuEditNewRow_Click()
MapInfo.RunMenuCommand M_EDIT_NEW_ROW
End Sub

Private Sub mnuEditShapes_Click()
MapInfo.RunMenuCommand M_EDIT_RESHAPE
End Sub


Private Sub mnuFileSaveAs_Click()
MapInfo.RunMenuCommand M_FILE_SAVE_COPY_AS
End Sub


Private Sub MnuMapChangeView_Click()
MapInfo.RunMenuCommand M_MAP_CHANGE_VIEW
End Sub

Private Sub mnuMapClearCosmetic_Click()
MapInfo.RunMenuCommand M_MAP_CLEAR_COSMETIC
End Sub

Private Sub mnuMapClearCustomLabels_Click()
MapInfo.RunMenuCommand M_MAP_CLEAR_CUSTOM_LABELS
End Sub

Private Sub mnuMapCloseClip_Click()
MapInfo.RunMenuCommand M_MAP_CLIP_REGION_ONOFF
End Sub

Private Sub mnuMapCopyView_Click()
Call LoadNewForm
mapWinID = CLng(MapInfo.Eval("FrontWindow()"))
MapInfo.RunMenuCommand M_MAP_CLONE_MAPPER
End Sub

Private Sub mnuMapCreate3DMap_Click()
    Call LoadNewForm
    ''mapWinID = CLng(MapInfo.Eval("FrontWindow()"))
    MapInfo.RunMenuCommand 817
End Sub

Private Sub mnuMapCreateLegend_Click()
    Call LoadNewForm
    ''mapWinID = CLng(MapInfo.Eval("FrontWindow()"))
    MapInfo.RunMenuCommand 816
End Sub

Private Sub mnuMapCreateLZMap_Click()
    Call LoadNewForm
    ''mapWinID = CLng(MapInfo.Eval("FrontWindow()"))
    MapInfo.RunMenuCommand 818
End Sub

Private Sub mnuMapEntireLayer_Click()
MapInfo.RunMenuCommand M_MAP_ENTIRE_LAYER
End Sub


Private Sub mnuMapLayer_Click()
MapInfo.RunMenuCommand M_MAP_LAYER_CONTROL
Call EnabledMenuAndToolbar
End Sub

Private Sub mnuMapOptions_Click()
MapInfo.RunMenuCommand M_MAP_OPTIONS
End Sub

Private Sub mnuMapSaveCosmetic_Click()
MapInfo.RunMenuCommand M_MAP_SAVE_COSMETIC

End Sub

Private Sub mnuMapSetClip_Click()
MapInfo.RunMenuCommand M_MAP_SET_CLIP_REGION
End Sub

Private Sub mnuObjects_BUFFER_Click()
MapInfo.RunMenuCommand M_OBJECTS_BUFFER
End Sub

Private Sub mnuObjects_Clear_Target_Click()
MapInfo.RunMenuCommand M_OBJECTS_CLEAR_TARGET
End Sub

Private Sub mnuObjects_Combine_Click()
MapInfo.RunMenuCommand M_OBJECTS_COMBINE
End Sub


Private Sub mnuObjects_CVT_PGON_Click()
MapInfo.RunMenuCommand M_OBJECTS_CVT_PGON
End Sub

Private Sub mnuObjects_CVT_PLINE_Click()
MapInfo.RunMenuCommand M_OBJECTS_CVT_PLINE
End Sub


Private Sub mnuObjects_ERASE_Click()
MapInfo.RunMenuCommand M_OBJECTS_ERASE
End Sub

Private Sub mnuObjects_ERASE_OUT_Click()
MapInfo.RunMenuCommand M_OBJECTS_ERASE_OUT
End Sub


Private Sub mnuObjects_OVERLAY_Click()
MapInfo.RunMenuCommand M_OBJECTS_OVERLAY
End Sub


Private Sub mnuObjects_Set_Target_Click()
MapInfo.RunMenuCommand M_OBJECTS_SET_TARGET
End Sub

Private Sub mnuObjects_SMOOTH_Click()
MapInfo.RunMenuCommand M_OBJECTS_SMOOTH
End Sub

Private Sub mnuObjects_SPLIT_Click()
MapInfo.RunMenuCommand M_OBJECTS_SPLIT
End Sub

Private Sub mnuObjects_unCombine_Click()
MapInfo.RunMenuCommand 1621
End Sub

Private Sub mnuObjects_UNSMOOTH_Click()
MapInfo.RunMenuCommand M_OBJECTS_UNSMOOTH
End Sub

Private Sub mnuObjectsCheckError_Click()
    MapInfo.RunMenuCommand 1619
End Sub

Private Sub mnuObjectsCheckRegions_Click()
    MapInfo.RunMenuCommand 1618
End Sub

Private Sub mnuObjectsConvexHull_Click()
    MapInfo.RunMenuCommand 1616
End Sub

Private Sub mnuObjectsLineClose_Click()
    MapInfo.RunMenuCommand 1617
End Sub


Private Sub mnuOld_Click()
Call menuallclose_Click

Call LoadStartUpWor
End Sub


Private Sub mnuSaveDefaultWor_Click()
    MapInfo.Do "Save Workspace As """ & TheInstallPath & "StartUp.Wor"""
End Sub

Private Sub mnuTableAddRow_Click()
MapInfo.RunMenuCommand M_TABLE_APPEND
End Sub

Private Sub mnuTableCombineObject_Click()
MapInfo.RunMenuCommand M_TABLE_MERGE_USING_COLUMN
End Sub

Private Sub mnuTableCreatePoint_Click()
MapInfo.RunMenuCommand M_TABLE_CREATE_POINTS
End Sub

Private Sub mnuTableDelTable_Click()
MapInfo.RunMenuCommand M_TABLE_DELETE
End Sub

Private Sub mnuTableExport_Click()
MapInfo.RunMenuCommand M_TABLE_EXPORT
End Sub

Private Sub mnuTableGeoCode_Click()
MapInfo.RunMenuCommand M_TABLE_GEOCODE
End Sub


Private Sub mnuTableImport_Click()
MapInfo.RunMenuCommand M_TABLE_IMPORT
End Sub

Private Sub mnuTablePack_Click()
MapInfo.RunMenuCommand M_TABLE_PACK
End Sub

Private Sub mnuTableRenameTable_Click()
MapInfo.RunMenuCommand M_TABLE_RENAME