当鼠标移动到图元上方时,标注改变样式(变色,加下划线等),移开后还原。通过vb+mapx基本实现这个效果,但由于mapx在label进行变化时的刷新很明显,达不到希望的效果。把代码留下。

Private Sub Map1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)

    'StatusBar1.Panels(1).Text = X & "," & Y

 

    Dim Lon As Double

    Dim lat As Double

    Dim fs As Features

    Dim pnt As New Point

    Dim lb As MapXLib.Label  '±ê×¢¶ÔÏó

    Map1.ConvertCoord x, y, Lon, lat, miScreenToMap

    pnt.Set Lon, lat

    Set fs = Map1.Layers(PLayer).SearchAtPoint(pnt)

    If fs.Count > 0 Then     '¶¨Î»¶ÔÏó

      If Not curftr Is Nothing Then If curftr = fs.Item(1) Then Exit Sub  '·ÀÖ¹Öظ´ÉèÖÃ

      Set lb = GetLabel(fs.Item(1).FeatureKey, Map1.Layers(PLayer).Labels)

      If Not lb Is Nothing Then             'Ϊ±ê×¢¼ÓÏ»®ÏßЧ¹û

        lb.Style.TextFont.Underline = True

        Set curftr = fs.Item(1)

        'fs.Item(1).Update

      End If

      Map1.MousePointer = miCustomCursor    'Êó±êÑùʽ

    Else

      If Not curftr Is Nothing Then  '»¹Ô­Ï»®Ïß״̬

        Set lb = GetLabel(curftr.FeatureKey, Map1.Layers(PLayer).Labels)

        lb.Style.TextFont.Underline = False

        'curftr.Update

        Set curftr = Nothing

        Frame1.Visible = False   'Òþ²Øµ¯³ö²Ëµ¥

      End If

      Map1.MousePointer = miArrowCursor

    End If

End Sub