cenvironment.vb

地理信息系统二次开发实例教程VB.NET及源代码

        nZoonNum = dY / (1000000.0)
        L0 = nZoonNum * 6 - 3

        dY = dY - nZoonNum * 1000000.0
        SubGussFs(dX, dY - 500000, L0, dLatitude, dLongitude)
        dLongitude = dLongitude + nZoonNum * 6 - 3
    End Function
    '-----------------------------------------------------------------
    Public Function CalGuassFromLB(ByVal dLongitude As Double, ByVal dLatitude As Double, ByRef dX As Double, ByRef dY As Double, ByVal nCenterL As Integer)
        Dim CenterL As Integer = nCenterL

        SubGussFs(dX, dY, dLatitude, dLongitude, CenterL)

        nCenterL = CenterL
    End Function
    '-----------------------------------------------------------------
    ' 计算一点对象数组之间的长度
    Public Function CalcLenght(ByVal pt As MPoint(), ByVal nSize As Integer) As Double
        Dim dLength As Double = 0
        Dim x1, x2, y1, y2 As Double
        x1 = 0
        x2 = 0
        y1 = 0
        y2 = 0
        Dim nCenterL As Integer = ((pt(0).x) / 6 + 1) * 6 - 3

        Dim i As Integer
        For i = 0 To nSize - 2
            CalGuassFromLB(pt(i).x, pt(i).y, x1, y1, nCenterL)
            CalGuassFromLB(pt(i + 1).x, pt(i + 1).y, x2, y2, nCenterL)
            dLength += Math.Sqrt((x1 - x2) * (x1 - x2) + (y1 - y2) * (y1 - y2))
        Next

        Return dLength
    End Function
    '-----------------------------------------------------------------
    Public Function GetLayerVisible(ByVal disp As Integer)
        Dim bVisible As Boolean = True
        Dim nType As Integer = 2
        Dim szSubType As String = ""

        If disp = MapDisp.MO_ALL Then
            nType = 1
        ElseIf disp = MapDisp.MO_HOSPITAL Then
            szSubType = "医院"
        ElseIf disp = MapDisp.MO_SCHOOL Then
            szSubType = "教育"
        ElseIf disp = MapDisp.MO_SHOP Then
            szSubType = "零售"
        ElseIf disp = MapDisp.MO_TOUR Then
            szSubType = "旅游"
        ElseIf disp = MapDisp.MO_HOTEL Then
            szSubType = "住宿"
        ElseIf disp = MapDisp.MO_LIBRAY Then
            szSubType = "图书馆"
            nType = 3
        ElseIf disp = MapDisp.MO_MOVIE Then
            szSubType = "影剧院、音乐厅"
            nType = 3
        ElseIf disp = MapDisp.MO_POST Then
            szSubType = "邮政"
        ElseIf disp = MapDisp.MO_RESTAURANT Then
            szSubType = "餐饮"
        ElseIf disp = MapDisp.MO_WC Then
            szSubType = "dddd"
        ElseIf disp = MapDisp.MO_STATION Then
            szSubType = "站点"
            nType = 4
        End If

        Dim nCount As Integer = 0
        Dim i As Integer
        For i = 0 To m_nLayerNum - 1
            If m_layerInfos(i).bCanControl Then
                If nType = 1 Then
                    nCount = nCount + 1
                    If m_layerInfos(i).bVisible = False Then
                        Return False
                    End If
                ElseIf nType = 2 Then
                    If szSubType = m_layerInfos(i).szSubType Then
                        nCount = nCount + 1
                        If m_layerInfos(i).bVisible = False Then
                            Return False
                        End If
                    End If
                ElseIf nType = 3 Then
                    If szSubType = m_layerInfos(i).szSubType2 Then
                        nCount = nCount + 1
                        If m_layerInfos(i).bVisible = False Then
                            Return False
                        End If
                    End If
                ElseIf nType = 4 Then
                    If szSubType = m_layerInfos(i).szSubType3 Then
                        nCount = nCount + 1
                        If m_layerInfos(i).bVisible = False Then
                            Return False
                        End If
                    End If
                End If
            End If
        Next

        If 0 = nCount Then
            bVisible = False
        End If

        Return bVisible
    End Function
    '-----------------------------------------------------------------
    Public Function GetLayerIndexByName(ByVal szName As String) As Integer
        Dim nIndex As Integer = -1
        Dim i As Integer

        For i = 0 To m_nLayerNum - 1
            If szName = m_layerInfos(i).szName Then
                nIndex = i
                GoTo endfunction
            End If
        Next
endfunction:
        Return nIndex
    End Function

    Public Sub ClearSelRsts()
        Dim i As Integer
        For i = 0 To m_nLayerNum - 1
            m_layerInfos(i).rsSel = Nothing
        Next
    End Sub
    '---------------------------------------------------------------------
    Public Sub SetLayerVisible(ByVal disp As Integer, ByVal bVisible As Boolean, ByVal dScale As Double)
        Dim nType As Integer = 2
        Dim szSubType As String = ""

        If disp = MapDisp.MO_ALL Then
            nType = 1
        ElseIf disp = MapDisp.MO_HOSPITAL Then
            szSubType = "医院"
        ElseIf disp = MapDisp.MO_SCHOOL Then
            szSubType = "教育"
        ElseIf disp = MapDisp.MO_SHOP Then
            szSubType = "零售"
        ElseIf disp = MapDisp.MO_TOUR Then
            szSubType = "旅游"
        ElseIf disp = MapDisp.MO_HOTEL Then
            szSubType = "住宿"
        ElseIf disp = MapDisp.MO_LIBRAY Then
            szSubType = "图书馆"
            nType = 3
        ElseIf disp = MapDisp.MO_MOVIE Then
            szSubType = "影剧院、音乐厅"
            nType = 3
        ElseIf disp = MapDisp.MO_POST Then
            szSubType = "邮政"
        ElseIf disp = MapDisp.MO_RESTAURANT Then
            szSubType = "餐饮"
        ElseIf disp = MapDisp.MO_WC Then
            szSubType = "厕所"
        ElseIf disp = MapDisp.MO_STATION Then
            szSubType = "站点"
            nType = 4
        End If

        Dim i As Integer
        For i = 0 To m_nLayerNum - 1
            If m_layerInfos(i).bCanControl = True Then
                If nType = 1 Then
                    If bVisible = False Then
                        m_layerInfos(i).bVisible = bVisible
                        m_layerInfos(i).layer.Visible = m_layerInfos(i).bVisible
                    Else
                        m_layerInfos(i).bVisible = bVisible
                        If m_layerInfos(i).dScale > dScale Then
                            m_layerInfos(i).layer.Visible = m_layerInfos(i).bVisible
                        End If
                    End If
                ElseIf nType = 2 Then
                    If szSubType = m_layerInfos(i).szSubType Then
                        If bVisible = False Then
                            m_layerInfos(i).bVisible = bVisible
                            m_layerInfos(i).layer.Visible = m_layerInfos(i).bVisible
                        Else
                            m_layerInfos(i).bVisible = bVisible
                            If m_layerInfos(i).dScale > dScale Then
                                m_layerInfos(i).layer.Visible = m_layerInfos(i).bVisible
                            End If
                        End If
                    End If
                ElseIf nType = 3 Then
                    If szSubType = m_layerInfos(i).szSubType2 Then
                        If bVisible = False Then
                            m_layerInfos(i).bVisible = bVisible
                            m_layerInfos(i).layer.Visible = m_layerInfos(i).bVisible
                        Else
                            m_layerInfos(i).bVisible = bVisible
                            If m_layerInfos(i).dScale > dScale Then
                                m_layerInfos(i).layer.Visible = m_layerInfos(i).bVisible
                            End If
                        End If
                    End If
                ElseIf nType = 4 Then
                    If szSubType = m_layerInfos(i).szSubType3 Then
                        If bVisible = False Then
                            m_layerInfos(i).bVisible = bVisible
                            m_layerInfos(i).layer.Visible = m_layerInfos(i).bVisible
                        Else
                            m_layerInfos(i).bVisible = bVisible
                            If m_layerInfos(i).dScale > dScale Then
                                m_layerInfos(i).layer.Visible = m_layerInfos(i).bVisible
                            End If
                        End If
                    End If
                End If
            End If
        Next
    End Sub
    '---------------------------------------------------------------------
    ' 功能：实现空间查询
    Public Sub ExecuteSpatial(ByVal map As AxMapObjects2.AxMap, ByVal shape As Object, ByVal sMode As MapObjects2.SearchMethodConstants, ByVal bMPoint As Boolean)
        Dim i As Integer
        For i = 0 To m_nLayerNum - 1
            If bMPoint = True Then
                ' 首先计算显示比例尺
                Dim dScale As Double = CalcScale(map)
                If dScale > 8000 Then
                    dScale = dScale / 10000
                    dScale = dScale / 5000
                Else
                    dScale = dScale / 10000
                    dScale = dScale / 2500
                End If

                ' 调用图层对象的SearchByDistance方法执行查询
                If m_layerInfos(i).layer.Visible = True And m_layerInfos(i).bCanSelected = True Then
                    m_layerInfos(i).rsSel = m_layerInfos(i).layer.SearchByDistance(shape, dScale, "")
                Else
                    m_layerInfos(i).rsSel = Nothing
                End If
            Else
                ' 调用图层对象的SearchShape方法执行查询
                If m_layerInfos(i).layer.Visible = True And m_layerInfos(i).bCanSelected = True Then
                    m_layerInfos(i).rsSel = m_layerInfos(i).layer.SearchShape(shape, sMode, "")
                Else
                    m_layerInfos(i).rsSel = Nothing
                End If
            End If
        Next
    End Sub
    '---------------------------------------------------------------------
    Public Sub DrawRecordset(ByVal map As AxMapObjects2.AxMap)
        Dim i As Integer
        For i = 0 To m_nLayerNum - 1
            If m_layerInfos(i).layer.Visible = True Then
                If Not m_layerInfos(i).rsSel Is Nothing Then
                    ' 创建符号对象
                    Dim sym As New MapObjects2.Symbol()
                    sym.SymbolType = m_layerInfos(i).layer.Symbol.SymbolType
                    sym.Style = m_layerInfos(i).layer.Symbol.Style
                    sym.Size = m_layerInfos(i).layer.Symbol.Size
                    sym.Color = System.Convert.ToUInt32(MapObjects2.ColorConstants.moRed)

                    If m_layerInfos(i).nCharacterIndex >= 0 And m_layerInfos(i).layer.shapeType = MapObjects2.ShapeTypeConstants.moShapeTypePoint Then
                        sym.SymbolType = MapObjects2.SymbolTypeConstants.moPointSymbol
                        sym.Font.Name = m_layerInfos(i).szFontName
                        sym.Style = 4
                        sym.Size = m_layerInfos(i).layer.Symbol.Size
                        sym.CharacterIndex = m_layerInfos(i).nCharacterIndex
                    End If

                    m_layerInfos(i).rsSel.MoveFirst()

                    While m_layerInfos(i).rsSel.EOF = False
                        ' 调用地图对象的DrawShape函数来绘制选择的地物
                        map.DrawShape(m_layerInfos(i).rsSel.Fields.Item("Shape").Value, sym)
                        m_layerInfos(i).rsSel.MoveNext()
                    End While
                End If
            End If
        Next
    End Sub
    '---------------------------------------------------------------------
    Public Sub DrawSelectedShape(ByVal map As AxMapObjects2.AxMap, ByVal frm As MainForm)
        Dim sym As New MapObjects2.Symbol()
        sym.Color = System.Convert.ToUInt32(MapObjects2.ColorConstants.moRed)

        If m_selectedSymbol Is Nothing Then
            map.DrawShape(m_selectedFeature, sym)
        Else
            Dim dScale As Double = CalcScale(map)
            m_selectedSymbol.Size = frm.ReCalcFontSize(m_selectedSymbolSize, dScale)
            map.DrawShape(m_selectedFeature, m_selectedSymbol)
        End If
    End Sub
    '---------------------------------------------------------------------
    Public Function GetLineLength(ByVal line As MapObjects2.Line) As Double
        Dim pt As MPoint()
        Dim nPtCount As Integer
        Dim pts As MapObjects2.Points

        pts = line.Parts.Item(0)
        nPtCount = pts.Count

        If nPtCount < 2 Then
            Return 0.0
        End If

        ReDim pt(nPtCount - 1)
        Dim i As Integer