mapsis.bas

MapInfo 行业应用源代码

Attribute VB_Name = "Module4"
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 Form1, fMainForm As 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 Form1

    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


'获取已选中的对象数
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("ABCDEFGHIJKLMNOP")
    ShowInfo.MSFlexGrid1.ColWidth(2) = ShowInfo.MSFlexGrid1.Width - 500 - 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)
        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") + "个记录"
    ShowInfo.Caption = Temp + Left(TableNameT, Len(TableNameT) - 1) + ")"
    
    Screen.MousePointer = 0
    
    ShowInfo.Show 1
Else
    Screen.MousePointer = 0
    I = MsgBox("没有选中一个目标,可能是图层没有设置为可选状态！ ", vbOKOnly, "关于获取信息 ")
End If
End Sub

Public Sub Main()
If App.PrevInstance Then
    End
Else
    Set fMainForm = New frmMain

    frmAbout.Show
    DoEvents
    fMainForm.Show
End If
End Sub