Le portail francophone de la géomatique

Private Sub ListBox1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

  Dim pMxDoc As IMxDocument
  Dim pPoint As IPoint
  Dim pFeature As IFeature
    
  Set pMxDoc = ThisDocument
  Set pPoint =pMxDoc.ActiveView.ScreenDisplay.DisplayTransformation.ToMapPoint(X, Y)
    
  If (pFeature Is Nothing) Then Exit Sub
    
  ' now we must highlight the selected feature by flashing its geometry
  FlashFeature pFeature, pMxDoc
  
  Exit Sub
end sub

Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
 
Public Sub FlashFeature(pGeom As IGeometry, pMxDoc As IMxDocument)
  
  ' Start Drawing on screen
  pMxDoc.ActiveView.ScreenDisplay.StartDrawing 0, esriNoScreenCache
  
  ' Switch functions based on Geomtry type
  Select Case pGeom.GeometryType
    Case esriGeometryPolyline
      FlashLine pMxDoc.ActiveView.ScreenDisplay, pGeom
    Case esriGeometryPolygon
      FlashPolygon pMxDoc.ActiveView.ScreenDisplay, pGeom
    Case esriGeometryPoint
      FlashPoint pMxDoc.ActiveView.ScreenDisplay, pGeom
  End Select
  
  ' Finish drawing on screen
  pMxDoc.ActiveView.ScreenDisplay.FinishDrawing
End Sub
 
 
Public Sub FlashLine(pDisplay As IScreenDisplay, pGeometry As IGeometry)
  Dim pLineSymbol As ISimpleLineSymbol
  Dim pSymbol As ISymbol
  Dim pRgbColor As IRgbColor
  
  Set pLineSymbol = New SimpleLineSymbol
  pLineSymbol.Width = 4
  
  Set pRgbColor = New RgbColor
  pRgbColor.Green = 128
  
  Set pSymbol = pLineSymbol
  pSymbol.ROP2 = esriROPNotXOrPen
  
  pDisplay.SetSymbol pLineSymbol
  pDisplay.DrawPolyline pGeometry
  Sleep 300
  pDisplay.DrawPolyline pGeometry
End Sub