⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 maptip.vb

📁 地理信息系统二次开发实例教程VB.NET及源代码
💻 VB
字号:
Public Class MapTip
    Private m_x As Double  ' 当前位置的x坐标
    Private m_y As Double  ' 当前位置的y坐标
    Private m_lastX As Double  ' 当计时开始时鼠标位置的x坐标
    Private m_lastY As Double  ' 当计时开始时鼠标位置的y坐标

    Private m_map As AxMapObjects2.AxMap = Nothing
    Private m_timer As System.Windows.Forms.Timer = Nothing
    Private m_picture As System.Windows.Forms.PictureBox = Nothing
    Private m_lable As System.Windows.Forms.Label = Nothing
    Private m_env As CEnvironment = Nothing
    Private m_szField As String = ""
    '---------------------------------------------------------------------
    Public Sub New(ByVal frm As MainForm)
        m_map = frm.Map
        m_timer = frm._timer
        m_picture = frm._picToolTip
        m_lable = frm._lblToolTip
        m_szField = "名称"
        m_env = frm._environment
        m_picture.Visible = False
        m_picture.BackColor = System.Drawing.Color.FromArgb(255, 255, 192)

        m_lable.AutoSize = True
        m_lable.BackColor = m_picture.BackColor
        m_lable.Visible = False
    End Sub
    '---------------------------------------------------------------------
    Public Sub MouseMove(ByVal X As Double, ByVal Y As Double)
        m_x = X
        m_y = Y

        If m_timer.Interval = 1 Then
            m_lastX = X
            m_lastY = Y
            m_timer.Interval = 100
        Else
            m_picture.Visible = False
            m_lable.Visible = False
        End If
    End Sub
    '---------------------------------------------------------------------
    Private Sub ShowTipText(ByVal text As String) ' 显示地物的名称
        ' 设置标签控件的显示内容与位置
        m_lable.Text = text
        m_lable.Left = m_map.Left + m_x + 20
        m_lable.Top = m_map.Top + m_y + 11

        ' 设置Picture控件的位置
        m_picture.Left = m_map.Left + m_x + 10
        m_picture.Top = m_map.Top + m_y + 10
        m_picture.Width = m_lable.Width + 20
        m_picture.Visible = True
        m_lable.Visible = True
    End Sub
    '---------------------------------------------------------------------
    Private Function InMap(ByVal x As Double, ByVal y As Double) As Boolean ' 判断某点是否在地图窗口中
        If x > m_map.Right Or x < m_map.Left Then
            Return False
        End If

        If y > m_map.Top Or y < m_map.Bottom Then
            Return False
        End If

        Return True
    End Function
    '---------------------------------------------------------------------
    Public Sub Timer()
        If m_x = m_lastX And m_y = m_lastY Then
            m_timer.Interval = 1

            Dim recs As MapObjects2.Recordset
            recs = DoSearch()
            If recs Is Nothing Or recs.EOF Or InMap(m_x, m_y) Then
                m_picture.Visible = False
                m_lable.Visible = False
            Else
                Dim szText As String = recs.Fields.Item(m_szField).Value.ToString()
                If szText <> "" Then
                    ShowTipText(recs.Fields.Item(m_szField).Value.ToString())
                End If
            End If
        Else
            m_lastX = m_x
            m_lastY = m_y
        End If
    End Sub
    '---------------------------------------------------------------------
    Private Function DoSearch() As MapObjects2.Recordset ' 执行查询
        Dim pt As MapObjects2.Point = Nothing
        Dim rst As MapObjects2.Recordset = Nothing

        pt = m_map.ToMapPoint(m_x, m_y)
        Dim dScale As Double = m_env.CalcScale(m_map)
        dScale = dScale / 10000
        dScale = dScale / 5000

        Dim i As Integer
        For i = m_env.m_nLayerNum - 1 To 0 Step -1
            If m_env.m_layerInfos(i).layer.Visible And m_env.m_layerInfos(i).bCanSelected _
                  And m_env.m_layerInfos(i).layer.shapeType = MapObjects2.ShapeTypeConstants.moShapeTypePoint Then
                rst = m_env.m_layerInfos(i).layer.SearchByDistance(pt, dScale, "")
            End If

            If Not rst Is Nothing Then
                rst.MoveFirst()
                If Not rst.EOF Then
                    Return rst
                End If
            End If
        Next

        For i = 0 To m_env.m_nLayerNum - 1
            If m_env.m_layerInfos(i).bVisible And m_env.m_layerInfos(i).bCanSelected And _
               m_env.m_layerInfos(i).layer.shapeType = MapObjects2.ShapeTypeConstants.moShapeTypeLine Then
                rst = m_env.m_layerInfos(i).layer.SearchByDistance(pt, dScale, "")
            End If

            If Not rst Is Nothing Then
                rst.MoveFirst()
                If Not rst.EOF Then
                    Return rst
                End If
            End If
        Next

        For i = 0 To m_env.m_nLayerNum - 1
            If m_env.m_layerInfos(i).bVisible And m_env.m_layerInfos(i).bCanSelected And _
               m_env.m_layerInfos(i).layer.shapeType = MapObjects2.ShapeTypeConstants.moShapeTypePolygon Then
                rst = m_env.m_layerInfos(i).layer.SearchByDistance(pt, dScale, "")
            End If

            If Not rst Is Nothing Then
                rst.MoveFirst()
                If Not rst.EOF Then
                    Return rst
                End If
            End If
        Next

        Return rst
    End Function
    '---------------------------------------------------------------------

End Class

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -