阅读:2397回复:3
创建arrowsymbol后,为什么屏幕刷新重叠?大奇迹,有源代码,大家快看!
<P>当我用arrowsymbol标志管线的水流向时,没有问题,但标志出后,我拖动屏幕,则出现重叠显现,原有的还在,新的继续叠加,即重影现象,请问哪位高手可以解决?</P>
<P>谢谢!</P> [此贴子已经被作者于2004-8-12 13:40:59编辑过]
|
|
1楼#
发布于:2004-08-11 15:10
<P>不会是显卡的问题吧,呵呵</P>
|
|
|
2楼#
发布于:2004-08-12 10:38
<P>Public Sub m_pActiveViewEvents_OnAfterDrawAll(ByVal display As esriCore.IScreenDisplay, ByVal phase As esriCore.esriViewDrawPhase)
On Error GoTo ErrorHandler Dim pEnumFeat As IEnumFeature Dim pFeature As IFeature Dim pEnvelope As IEnvelope Dim pCancel As ITrackCancel Dim lLoop As Long Dim pDT As IDisplayTransformation Dim pScreenDisplay As IScreenDisplay Dim realWorldDisplayExtent As Double Dim pixelExtent As Long Dim sizeOfOnePixel As Double Dim deviceRECT As tagRECT Dim pEnv As IEnvelope Dim pAMSymbol As IArrowMarkerSymbol Dim pRGBColor As IRgbColor Dim pSymbol As IMarkerSymbol</P><P> Dim pEnumLayer As IEnumLayer Dim pLayer As IFeatureLayer Dim pID As New UID Dim bVisible As Boolean Dim aryLayers() As String Dim iLayers As Integer Dim iCount As Integer Dim pGeoColl As IGeometryCollection Dim pSegColl As ISegmentCollection Dim pSegment As ISegment Dim lSegment As Long Dim lGeometry As Long Dim pline As ILine Dim dAngle As Double Dim dLength As Double Dim pfeatclass As IFeatureClass Dim pFeatures As IFeatureCursor Dim l11ActiveCache As Long Dim pGraphicsContainer As IGraphicsContainer Dim pTextElement As ISimpleLineDecorationElement Dim pElement As IElement '试验Element Set pGraphicsContainer = m_Map Set pTextElement = New SimpleLineDecorationElement pTextElement.MarkerSymbol.color.RGB = 8612054 If phase = esriViewGeoSelection Then 'And pWorkEdit.IsBeingEdited = True l11ActiveCache = display.ActiveCache Set pDT = display.DisplayTransformation If TypeOf display Is IScreenDisplay Then Set pScreenDisplay = display Set pCancel = m_View.ScreenDisplay.CancelTracker End If Set pRGBColor = New RgbColor pRGBColor.red = 255 pRGBColor.blue = 0 pRGBColor.green = 0</P><P> Set pAMSymbol = New ArrowMarkerSymbol pAMSymbol.Style = esriAMSPlain Dim dArrowSize As Double dArrowSize = 10 If m_Map.ReferenceScale > 0 Then deviceRECT = pDT.DeviceFrame pixelExtent = deviceRECT.right - deviceRECT.left Set pEnv = pDT.VisibleBounds realWorldDisplayExtent = pEnv.Width sizeOfOnePixel = realWorldDisplayExtent / pixelExtent If dArrowSize < (sizeOfOnePixel * 2) Then dArrowSize = sizeOfOnePixel * 2 End If End If pAMSymbol.Width = 10 pAMSymbol.Size = dArrowSize pAMSymbol.color = pRGBColor Set pSymbol = pAMSymbol</P><P> Set pline = New esriCore.Line Dim pTargetLayer As IFeatureLayer Set pTargetLayer = m_CurrentLayer Set pfeatclass = pTargetLayer.FeatureClass Dim pQueryFilter As IQueryFilter Set pQueryFilter = New QueryFilter pQueryFilter.whereClause = "" Set pFeatures = pfeatclass.Search(pQueryFilter, False) Set pFeature = pFeatures.NextFeature Do While Not pFeature Is Nothing If Not pFeature Is Nothing Then display.ActiveCache = esriNoScreenCache display.StartDrawing 0, esriNoScreenCache display.setsymbol pSymbol If pFeature.Shape.GeometryType = esriGeometryPolyline And pTargetLayer.FeatureClass.ShapeType = esriGeometryPolyline Then</P><P> Set pGeoColl = pFeature.Shape For lGeometry = 0 To pGeoColl.GeometryCount - 1 Set pSegColl = pGeoColl.Geometry(lGeometry) Set pSegment = pSegColl.Segment(pSegColl.SegmentCount - 1) dLength = pSegment.length - ConvertPixelsToRW(7) If dLength <= 0 Then dLength = pSegment.length End If If dLength > 0 Then pSegment.QueryTangent esriExtendTangentAtTo, dLength, False, 1, pline dAngle = AngleFromCoords(pline.FromPoint.X, pline.FromPoint.Y, _ pline.ToPoint.X, pline.ToPoint.Y) ' Draw the arrow</P><P> pAMSymbol.Angle = dAngle With display</P><P> .DrawPoint pline.FromPoint .ActiveCache = esriNoScreenCache End With End If Next lGeometry End If End If Set pFeature = pFeatures.NextFeature ' If Not pCancel Is Nothing Then ' If Not pCancel.Continue Then ' Set pFeature = Nothing ' End If ' End If Loop End If display.FinishDrawing display.ActiveCache = l11ActiveCache ' display.RemoveCache l11ActiveCache '' InvalidateRect; m_disp.hwnd, prect, 0 ' display.Invalidate m_View.Extent, False, 0 ' m_View.Draw display.hDC, Nothing ' m_View.PartialRefresh esriViewNone, Nothing, Nothing '' Finally:</P><P> Set pAMSymbol = Nothing Exit Sub ErrorHandler: Set pAMSymbol = Nothing MsgBox "Error " ; err.Number ; ": " ; err.Description ; vbNewLine _ ; "In " ; err.Source ; " at DrawSelectedArrows.m_pActiveViewEvents_AfterDraw" End Sub</P><P>请各位大虾帮我看看!</P> |
|
3楼#
发布于:2004-08-12 15:40
我想你应该在该事件内先把IGraphicsContainer内的东西清空并刷新一次 用该接口的<a href="mk:@MSITStore:C:\arcgis\arcexe83\ArcObjects%20Developer%20Kit\Help\esriCore.chm::/IGraphicsContainer_DeleteAllElements.htm" target="_blank" ><b>DeleteAllElements</b></A>方法
|
|
|