cenvironment.vb

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

            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
    '---------------------------------------------------------------------
    ' 功能：得到给定的车站名在给定的公交线路上的车站顺序（如第2站）
    ' 参数：[in]string szLineName 公交线路名
    '		[in]string szStationName 公交车站名
    ' 返回值：> 0 车站顺序,否则失败
    Public Function GetStationOrder(ByVal szLineName As String, ByVal szStationName As String) As Integer
        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 + "' And 站名 ='" + szStationName + " '"
        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 -1
        End If

        Return rowsType(0)("顺序")
    End Function
    '---------------------------------------------------------------------
    ' 功能：得到给定的车站名的地理坐标
    ' 参数：[in]string szLineName 公交线路名
    '		  [out]MPoint pt 公交车的地理坐标
    ' 返回值：false 失败
    Public Function GetStationPt(ByVal szStationName As String, ByVal pt As MPoint) As Boolean
        Dim szName As String = szStationName
        Dim szLayer As String = GetLayerName(szName, "地名索引")
        Dim szTable As String = GetTableName(szName, "地名索引")
        Dim nIndex As Integer = GetLayerIndexByName(szTable)
        If nIndex < 0 Then
            Return False
        End If

        Dim rs As MapObjects2.Recordset
        rs = m_layerInfos(nIndex).layer.SearchExpression("名称 like '" + szName + "'")
        If Not rs Is Nothing Then
            rs.MoveFirst()
            If Not rs.EOF Then
                Dim pt1 As MapObjects2.Point
                pt1 = rs.Fields.Item("shape").Value
                pt.x = pt1.X
                pt.y = pt1.Y
                Return True
            End If
        End If

        Return False
    End Function
    '---------------------------------------------------------------------
    Public Function GetLine(ByVal szName As String) As MapObjects2.Line
        Dim line As MapObjects2.Line = Nothing
        Dim szLayer As String = GetLayerName(szName, "地名索引")
        Dim szTable As String = GetTableName(szName, "地名索引")

        If "" = szTable Then
            Return Nothing
        End If

        Dim nIndex As Integer = GetLayerIndexByName(szTable)
        If nIndex < 0 Then
            Return Nothing
        End If
        Dim rs As MapObjects2.Recordset
        rs = m_layerInfos(nIndex).layer.SearchExpression("名称 like '" + szName + "'")

        If Not rs Is Nothing Then
            rs.MoveFirst()
            If Not rs.EOF Then
                If m_layerInfos(nIndex).layer.shapeType = MapObjects2.ShapeTypeConstants.moShapeTypePoint Then
                    Return line
                ElseIf m_layerInfos(nIndex).layer.shapeType = MapObjects2.ShapeTypeConstants.moShapeTypeLine Then
                    line = rs.Fields.Item("shape").Value
                    Return line
                ElseIf m_layerInfos(nIndex).layer.shapeType = MapObjects2.ShapeTypeConstants.moShapeTypePolygon Then
                    Return line
                End If
            End If
        End If

        Return line
    End Function
    '---------------------------------------------------------------------
    Public Function GetPoint(ByVal szName As String) As MapObjects2.Point
        Dim pt As MapObjects2.Point = Nothing

        Dim szLayer As String = GetLayerName(szName, "地名索引")
        Dim szTable As String = GetTableName(szName, "地名索引")

        If "" = szTable Then
            Return Nothing
        End If

        Dim nIndex As Integer = GetLayerIndexByName(szTable)
        If nIndex < 0 Then
            Return Nothing
        End If

        Dim rs As MapObjects2.Recordset
        rs = m_layerInfos(nIndex).layer.SearchExpression("名称 like '" + szName + "'")

        If Not rs Is Nothing Then
            rs.MoveFirst()
            If Not rs.EOF Then
                If m_layerInfos(nIndex).layer.shapeType = MapObjects2.ShapeTypeConstants.moShapeTypePoint Then
                    pt = rs.Fields.Item("shape").Value
                    Return pt
                ElseIf m_layerInfos(nIndex).layer.shapeType = MapObjects2.ShapeTypeConstants.moShapeTypeLine Then
                    Dim line As MapObjects2.Line
                    line = rs.Fields.Item("shape").Value
                    pt = line.Extent.Center
                    Return pt
                ElseIf m_layerInfos(nIndex).layer.shapeType = MapObjects2.ShapeTypeConstants.moShapeTypePolygon Then
                    Dim poly As MapObjects2.Polygon
                    poly = rs.Fields.Item("shape").Value
                    pt = poly.Extent.Center
                    Return pt
                End If
            End If
        End If

        Return pt
    End Function
    '---------------------------------------------------------------------
    Public Function CreateLine(ByVal moline As MapObjects2.Line) As MLine
        Dim line As New MLine()
        Dim pts As MapObjects2.Points = moline.Parts.Item(0)

        line.nPointNumber = pts.Count
        ReDim line.pPoint(line.nPointNumber - 1)

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

        Return line
    End Function
    '---------------------------------------------------------------------
    Public Function FromMapPoint(ByVal map As AxMapObjects2.AxMap, ByVal x As Double, ByVal y As Double) As MPoint
        Dim pt As New MPoint()
        Dim dW As Double = System.Math.Abs(map.Extent.Right - map.Extent.Left)
        Dim dH As Double = System.Math.Abs(map.Extent.Top - map.Extent.Bottom)

        Dim dRatio As Double = 1.0
        Dim dOrgX As Double = 0
        Dim dOrgY As Double = 0

        If map.Width / dW > map.Height / dH Then ' 横向居中
            dRatio = map.Height / dH
            dOrgX = (map.Width - dW * dRatio) / 2
        ElseIf map.Width / dW < map.Height / dH Then ' 纵向居中
            dRatio = map.Width / dW
            dOrgY = (map.Height - dH * dRatio) / 2
        End If

        pt.x = (x - map.Extent.Left) * dRatio + dOrgX
        pt.y = map.Height - (y - map.Extent.Bottom) * dRatio + dOrgY
        Return pt
    End Function
    '---------------------------------------------------------------------

    '---------------------------------------------------------------------
    Public Function IsBusLine(ByVal map As AxMapObjects2.AxMap, ByVal szName As String) As Boolean
        Dim i As Integer
        For i = 0 To m_nLayerNum - 1
            If m_layerInfos(i).szName = CEnvironment.BUSLINE_LAYERNAME Then
                GoTo BreakI
            End If
        Next

BreakI: If i = m_nLayerNum Then
            Return False
        End If

        Dim ly As MapObjects2.MapLayer = m_layerInfos(i).layer
        Dim rs As MapObjects2.Recordset = ly.SearchExpression("名称 like '" + szName + "'")

        If rs Is Nothing Then
            Return False
        End If

        rs.MoveFirst()
        If rs.EOF Then
            Return False
        End If

        Return True
    End Function
    '---------------------------------------------------------------------
    Public Function GetLayerByName(ByVal szName As String) As MapObjects2.MapLayer
        Dim i As Integer
        For i = 0 To m_nLayerNum - 2
            If m_layerInfos(i).szName = szName Then
                GoTo BreakI
            End If
        Next

BreakI: If i = m_nLayerNum Then
            Return Nothing
        End If
        Return m_layerInfos(i).layer
    End Function
    '---------------------------------------------------------------------
    Public Function IsStation(ByVal map As AxMapObjects2.AxMap, ByVal szName As String) As Boolean
        Dim i As Integer
        For i = 0 To m_nLayerNum - 1
            If m_layerInfos(i).szName = CEnvironment.BUSSTATION_LAYERNAME Then
                GoTo BreakI
            End If
        Next

BreakI: If i = m_nLayerNum Then
            Return False
        End If

        Dim ly As MapObjects2.MapLayer = m_layerInfos(i).layer
        Dim rs As MapObjects2.Recordset = ly.SearchExpression("名称 like '" + szName + "'")

        If rs Is Nothing Then
            Return False
        End If

        rs.MoveFirst()
        If rs.EOF Then
            Return False
        End If

        Return True
    End Function
    '---------------------------------------------------------------------
    Public Function GetFieldName(ByVal szName As String) As String
        Dim szTable As String = GetTableName(szName, "地名索引")
        Dim szFieldName As String = "单位名称"

        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 " + m_mapInfos(m_nCurrMapIndex).szMetaTable + _
                " Where 属性表名 ='" + szTable + "'"

        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 szFieldName
        End If

        szFieldName = rowsType(0)("字段名").ToString()
        Return szFieldName
    End Function
    '---------------------------------------------------------------------
    Public Function IsImage(ByVal szName As String) 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 名称 ='" + 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 False
        End If

        Return True
    End Function
    '---------------------------------------------------------------------
End Class