mapinfo.bas

VB+mapinfo开发的最短路径

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