?? mapsis.cls
字號:
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
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -