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