mapsis.cls

MapInfo 行业应用源代码

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "MapSIS"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True

'取指定字段字符串
Private Function GetField(ByVal theStr As String, ByVal whichField As Integer, Delimiter As String) As String
Dim I As Integer
Dim startPos As Integer
Dim argCount As Integer
Dim tmpStr, result As String

If Len(theStr) = 0 Or whichField < 1 Then
    GetField = ""
    Exit Function
End If

argCount = 0
tmpStr = theStr
While InStr(tmpStr, Delimiter) > 0 And argCount < whichField
    argCount = argCount + 1
    result = Left$(tmpStr, InStr(tmpStr, Delimiter) - 1)
    tmpStr = Mid$(tmpStr, InStr(tmpStr, Delimiter) + 1)
Wend

If argCount < whichField Then
    argCount = argCount + 1
    result = tmpStr
End If

If argCount = whichField Then
    GetField = result
Else
    GetField = ""
End If
End Function
'处理右键"快捷选单"命令,"快捷选单"由InitializeMapInfoConnection设定
Public Sub HandleMenuSelection(ByVal CommandInfoStr As String)
    Dim whichItem As Integer

    If (Left(CommandInfoStr, 3) <> "MI:") Then Exit Sub '非MapInfo信息

    CommandInfoStr = Mid$(CommandInfoStr, 4, 9999)

    whichItem = CInt(GetField(CommandInfoStr, CMD_INFO_MENUITEM, ","))
    Select Case whichItem
        Case 1001 '图层控制
            If thereIsAMap Then
                MapInfo.RunMenuCommand M_MAP_LAYER_CONTROL
                Call EnabledMenuAndToolbar
            End If
        Case 1002 '清除装饰图层
            MapInfo.RunMenuCommand M_MAP_CLEAR_COSMETIC
        Case 1003 '全选
            MapInfo.RunMenuCommand M_ANALYZE_SELECTALL
        Case 1004 '反选
            MapInfo.RunMenuCommand 311
        Case 1005 '全不选
            MapInfo.RunMenuCommand M_ANALYZE_UNSELECT
        Case 1006 '前一视图
            MapInfo.RunMenuCommand M_MAP_PREVIOUS
        Case 1007 '查看整个图层
            MapInfo.RunMenuCommand M_MAP_ENTIRE_LAYER
        Case 1008 '地图投影
            MapInfo.RunMenuCommand M_MAP_OPTIONS
        Case 1010 '获取信息
            MapInfo.RunMenuCommand M_EDIT_GETINFO
    End Select
End Sub
'处理"工具条命令","工具条命令"由InitializeMapInfoConnection设定
Public Sub HandleToolButton(ByVal CommandInfoStr As String)
Dim whichButton As Integer
Dim MapX1 As Double, MapY1 As Double '存储起始点坐标
Dim MapX2 As Double, MapY2 As Double '存储终止点坐标


If (Left(CommandInfoStr, 3) <> "MI:") Then Exit Sub '非MapInfo信息
CommandInfoStr = Mid$(CommandInfoStr, 4, 9999)

'判定选择工具
whichButton = CInt(GetField(CommandInfoStr, CMD_INFO_TOOLBTN, ","))

Select Case whichButton
    Case 2001 '点选取工具
        MapX1 = CDbl(GetField(CommandInfoStr, CMD_INFO_X, ","))
        MapY1 = CDbl(GetField(CommandInfoStr, CMD_INFO_Y, ","))
        UpdateInfo MapX1, MapY1, 0, 0, 0
    Case 2002 '矩形工具
        MapX1 = CDbl(GetField(CommandInfoStr, CMD_INFO_X, ","))
        MapY1 = CDbl(GetField(CommandInfoStr, CMD_INFO_Y, ","))
        MapX2 = CDbl(GetField(CommandInfoStr, CMD_INFO_X2, ","))
        MapY2 = CDbl(GetField(CommandInfoStr, CMD_INFO_Y2, ","))
        UpdateInfo MapX1, MapY1, MapX2, MapY2, 1
End Select
End Sub
'这是一个标准的MapInfo回调过程,当一个窗口状态改变时调用该子程序(如移动图层)
Public Sub WindowContentsChanged(ByVal WinID As Long)
If WinID = mapWinID Then
        ''UpdateLayerList     '* make sure the layer list is up to date
        ''UpdateMenuAndToolbar    '* make sure menu & toolbar are properly activated
End If
End Sub


'这是一个标准的MapInfo回调过程，时时跟踪MapInfo的状态是否改变，其返回字符串为Tab分开的三个字段
'第一个字段为视野Zoom、地图比例Scale或光标位置Cursor Location
'第二个字段为是否有可编辑图层
'第三个字段不详
Public Sub SetStatusText(ByVal StatusText As String)
    Dim OneField As String, TwoField, I As Integer
    Dim Lon As Double

    OneField = GetField(StatusText, 1, Chr(9))
    TwoField = GetField(StatusText, 2, Chr(9))
    I = InStr(OneField, "°")
    If (I > 0) Then
        Lon = Val(Left(OneField, I))
        If (Lon > 180) Then
            fMainForm.sbStatusBar.Panels(1).Text = Format(Lon - 360, "##0.00") + Right(OneField, Len(OneField) - I + 1)
        Else
            fMainForm.sbStatusBar.Panels(1).Text = OneField
        End If
    Else
        fMainForm.sbStatusBar.Panels(1).Text = OneField
    End If
    fMainForm.sbStatusBar.Panels(2).Text = TwoField
End Sub