cenvironment.vb

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

        For i = 0 To nPtCount - 1
            Dim point As MapObjects2.Point = pts.Item(i)
            pt(i) = New MPoint()
            pt(i).x = point.X
            pt(i).y = point.Y
        Next

        Return CalcLenght(pt, nPtCount)
    End Function

    Public Function GetPolygonLength(ByVal poly As MapObjects2.Polygon) As Double
        Dim pt As MPoint()
        Dim nPtCount As Integer
        Dim pts As MapObjects2.Points

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

        If nPtCount < 2 Then
            Return 0.0
        End If

        ReDim pt(nPtCount)
        Dim i As Integer
        For i = 0 To nPtCount - 1
            Dim point As MapObjects2.Point = pts.Item(i)
            pt(i) = New MPoint()
            pt(i).x = point.X
            pt(i).y = point.Y
        Next

        pt(nPtCount) = New MPoint()
        pt(nPtCount).x = pt(0).x
        pt(nPtCount).y = pt(0).y

        Return CalcLenght(pt, nPtCount + 1)
    End Function

    Public Function GetPolygonArea(ByVal poly As MapObjects2.Polygon) As Double
        Dim pt As MPoint()
        Dim nPtCount As Integer
        Dim pts As MapObjects2.Points

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

        If nPtCount < 3 Then
            Return 0.0
        End If

        ReDim pt(nPtCount)
        Dim i As Integer
        For i = 0 To nPtCount - 1
            Dim point As MapObjects2.Point = pts.Item(i)
            pt(i) = New MPoint()
            pt(i).x = point.X
            pt(i).y = point.Y
        Next

        pt(nPtCount) = New MPoint()
        pt(nPtCount).x = pt(0).x
        pt(nPtCount).y = pt(0).y

        Return CalcArea(pt, nPtCount + 1)
    End Function

    Private Function CalcArea(ByVal pt As MPoint(), ByVal nSize As Integer) As Double
        Dim dArea 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)
            dArea += (x2 - x1) * (y1 + y2) / 2
        Next



        If dArea < 0 Then
            dArea = 0 - dArea
        End If
        Return dArea
    End Function
    '---------------------------------------------------------------------
    ' 从szTbleName表中查找包含szName指定的地名所在的数据表名
    Public Function GetTableName(ByVal szName As String, ByVal szTbleName As String) As String
        Dim szTableName As String = ""

        ' 首先构造连接字符串
        Dim strConnectionString As String = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + m_szDBName + ";Persist Security Info=False"
        Dim myConnection As New System.Data.OleDb.OleDbConnection(strConnectionString)
        myConnection.Open()
        Dim dataSet As New System.Data.DataSet("临时库")
        Dim myDataAdapter As System.Data.OleDb.OleDbDataAdapter

        Dim szSQL As String
        szSQL = "Select * From " + szTbleName + " Where 名称 ='" + szName + "'"
        myDataAdapter = New System.Data.OleDb.OleDbDataAdapter(szSQL, myConnection)
        myDataAdapter.Fill(dataSet, "地名索引")

        Dim indexTbl As System.Data.DataTable = dataSet.Tables("地名索引")
        Dim rowsType As System.Data.DataRow() = indexTbl.Select()

        If 0 = rowsType.Length Then
            Return szTableName
        End If

        szTableName = rowsType(0)("属性表名").ToString()
        Return szTableName
    End Function
    '---------------------------------------------------------------------
    ' 根据地名得到地名所在的图层名
    ' 参数： szName， 地名名称
    '        szTblName， 索引表名称
    ' 返回值：图层名称
    Public Function GetLayerName(ByVal szName As String, ByVal szTblName As String) As String
        Dim szTableName As String = ""

        Dim strConnectionString As String = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + m_szDBName + ";Persist Security Info=False"
        Dim myConnection As New System.Data.OleDb.OleDbConnection(strConnectionString)
        myConnection.Open()
        Dim dataSet As New System.Data.DataSet("临时库")
        Dim myDataAdapter As System.Data.OleDb.OleDbDataAdapter

        Dim szSQL As String
        szSQL = "Select * From " + szTblName + " Where 名称 ='" + szName + "'"

        myDataAdapter = New System.Data.OleDb.OleDbDataAdapter(szSQL, myConnection)
        myDataAdapter.Fill(dataSet, "地名索引")

        Dim indexTbl As System.Data.DataTable = dataSet.Tables("地名索引")

        Dim rowsType As System.Data.DataRow() = indexTbl.Select()

        If 0 = rowsType.Length Then
            Return ""
        End If

        szTableName = rowsType(0)("图层名").ToString()
        Return szTableName
    End Function
    '---------------------------------------------------------------------
    ' 根据距离进行查询
    Public Function SearchByDistance(ByVal dX As Double, ByVal dY As Double, ByVal dDistance As Double, ByVal listBox As System.Windows.Forms.ListBox) As Long
        Dim bClosest As Boolean = False

        If dDistance <= 0.0 Then
            bClosest = True
            dDistance = 1000000000
        End If

        listBox.DataSource = Nothing
        listBox.Items.Clear()

        Dim i As Integer
        For i = 0 To m_nLayerNum - 1
            If m_layerInfos(i).bSelected = True And m_layerInfos(i).layer.shapeType = MapObjects2.ShapeTypeConstants.moShapeTypePoint Then
                Dim rs As MapObjects2.Recordset = Nothing

                Dim szPlaceName As String = ""
                Dim dMinDist As Double = -1.0
                Dim dDist As Double = 0.0

                rs = m_layerInfos(i).layer.Records

                If Not rs Is Nothing Then
                    rs.MoveFirst()

continue:           While rs.EOF = False
                        Dim pts(1) As MPoint

                        Dim pt As MapObjects2.Point

                        pt = rs.Fields.Item("shape").Value

                        pts(0) = New MPoint()
                        pts(0).x = dX
                        pts(0).y = dY
                        pts(1) = New MPoint()
                        pts(1).x = pt.X
                        pts(1).y = pt.Y

                        dDist = CalcLenght(pts, 2)
                        If dDistance >= CalcLenght(pts, 2) Then
                            If bClosest Then
                                ' 查找最近
                                Dim szTemp As String = rs.Fields.Item("名称").Value.ToString()

                                If szTemp = "" Then
                                    GoTo continue
                                End If

                                If (dMinDist < 0 Or dMinDist > dDist) And m_szPlaceName = szTemp Then
                                    dMinDist = dDist
                                    szPlaceName = szTemp
                                End If
                            Else
                                listBox.Items.Add(rs.Fields.Item("名称").Value.ToString())
                            End If
                        End If

                        rs.MoveNext()
                    End While

                    If bClosest = True And szPlaceName <> "" And m_szPlaceName = szPlaceName Then
                        listBox.Items.Add(szPlaceName)
                    End If
                End If
            Else
                m_layerInfos(i).rsSel = Nothing
            End If
        Next i

        Return listBox.Items.Count
    End Function
    '---------------------------------------------------------------------
    ' 功能：得到公交线路上车站
    ' 参数：[in]object node 乘车路线结构
    '       [in]int nIndex 第几次换乘
    '       [out]Buses buses 车站数组
    '       [out]int nCount 车站数目
    ' 返回值：true 成功
    Public Function GetStation(ByVal node As Object, ByVal nIndex As Integer, ByVal buses As Buses, ByRef nCount As Integer) As Boolean
        Dim line As PathNode = node

        Dim nOrder1, nOrder2 As Integer
        nOrder1 = GetStationOrder(line.szRoutineName(nIndex), line.szFromStationName(nIndex))
        nOrder2 = GetStationOrder(line.szRoutineName(nIndex), line.szToStationName(nIndex))

        If nOrder1 < 0 Or nOrder2 < 0 Then
            Return False
        End If

        Dim strConnectionString As String
        strConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" _
                              + m_szDBName + ";Persist Security Info=False"
        Dim myConnection As New System.Data.OleDb.OleDbConnection(strConnectionString)
        myConnection.Open()
        Dim dataSet As New System.Data.DataSet("临时库")
        Dim myDataAdapter As System.Data.OleDb.OleDbDataAdapter

        Dim szSQL As String
        szSQL = "Select * From 公交车站路线 " + " Where 线路名 ='" + _
                line.szRoutineName(nIndex) + "' And 顺序 Between " + _
                nOrder1.ToString() + " And " + nOrder2.ToString()

        myDataAdapter = New System.Data.OleDb.OleDbDataAdapter(szSQL, myConnection)
        myDataAdapter.Fill(dataSet, "索引")

        Dim indexTbl As System.Data.DataTable = dataSet.Tables("索引")

        Dim rowsType As System.Data.DataRow() = indexTbl.Select()

        If 0 = rowsType.Length Then
            Return False
        End If

        Dim myRow As System.Data.DataRow
        For Each myRow In rowsType
            buses.pts(nCount) = New MPoint()

            Dim szStation As String = ""
            szStation = myRow("站名").ToString()

            If Not GetStationPt(szStation, buses.pts(nCount)) Then
                buses.pts(nCount).x = -1
                buses.pts(nCount).y = -1
	        End If
            nCount = nCount + 1
        Next

        Return True
    End Function
    '---------------------------------------------------------------------
    ' 功能：得到公交线路上车站
    ' 参数：[in]string szLineName 公交线路名
    '       [out]Buses buses 车站数组
    '       [out]int nCount 车站数目
    ' 返回值：true 成功
    '---------------------------------------------------------------------
    Public Function GetStation(ByVal szLineName As String, ByVal buses As Buses, ByRef nCount As Integer) As Boolean
        Dim strConnectionString As String
        strConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + _
                              m_szDBName + ";Persist Security Info=False"
        Dim myConnection As New System.Data.OleDb.OleDbConnection(strConnectionString)
        myConnection.Open()
        Dim dataSet As New System.Data.DataSet("临时库")
        Dim myDataAdapter As System.Data.OleDb.OleDbDataAdapter

        Dim szSQL As String
        szSQL = "Select * From 公交车站路线 " + " Where 线路名 ='" + szLineName + "'"
        myDataAdapter = New System.Data.OleDb.OleDbDataAdapter(szSQL, myConnection)
        myDataAdapter.Fill(dataSet, "索引")
        Dim indexTbl As System.Data.DataTable = dataSet.Tables("索引")

        Dim rowsType As System.Data.DataRow() = indexTbl.Select()
        If 0 = rowsType.Length Then
            Return False
        End If

        Dim myRow As System.Data.DataRow
        For Each myRow In rowsType
            buses.pts(nCount) = New MPoint()