?? mapinfo.bas
字號:
Attribute VB_Name = "Module1"
'移動窗口
Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Const WM_CLOSE = &H10
Private Const WM_QUIT = &H12
Public MapInfo As Object 'Mapinfo對象
Public theResponder As Object '存儲Mapinfo回調信息
Public thereIsAMap As Boolean '存儲是否已打開Mapinfo地圖
Public mapWinID As Long '存儲Mapinfo圖形窗口序列號
Public BrowserWinID As Long '存儲Mapinfo瀏覽窗口序列號
'更新選單(Menu)和工具條(ToolBar)
Public Sub EnabledMenuAndToolbar()
Dim I As Integer, bEnabled As Boolean
On Error Resume Next
'Begin可編輯圖層參數設置
If (mapWinID > 0) Then
I = CInt(MapInfo.Eval("MapperInfo(" & mapWinID & "," & MAPPER_INFO_EDIT_LAYER & ")"))
If (I >= 0) Then '有可編輯圖層
TableName = MapInfo.Eval("LayerInfo(" & mapWinID & "," & I & ",1)")
bEnabled = True
Else '無可編輯圖層
bEnabled = False
End If
Else
bEnabled = False
End If
'End可編輯圖層參數設置
'工具按鈕
fMainForm.tbarMain.Buttons("Symbol").Enabled = bEnabled
fMainForm.tbarMain.Buttons("Line").Enabled = bEnabled
fMainForm.tbarMain.Buttons("PolyLine").Enabled = bEnabled
fMainForm.tbarMain.Buttons("Arc").Enabled = bEnabled
fMainForm.tbarMain.Buttons("Polygon").Enabled = bEnabled
fMainForm.tbarMain.Buttons("Ellipse").Enabled = bEnabled
fMainForm.tbarMain.Buttons("Rectangle").Enabled = bEnabled
fMainForm.tbarMain.Buttons("RoundedRectangle").Enabled = bEnabled
fMainForm.tbarMain.Buttons("Text").Enabled = bEnabled
fMainForm.tbarMain.Buttons("ReShape").Enabled = bEnabled
fMainForm.tbarMain.Buttons("AddNode").Enabled = bEnabled
fMainForm.tbarMain.Buttons("ReShape").Value = 0
fMainForm.tbarMain.Buttons("AddNode").Value = 0
fMainForm.tbarMain.Buttons("EllipsStyle").Enabled = bEnabled
'選單
fMainForm.mnuEditUndo.Enabled = bEnabled
fMainForm.mnuEditCut.Enabled = bEnabled
fMainForm.mnuEditCopy.Enabled = bEnabled
fMainForm.mnuEditPaste.Enabled = bEnabled
fMainForm.mnuEditDel.Enabled = bEnabled
fMainForm.mnuEditDelMap.Enabled = bEnabled
fMainForm.mnuEditShapes.Enabled = bEnabled
fMainForm.mnuEditNewRow.Enabled = bEnabled
fMainForm.mnuObjects_Set_Target.Enabled = bEnabled
fMainForm.mnuObjects_Clear_Target.Enabled = bEnabled
fMainForm.mnuObjects_Combine.Enabled = bEnabled
fMainForm.mnuObjects_SPLIT.Enabled = bEnabled
fMainForm.mnuObjects_ERASE.Enabled = bEnabled
fMainForm.mnuObjects_ERASE_OUT.Enabled = bEnabled
fMainForm.mnuObjects_OVERLAY.Enabled = bEnabled
fMainForm.mnuObjectsConvexHull.Enabled = bEnabled
fMainForm.mnuObjectsCheckRegions.Enabled = bEnabled
fMainForm.mnuObjects_BUFFER.Enabled = bEnabled
fMainForm.mnuObjects_SMOOTH.Enabled = bEnabled
fMainForm.mnuObjects_UNSMOOTH.Enabled = bEnabled
fMainForm.mnuObjects_CVT_PGON.Enabled = bEnabled
fMainForm.mnuObjects_CVT_PLINE.Enabled = bEnabled
End Sub
'關閉指定圖層
Public Sub CloseSelectedLayer()
Dim nLayers As Integer
On Error GoTo Error1
If thereIsAMap Then
'查找圖層數
nLayers = CInt(MapInfo.Eval("MapperInfo(" & mapWinID & "," & MAPPER_INFO_LAYERS & ")"))
'' UpdateMenuAndToolbar
End If
Exit Sub
Error1:
thereIsAMap = False
mapWinID = 0
BrowserWinID = 0
End Sub
'關閉VB與MapInfo的連接,否則VB程序不能關閉
Public Sub ShutdownMapInfoConnection()
MapInfo.RunMenuCommand M_FILE_CLOSE_ALL
If Not (MapInfo Is Nothing) Then
MapInfo.SetCallback Nothing
End If
Set MapInfo = Nothing
Set theResponder = Nothing
End Sub
'初始化MapInfo與VB的連接
Public Sub InitializeMapInfoConnection()
Call CloseExitMapInfo
On Error Resume Next
'第一步,構造一個MapInfo應用程序句柄
MapinfoRunTime = False
Set MapInfo = CreateObject("MapInfo.Application")
If (MapInfo = "") Then
Set MapInfo = CreateObject("MapInfo.runtime")
If (MapInfo = "") Then
MsgBox "無MapInfo 運行版 或 MapInfo Professional!" + Chr(10) + Chr(13) + Chr(10) + Chr(13) + "不能運行!", vbOKOnly, "關于運行"
End
End If
MapinfoRunTime = True
End If
'第二步,設置MapInfo全部對話框為本應用程序的子窗口
MapInfo.Do "Set Application Window " & fMainForm.hwnd
'第三步,定義MapInfo與VB通訊句柄,使MapInfo給VB返回信息
Set theResponder = New MapSIS
MapInfo.SetCallback theResponder
'第四步,設置右鍵功能菜單
MapInfo.Do "Create Menu ""MapperShortcut"" ID 17 As " & _
"""圖層控制..."" ID 1001 Calling OLE ""HandleMenuSelection"", " & _
"""(-"", " & _
"""清除裝飾圖層"" ID 1002 Calling OLE ""HandleMenuSelection"", " & _
"""(-"", " & _
"""全選"" ID 1003 Calling OLE ""HandleMenuSelection"", " & _
"""反選"" ID 1004 Calling OLE ""HandleMenuSelection"", " & _
"""全不選"" ID 1005 Calling OLE ""HandleMenuSelection"", " & _
"""(-"", " & _
"""前一視圖"" ID 1006 Calling OLE ""HandleMenuSelection"", " & _
"""查看整個圖層..."" ID 1007 Calling OLE ""HandleMenuSelection"", " & _
"""地圖投影..."" ID 1008 Calling OLE ""HandleMenuSelection"", " & _
"""(-"", " & _
"""獲取信息"" ID 1010 Calling OLE ""HandleMenuSelection"""
'第五步,設置工具箱按鈕的響應
'* note: DrawMode 34 = single point drawmode, DrawMode 32 = marquee (rectangle) drawmmode
MapInfo.Do "Create ButtonPad ""Custom Tools"" As " & _
"ToolButton ID 2001 DrawMode 34 Calling OLE ""HandleToolButton"" Cursor 138 " & _
"ToolButton ID 2002 DrawMode 32 Calling OLE ""HandleToolButton"" Cursor 138 "
'第六步,其它
'定義程序用Object
MapInfo.Do "Dim OBJ_Temp as Object"
MapInfo.Do "Dim OBJ_Temp1 as Object"
MapInfo.Do "Dim OBJ_Temp2 as Object"
MapInfo.Do "Dim OBJ_Temp3 as Object"
MapInfo.Do "Dim AreaFloat as float"
MapInfo.Do "Dim MinLat as float"
MapInfo.Do "Dim MaxLat as float"
MapInfo.Do "Dim MinLon as float"
MapInfo.Do "Dim MaxLon as float"
MapInfo.Do "Dim InPoly as Object"
MapInfo.Do "Dim AreaObj as Object"
MapInfo.Do "Dim CurSymbol As Symbol"
MapInfo.Do "Dim Brush_Temp as Brush"
MapInfo.Do "Dim Pen_Temp as Pen"
MapInfo.Do "Create Rect Into Variable InPoly (0,0) (150,60)"
bOKCancel = True
AreaType = 0
MapInfo.Do "Set Style Brush MakeBrush(1," & CYAN & "," & BLUE & ")"
thereIsAMap = False '* initially, there is no map window
mapWinID = 0 '* a window ID of 0 means no window
MapInfo.RunMenuCommand M_TOOLS_SELECTOR '* make MapInfo's select tool active
''UpdateMenuAndToolbar
End Sub
Private Sub CloseExitMapInfo()
Dim winHwnd As Long, RetVal As Long
winHwnd = FindWindow(vbNullString, "MapInfo Professional")
If winHwnd <> 0 Then
RetVal = PostMessage(winHwnd, WM_QUIT, 0&, 0&)
End If
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -