cenvironment.vb

用vb.net和gis组建MO实现了一个地名数据库地理信息系统

Imports System
Imports System.Drawing

'---------------------------------------------------------------------
Public Class LayerInfo             ' 图层信息类
    Public szName As String        ' 名称
    Public szLayerName As String   ' 图层名称
    Public szFileName As String    ' 图层对应的Shape文件名
    Public szTableName As String   ' 属性表名
    Public szFieldName As String   ' 字段名称
    Public szType As String        ' 大类类型
    Public szSubType As String     ' 中类类型
    Public szSubType2 As String    ' 小类类型
    Public szSubType3 As String    ' 次小类类型
    Public bCanControl As Boolean  ' 可控制状态
    Public bVisible As Boolean     ' 可显示状态，只能通过图层控制来改变
    Public bSelected As Boolean    ' 是否被选择
    Public bCanSelected As Boolean ' 可选择状态
    Public bBackground As Boolean  ' 是否是背景图像
    Public bLable As Boolean       ' 是否被注记
    Public dScale As Double        ' 图层比例尺
    Public dShowScale As Double    ' 显示比例尺
    Public nCharacterIndex As Integer ' 注记字体索引
    Public szFontName As String    ' 注记字体名称
    Public nFontSize As Integer    ' 注记字体大小
    Public nSymSize As Integer     ' 符号大小
    Public nSymColor As UInt32     ' 符号的颜色

    Public layer As MapObjects2.MapLayer ' 对应的图层对象指针
    Public rsSel As MapObjects2.Recordset ' 图层对应的记录集
End Class
'---------------------------------------------------------------------
Public Class MPoint  ' 定义点类
    Public x As Double  ' x坐标
    Public y As Double  ' y坐标
End Class
'---------------------------------------------------------------------
Public Class MLine  ' 定义线类
    Public nPointNumber As Integer  ' 线上的点的数目
    Public pPoint As MPoint()       ' 线上各点对象数组
End Class
'---------------------------------------------------------------------
Public Class CloestPath  ' 定义最近路径类
    Public pt1 As MPoint  ' 起点
    Public pt2 As MPoint  ' 重点
End Class
'---------------------------------------------------------------------
Public Class Buses
    Public nNum As Integer
    Public pts As MPoint()

    Public Sub New()
        ReDim pts(200)
    End Sub
End Class
'---------------------------------------------------------------------
Public Enum MapOpr  ' 定义用户当前在地图窗口中的操作类型
    MO_NULL         ' 无任何操作
    MO_ZOOMIN       ' 放大操作
    MO_ZOOMOUT      ' 缩小操作
    MO_ZOOMFULL     ' 全图显示操作
    MO_PAN          ' 漫游操作
    MO_POINTSEL     ' 点选择操作
    MO_RECTSEL      ' 矩形选择操作
    MO_CIRCLESEL    ' 圆选择操作
    MO_POLYGONSEL   ' 多边形选择操作
    MO_INFO         ' 查询地物信息操作
    MO_LINEMEAS     ' 线量算操作
    MO_POLYMEAS     ' 多边形量算操作
    MO_SEACHBYDIST  ' 查询最近地物操作
    MO_CLOSEST      ' 最短路径查询操作
End Enum
'---------------------------------------------------------------------
Public Enum MapDisp ' 定义当前地图窗口中显示的地物类型
    MO_ALL          ' 显示所有地物
    MO_SCHOOL       ' 学校
    MO_TOUR         ' 旅游景点
    MO_HOSPITAL     ' 医院
    MO_SHOP         ' 商店
    MO_HOTEL        ' 宾馆
    MO_GAS          ' 加油站
    MO_BANK         ' 银行
    MO_MOVIE        ' 电影院
    MO_RESTAURANT   ' 餐馆
    MO_WC           ' 公共厕所
    MO_POST         ' 邮政局
    MO_LIBRAY       ' 图书馆
    MO_STATION      ' 公交站点
End Enum
'---------------------------------------------------------------------
Public Class MapInfo               ' 地图信息类
    Public szName As String        ' 地图名称
    Public szMetaTable As String   ' 元数据表名称
    Public szIndexTable As String  ' 索引数据表名称
    Public szType As String        ' 类型

    Public rect As MapObjects2.Rectangle ' 显示范围
End Class
'---------------------------------------------------------------------
Public Class IndexInfo             ' 地图分块索引类
    Public szName As String        ' 名称
    Public m_extent As MapObjects2.Rectangle ' 外包矩形
End Class
'---------------------------------------------------------------------
Public Class CEnvironment
    ' 常量
    Public Const BUSLINE_LAYERNAME As String = "公交线路"
    Public Const BUSSTATION_LAYERNAME As String = "公交车站"
    Public Const SYMBOL_COLOR_NONE As Integer = 9999

    Public m_szDBName As String = ""     ' 数据库名称
    Public m_szSDBPath As String = ""    ' 数据库路径
    Public m_AppPath As String = ""      ' 当前系统所在路径
    Public m_szHelpPath As String = ""   ' 帮助文件所在路径

    Public m_db As MapObjects2.DataConnection ' 数据库链接对象
    Public m_dataSet As System.Data.DataSet  ' 数据集

    Public m_nCurrMapIndex As Integer = -1  ' 当前地图在地图集合中的索引
    Public m_nMapNum As Integer = -1        ' 当前系统包含的地图数目
    Public m_mapInfos As MapInfo()          ' 地图信息对象数组

    Public m_nLayerNum As Integer = -1      ' 当前地图包含的图层的数目
    Public m_layerInfos As LayerInfo()      ' 当前地图中图层信息对象数组

    Public m_nIndexNum As Integer = -1      ' 当前地图分块索引的数目
    Public m_indexInfos As IndexInfo()      ' 当前地图分块索引信息对象数组

    Public m_selSymbol As MapObjects2.Symbol ' 选择地物使用的符号对象
    Public m_szfntStation As String = ""     ' 显示公交车站站名的字体名称
    Public m_chStation As Char = "a"         ' 显示公交车站站名的字体类型
    Public m_nfntStation As Integer = 10     ' 显示公交车站站名的字体的大小

    Public m_x, m_y As Integer   ' 用户在地图窗口中单击位置处的x、y坐标
    Public m_MapOpr As Integer   ' 用户在地图窗口中进行的操作的类型

    Public m_dDistance As Double             ' 最短距离查询所用的距离范围
    Public m_selectedFeature As Object       ' 选择的地物特征对象
    Public m_selectedSymbol As MapObjects2.Symbol ' 用于表达选择的地物的符号对象
    Public m_selectedSymbolSize As Short          ' 用于表达选择的地物的符号的大小    

    Public m_szPlaceName As String = ""     ' 需要查找的地名名称
    Public m_layerRoad As MapObjects2.MapLayer ' 街道图层

    Public m_drawLine As MLine()
    Public m_szBusFilter As String = ""
    Public m_selectedScale As Double
    Public m_bPathInit As Boolean = False
    Public m_cloestPath As CloestPath = Nothing
    Public m_path As CPath = Nothing
    Public m_buses As Buses
    'Public m_shapeRect As MapObjects2.Rectangle

    '---------------------------------------------------------------------
    Public Sub New()
        m_MapOpr = MapOpr.MO_NULL
        m_selSymbol = New MapObjects2.Symbol()
        m_selSymbol.SymbolType = MapObjects2.SymbolTypeConstants.moPointSymbol
        'm_selSymbol.Color = 0xff  
        'm_bPathInit = False
        m_nMapNum = 0
        m_nIndexNum = 0
        m_path = New CPath()
        m_cloestPath = New CloestPath()
    End Sub
    '---------------------------------------------------------------------
    Public Function GetMapIndex(ByVal szMapName As String) As Integer
        Dim nIndex As Integer = -1
        Dim i As Integer

        For i = 0 To m_nMapNum
            If szMapName = m_mapInfos(i).szName Then
                nIndex = i
                Exit For
            End If
        Next

        Return nIndex
    End Function
    '---------------------------------------------------------------------
    '功能：计算地图比例尺
    '参数：AxMapObjects2.AxMap map
    '返回值：地图比例尺
    Public Function CalcScale(ByVal map As AxMapObjects2.AxMap) As Double
        Dim hwnd As New IntPtr(map.hWnd)
        Dim g As System.Drawing.Graphics
        g = Graphics.FromHwnd(hwnd)

        Dim pts(1) As MPoint
        pts(0) = New MPoint()
        pts(0).x = map.Extent.Left
        pts(0).y = map.Extent.Top
        pts(1) = New MPoint()
        pts(1).x = map.Extent.Right
        pts(1).y = map.Extent.Top

        Dim dLen1 As Double
        dLen1 = CalcLenght(pts, 2)

        Dim dLen2 As Double
        dLen2 = map.Width / g.DpiX * 2.54 / 100

        g.Dispose()
        Return dLen1 / dLen2
    End Function

    Public Function CalcScale(ByVal map As AxMapObjects2.AxMap, ByVal extent As MapObjects2.Rectangle) As Double
        Dim hwnd As New IntPtr(map.hWnd)
        Dim g As System.Drawing.Graphics
        g = Graphics.FromHwnd(hwnd)

        Dim pts(1) As MPoint
        pts(0) = New MPoint()
        pts(0).x = extent.Left
        pts(0).y = extent.Top
        pts(1) = New MPoint()
        pts(1).x = extent.Right
        pts(1).y = extent.Top

        Dim dLen1 As Double = CalcLenght(pts, 2)

        Dim dLen2 As Double = map.Width / g.DpiX * 2.54 / 100

        Return dLen1 / dLen2
    End Function

    '-----------------------------------------------------------------
    Public Function SubGussFs(ByRef X As Double, ByRef Y As Double, ByVal C As Double, ByVal L As Double, ByVal nCenterLongi As Integer)
        '高斯投影分带
        Dim nzonenum As Integer
        If nCenterLongi = 0 Then
            nzonenum = L / 6 + 1
            nCenterLongi = nzonenum * 6 - 3
        Else
            nzonenum = nCenterLongi / 6 + 1
        End If

        '以弧度为单位的经纬度数值()
        Dim rB As Double = C / 180 * 3.1415926
        Dim rL As Double = (L - nCenterLongi) / 180 * 3.1415926 '同时计算了中央经线
        '1980坐标系参数
        Dim a As Double = 6378245.0        '长轴
        Dim b As Double = 6356863.5        '短轴
        Dim sqre1 As Double = (a * a - b * b) / (a * a) '第一偏心率平方
        'B:纬度
        'L:精度
        '子午圈曲率半径
        Dim sinb As Double = Math.Sin(rB)
        Dim cosb As Double = Math.Cos(rB)
        Dim M As Double = a * (1 - sqre1) / (1 - sqre1 * sinb * sinb) / Math.Sqrt(1 - sqre1 * sinb * sinb)
        '卯酉圈曲率半径
        Dim N As Double = a / Math.Sqrt(1 - sqre1 * sinb * sinb)
        Dim sqrita As Double = N / M - 1

        '该纬度点到赤道的子午线弧长
        Dim s As Double
        s = a * (1 - sqre1) * (1.00505117739 * rB - 0.00506237764 / 2 * Math.Sin(2 * rB) + 0.0000106245 / 4 * Math.Sin(4 * rB) - 0.00000002081 / 6 * Math.Sin(6 * rB))

        Dim tanb As Double = Math.Tan(rB)
        X = s + rL * rL * N / 2 * sinb * cosb + rL * rL * rL * rL * N / 24 * sinb * cosb * cosb * cosb * (5 - tanb * tanb + 9 * sqrita * sqrita + 4 * sqrita)
        Y = rL * N * cosb + rL * rL * rL * N / 6 * cosb * cosb * cosb * (1 - tanb * tanb + sqrita) + rL * rL * rL * rL * rL * N / 120 * cosb * cosb * cosb * cosb * cosb * (5 - 18 * tanb * tanb + tanb * tanb * tanb * tanb)
        Y = Y + 500000 + nzonenum * 1000000.0
    End Function
    '-----------------------------------------------------------------
    Private Function SubGussFs(ByVal X As Double, ByVal Y As Double, ByVal L0 As Double, ByRef B As Double, ByRef L As Double)
        Dim p As Double = 57.29577951472
        Dim a As Double = 6378245.0
        Dim e2 As Double = 0.00669342162297
        Dim e12 As Double = 0.00673852541468
        Dim c0 As Double = 0.000000157046064172
        Dim c1 As Double = 0.005051773759
        Dim c2 As Double = 0.000029837302
        Dim c3 As Double = 0.000000238189

        Dim bf0 As Double = c0 * X
        Dim bf0c As Double = Math.Cos(bf0)
        Dim bf0s As Double = Math.Sin(bf0)
        Dim bf As Double = bf0 + bf0c * (c1 * bf0s - c2 * Math.Pow(bf0s, 3) + c3 * Math.Pow(bf0s, 5))
        Dim bt As Double = Math.Tan(bf)
        Dim bc As Double = Math.Cos(bf)
        Dim bs As Double = Math.Sin(bf)
        Dim bi As Double = e12 * Math.Pow(bc, 2)
        Dim v2 As Double = 1.0 + bi
        Dim bn As Double = a / Math.Sqrt(1.0 - e2 * Math.Pow(bs, 2))
        Dim yn As Double = Y / bn

        ' 计算纬度
        Dim b1 As Double = -v2 * bt * Math.Pow(yn, 2) / 2.0
        Dim b2 As Double = -(5.0 + 3.0 * Math.Pow(bt, 2) + bi - 9.0 * bi * Math.Pow(bt, 2)) * b1 * Math.Pow(yn, 2) / 12.0
        Dim b3 As Double = (61.0 + 90.0 * Math.Pow(bt, 2) + 45.0 * Math.Pow(bt, 4)) * b1 * Math.Pow(yn, 4) / 360.0
        B = bf + b1 + b2 + b3
        B = B * p

        ' 计算经度
        Dim l1 As Double = yn / bc
        Dim l2 As Double = -(1.0 + 2.0 * Math.Pow(bt, 2) + bi) * l1 * Math.Pow(yn, 2) / 6.0
        Dim l3 As Double = (5.0 + 28.0 * Math.Pow(bt, 2) + 24.0 * Math.Pow(bt, 4) + 6.0 * bi + 8.0 * bi * Math.Pow(bt, 2)) * l1 * Math.Pow(yn, 4) / 120.0
        L = l1 + l2 + l3
        L = L * p

        L = L + L0
        If L > 360.0 Then
            L = L - 360.0
        End If
    End Function
    '-----------------------------------------------------------------
    Private Function CalGuassToLB(ByVal dX As Double, ByVal dY As Double, ByRef dLongitude As Double, ByRef dLatitude As Double)
        Dim L0 As Double
        Dim nZoonNum As Integer