gis
gis
管理员
管理员
  • 注册日期2003-07-16
  • 发帖数15951
  • QQ
  • 铜币25345枚
  • 威望15368点
  • 贡献值0点
  • 银元0个
  • GIS帝国居民
  • 帝国沙发管家
  • GIS帝国明星
  • GIS帝国铁杆
阅读:1637回复:0

用vb写dll或用vba时,要素闪烁的代码[转帖]

楼主#
更多 发布于:2003-10-13 11:27
一个api函数写的方法,间隔0.1秒闪烁一次,共闪烁三次。这个时间间隔和闪烁次数,大家可以任意定。

Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Public Sub FlashFeature(pFeature As IFeature, pMxDoc As IMxDocument)
  pMxDoc.ActiveView.ScreenDisplay.StartDrawing 0, esriNoScreenCache
  
  Select Case pFeature.Shape.GeometryType
    Case esriGeometryPolyline
      FlashLine pMxDoc.ActiveView.ScreenDisplay, pFeature.Shape
    Case esriGeometryPolygon
      FlashPolygon pMxDoc.ActiveView.ScreenDisplay, pFeature.Shape
    Case esriGeometryPoint
      FlashPoint pMxDoc.ActiveView.ScreenDisplay, pFeature.Shape
  End Select
  
  pMxDoc.ActiveView.ScreenDisplay.FinishDrawing
End Sub

Private 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 100
  pDisplay.DrawPolyline pGeometry
  Sleep 100
  pDisplay.DrawPolyline pGeometry
  Sleep 100
  pDisplay.DrawPolyline pGeometry
  
  Set pLineSymbol = Nothing
  Set pSymbol = Nothing
  Set pRGBColor = Nothing
End Sub

Private Sub FlashPolygon(pDisplay As IScreenDisplay, pGeometry As IGeometry)
  Dim pFillSymbol As ISimpleFillSymbol
  Dim pSymbol As ISymbol
  Dim pRGBColor As IRgbColor
  
  Set pFillSymbol = New SimpleFillSymbol
  pFillSymbol.Outline = Nothing
  
  Set pRGBColor = New RgbColor
  pRGBColor.Green = 128
  
  Set pSymbol = pFillSymbol
  pSymbol.ROP2 = esriROPNotXOrPen
  
  pDisplay.SetSymbol pFillSymbol
  pDisplay.DrawPolygon pGeometry
  Sleep 100
  pDisplay.DrawPolygon pGeometry
  Sleep 100
  pDisplay.DrawPolygon pGeometry
  Sleep 100
  pDisplay.DrawPolygon pGeometry
  
  Set pFillSymbol = Nothing
  Set pSymbol = Nothing
  Set pRGBColor = Nothing
End Sub

Private Sub FlashPoint(pDisplay As IScreenDisplay, pGeometry As IGeometry)
  Dim pMarkerSymbol As ISimpleMarkerSymbol
  Dim pSymbol As ISymbol
  Dim pRGBColor As IRgbColor
  
  Set pMarkerSymbol = New SimpleMarkerSymbol
  pMarkerSymbol.Style = esriSMSCircle
  
  Set pRGBColor = New RgbColor
  pRGBColor.Green = 128
  
  Set pSymbol = pMarkerSymbol
  pSymbol.ROP2 = esriROPNotXOrPen
  
  pDisplay.SetSymbol pMarkerSymbol
  pDisplay.DrawPoint pGeometry
  Sleep 100
  pDisplay.DrawPoint pGeometry
  Sleep 100
  pDisplay.DrawPoint pGeometry
  Sleep 100
  pDisplay.DrawPoint pGeometry
    
  Set pMarkerSymbol = Nothing
  Set pSymbol = Nothing
  Set pRGBColor = Nothing
End Sub

FlashFeature主函数,调用下面三个方法,可以自己用循环定义闪烁次数。
喜欢0 评分0
GIS麦田守望者,期待与您交流。
游客

返回顶部