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
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