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設(shè)定
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設(shè)定
Public Sub HandleToolButton(ByVal CommandInfoStr As String)
Dim whichButton As Integer
Dim MapX1 As Double, MapY1 As Double '存儲起始點坐標(biāo)
Dim MapX2 As Double, MapY2 As Double '存儲終止點坐標(biāo)


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
'這是一個標(biāo)準(zhǔn)的MapInfo回調(diào)過程,當(dāng)一個窗口狀態(tài)改變時調(diào)用該子程序(如移動圖層)
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


'這是一個標(biāo)準(zhǔn)的MapInfo回調(diào)過程，時時跟蹤MapInfo的狀態(tài)是否改變，其返回字符串為Tab分開的三個字段
'第一個字段為視野Zoom、地圖比例Scale或光標(biāo)位置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