Attribute VB_Name = "Module1"
'移動(dòng)窗口
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對(duì)象
Public theResponder As Object           '存儲(chǔ)Mapinfo回調(diào)信息
Public thereIsAMap As Boolean           '存儲(chǔ)是否已打開(kāi)Mapinfo地圖
Public mapWinID As Long                 '存儲(chǔ)Mapinfo圖形窗口序列號(hào)
Public BrowserWinID As Long             '存儲(chǔ)Mapinfo瀏覽窗口序列號(hào)
'更新選單（Menu)和工具條(ToolBar)
Public Sub EnabledMenuAndToolbar()
    Dim I As Integer, bEnabled As Boolean

    On Error Resume Next
    
    'Begin可編輯圖層參數(shù)設(shè)置
    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 '無(wú)可編輯圖層
            bEnabled = False
        End If
    Else
        bEnabled = False
    End If
    'End可編輯圖層參數(shù)設(shè)置

    '工具按鈕
    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
'關(guān)閉指定圖層
Public Sub CloseSelectedLayer()
Dim nLayers As Integer

On Error GoTo Error1
If thereIsAMap Then
    '查找圖層數(shù)
    nLayers = CInt(MapInfo.Eval("MapperInfo(" & mapWinID & "," & MAPPER_INFO_LAYERS & ")"))
''    UpdateMenuAndToolbar
End If
Exit Sub
Error1:
thereIsAMap = False
mapWinID = 0
BrowserWinID = 0
End Sub
'關(guān)閉VB與MapInfo的連接,否則VB程序不能關(guān)閉
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
'第一步,構(gòu)造一個(gè)MapInfo應(yīng)用程序句柄
MapinfoRunTime = False

Set MapInfo = CreateObject("MapInfo.Application")
If (MapInfo = "") Then
    Set MapInfo = CreateObject("MapInfo.runtime")
    If (MapInfo = "") Then
        MsgBox "無(wú)MapInfo 運(yùn)行版 或 MapInfo Professional!" + Chr(10) + Chr(13) + Chr(10) + Chr(13) + "不能運(yùn)行!", vbOKOnly, "關(guān)于運(yùn)行"
        End
    End If
    MapinfoRunTime = True
End If
'第二步,設(shè)置MapInfo全部對(duì)話框?yàn)楸緫?yīng)用程序的子窗口
MapInfo.Do "Set Application Window " & fMainForm.hwnd

'第三步,定義MapInfo與VB通訊句柄,使MapInfo給VB返回信息
Set theResponder = New MapSIS
MapInfo.SetCallback theResponder

'第四步,設(shè)置右鍵功能菜單
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"", " & _
        """查看整個(gè)圖層..."" ID 1007 Calling OLE ""HandleMenuSelection"", " & _
        """地圖投影..."" ID 1008 Calling OLE ""HandleMenuSelection"", " & _
        """(-"", " & _
        """獲取信息"" ID 1010 Calling OLE ""HandleMenuSelection"""
'第五步,設(shè)置工具箱按鈕的響應(yīng)
'*  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