mapx实现热点效果

        当鼠标移动到图元上方时，标注改变样式（变色，加下划线等），移开后还原。通过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

转载于:https://www.cnblogs.com/jetz/archive/2008/05/13/1195963.html