mapsis.bas

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

Attribute VB_Name = "modMapSIS"
Public bOKCancel As Boolean
Public StrSIS As String, StrWait As String, StrDir As String
Public ThePublicInPath As String, ThePublicOutPath As String, ThePublicPicturePath As String, TheDataBasePath As String, TheMapInfoPath As String
Public DataBaseMinTime As String * 8, DataBaseMaxTime As String * 8, DataBaseLink As Integer
Public TheOutFile As String
Public frmD As frmMap, fMainForm As MDIFrmMain 'frmMain

'Public Xold As Double, Yold As Double
'Public WcsX As Double, WcsY As Double
'Public Xleng As Double, Yleng As Double
'Public Xminp As Double, Yminp As Double
'Public Xmaxp As Double, Ymaxp As Double

Public FormBrowser As Integer, WinID As Long

Public TheInstallPath As String, CurPath As String
Public TheInFile As String, bExitSub As Boolean
Public SelectEarthQuakeTable As String
Public nTim As Integer, nMT0 As Integer, FileMT0 As String
Public PaperHeight As Single, PaperWidth As Single, mmPaperHeight As Single, mmPaperWidth As Single
Public StrEQMap As String
Public bSaveFile As Boolean, TheSaveFile As String
Public MapinfoRunTime As Boolean
'固体潮动态
Public GTSLV As String * 1
'RunTime新建表
Public iOpenBrowser As Integer, iOpenNewMap As Integer, iAddCurMap As Integer, iMapper As Integer
'前兆干扰异常备注库
Public FileMDB As String
'打开表或工作空间
Public TabOrWor() As String, nTabOrWor As Integer, RightIndex As String, LeftRightIndex As String
Public TheInPathTabOrWor As String

'InNum-输入数,nDec-小数位数,nWidth-宽度,IC-左右对齐标志,OutStr-输出字符串
Public Function Formats(InNum As Variant, cFormat As String) As String
Dim i As Integer

i = Len(cFormat)
Formats = Format(InNum, cFormat)
If (Len(Formats) < i) Then Formats = Space(i - Len(Formats)) + Formats
End Function


Public Sub LoadNewForm()
    Set frmD = New frmMap

    frmD.Show
   
    '设置下一个窗口的父窗口
    MapInfo.Do "Set Next Document Parent " & frmD.hwnd & " Style 1"
End Sub


'处理MapInfo信息
Public Sub UpdateInfo(ByVal X As Double, ByVal Y As Double, X2 As Double, Y2 As Double, CR As Integer)
    Dim i As Long, J As Integer, K As Integer, L As Integer, n As Integer, nObject As Long
    Dim TableName As String, RecNum As Long, ThePictureFile As String
    Dim Temp As String, TableNameT As String
    
'    Debug.Print X, Y
    
    '获取已选中的对象数
    If (CR = 0) Then '点选取
        nObject = CLng(MapInfo.Eval("SearchPoint(" & mapWinID & "," & X & "," & Y & ")"))
    Else '矩形选取
        nObject = CLng(MapInfo.Eval("SearchRect(" & mapWinID & "," & X & "," & Y & "," & X2 & "," & Y2 & ")"))
    End If
'    Debug.Print nObject
    If nObject > 0 Then
        bExitSub = True
        
        With frmObjectInfo
            '------------------------------
            '检测窗体的标签和文本框数目
            n = .lblField.Count
            If n > 1 Then
                For L = 1 To n - 1
                    Unload .lblField(L)
                Next
            End If
            '------------------------------
            n = .txtField.Count
            If n > 1 Then
                For L = 1 To n - 1
                    Unload .txtField(L)
                Next
            End If
            '------------------------------
            .pObject = nObject
            .X = X
            .Y = Y
            .curObject = 1
            .ReadInfo ByVal 1
            .cmdPrevious.Enabled = False
            .Show
        End With
    Else
        Screen.MousePointer = 0
        i = MsgBox("没有选中一个目标,可能是图层没有设置为可选状态！ ", vbOKOnly, "信息工具")
    End If
End Sub


'处理MapInfo信息(bak)
Public Sub UpdateInfo_bak(ByVal X As Double, ByVal Y As Double, X2 As Double, Y2 As Double, CR As Integer)
'Dim I As Long, J As Integer, K As Integer, L As Integer, N As Integer, nObject As Long
'Dim TableName As String, RecNum As Long, ThePictureFile As String
'Dim Temp As String, TableNameT As String
'
'
'If bEditNumber Then
'    nObject = CLng(MapInfo.Eval("SearchPoint(" & mapWinID & "," & X & "," & Y & ")"))
'    K = 0
'    For I = 1 To nObject
'        '获取表名
'        TableName = MapInfo.Eval("SearchInfo(" & I & "," & SEARCH_INFO_TABLE & ")")
'        '获取该对象在表中的位置
'        RecNum = CLng(MapInfo.Eval("SearchInfo(" & I & "," & SEARCH_INFO_ROW & ")"))
'        '定位该对象在表中记录位置
'        MapInfo.do "Fetch Rec " & RecNum & " From " & TableName
'        If TableName = "地类图斑" Then
'            frmNumber.mRow = RecNum '定位行
'            frmNumber.Text1.Text = MapInfo.Eval(TableName & ".Col1")
'            frmNumber.Show
'        End If
'    Next I
'    Exit Sub
'End If
'
''获取已选中的对象数
'If (CR = 0) Then '点选取
'    nObject = CLng(MapInfo.Eval("SearchPoint(" & mapWinID & "," & X & "," & Y & ")"))
'Else '矩形选取
'    nObject = CLng(MapInfo.Eval("SearchRect(" & mapWinID & "," & X & "," & Y & "," & X2 & "," & Y2 & ")"))
'End If
'
'If nObject > 0 Then
'    bExitSub = True
'
'    Screen.MousePointer = 11
'
'    'Load ShowInfo
'    ShowInfo.MSFlexGrid1.Clear
'    K = 0
'    For I = 1 To nObject
'        TableName = MapInfo.Eval("SearchInfo(" & I & "," & SEARCH_INFO_TABLE & ")")
'        K = K + Val(MapInfo.Eval("TableInfo(" & TableName & "," & TAB_INFO_NCOLS & ")"))
'    Next I
'    ShowInfo.MSFlexGrid1.Rows = K
'    ShowInfo.MSFlexGrid1.ColWidth(0) = ShowInfo.TextWidth("ABCDEFGHI")
'    ShowInfo.MSFlexGrid1.ColWidth(1) = ShowInfo.TextWidth("ABCDEFGHIJKL") 'ABCDEFGHIJKLMNOP
'    'ShowInfo.MSFlexGrid1.ColWidth(1) = ShowInfo.MSFlexGrid1.Width - 400 - ShowInfo.MSFlexGrid1.ColWidth(0)
'    ShowInfo.MSFlexGrid1.ColWidth(2) = ShowInfo.MSFlexGrid1.Width - 400 - ShowInfo.MSFlexGrid1.ColWidth(0) - ShowInfo.MSFlexGrid1.ColWidth(1)
'    ShowInfo.MSFlexGrid1.ColAlignment(0) = 1
'    ShowInfo.MSFlexGrid1.ColAlignment(1) = 1
'    ShowInfo.MSFlexGrid1.ColAlignment(2) = 1
'
'    K = -1
'    Temp = ""
'    L = 0
'    TableNameT = "("
'    For I = 1 To nObject
'        '获取表名
'        TableName = MapInfo.Eval("SearchInfo(" & I & "," & SEARCH_INFO_TABLE & ")")
'        '获取该对象在表中的位置
'        RecNum = CLng(MapInfo.Eval("SearchInfo(" & I & "," & SEARCH_INFO_ROW & ")"))
'        '定位该对象在表中记录位置
'        MapInfo.do "Fetch Rec " & RecNum & " From " & TableName
'        '获取表的字段数
'        N = Val(MapInfo.Eval("TableInfo(" & TableName & "," & TAB_INFO_NCOLS & ")"))
'        For J = 1 To N
'            K = K + 1
'            If (J = 1) Then
'                ShowInfo.MSFlexGrid1.TextMatrix(K, 0) = TableName
'            Else
'                ShowInfo.MSFlexGrid1.TextMatrix(K, 0) = ""
'            End If
'            ShowInfo.MSFlexGrid1.TextMatrix(K, 1) = MapInfo.Eval("ColumnInfo(""" & TableName & """,""col" & J & """,1)")
'            ShowInfo.MSFlexGrid1.TextMatrix(K, 2) = MapInfo.Eval(TableName & ".Col" & J)
''            ShowInfo.MSFlexGrid1.TextMatrix(K, 0) = MapInfo.Eval("ColumnInfo(""" & TableName & """,""col" & J & """,1)")
''            ShowInfo.MSFlexGrid1.TextMatrix(K, 1) = MapInfo.Eval(TableName & ".Col" & J)
'        Next J
'
'        If (TableName <> Temp) Then
'            L = L + 1
'            Temp = TableName
'            TableNameT = TableNameT + TableName + ","
'        End If
'    Next I
'    Temp = "选中" + Format(L, "#0") + "个表中的" + Format(nObject, "###0") + "个记录"
'    'Temp = "表名"
'    ShowInfo.Caption = Temp + Left(TableNameT, Len(TableNameT) - 1) + ")"
'
'    Screen.MousePointer = 0
'
'    ShowInfo.Show
'Else
'    Screen.MousePointer = 0
'    I = MsgBox("没有选中一个目标,可能是图层没有设置为可选状态！ ", vbOKOnly, "关于获取信息 ")
'End If
End Sub