Vb+Engine的简单画线程序

<P><IMG src="http://www.gisempire.com/bbs/Skins/Default/emot/em07.gif"> </P>
<P>VB+ENGINE的画线程序，缺少像素化，所以在加载的图层上会有问题，在空白的图上完全没有问题，像素化本人正在做……</P>
<P>由于考虑到mousemove的时候那条线其实是虚幻的，所以用mapcon.flashshape来做，可能会存在一定的问题，不过根据本人使用情况，还算满意。</P>
<P>该程序的优点是摆脱了trackline的起始点指定，而由使用者根据捕捉到的点来设定，多了一些方便，这个是简单的程序，代码也比较少，就大家看看而已</P>
<P>Dim pPrePoint As IPoint<BR>Dim pNextPoint As IPoint</P>
<P><BR>Dim pClickPoint As IPoint<BR>Dim pMovePoint As IPoint</P>
<P>Dim pTempPolyline As IPolyline '鼠标移动临时画线<BR>Dim pFinishPolyline As IPolyline '鼠标点击后画下的线</P>
<P>Dim pGeometryOld As IGeometry<BR>Dim pGeometryNew As IGeometry</P>
<P><BR>Dim ClickFlag As Boolean<BR>Dim SnapPointFlag As Boolean</P>
<P>Dim pTempCol As IPointCollection '只存2个点的collection<BR>Dim pFinishCol As IPointCollection '存所有点的collection</P>
<P><BR>Dim pSymbol As IMarkerLineSymbol</P>

<P>Private Sub Form_Load() '初始化变量<BR>    Set pActiveView = MapCon.ActiveView<BR>    Set pTempPolyline = New Polyline<BR>    Set pFinishPolyline = New Polyline<BR>    Set pTempCol = pTempPolyline<BR>    Set pFinishCol = pFinishPolyline<BR>        <BR>    ClickFlag = False<BR>    SnapPointFlag = False<BR>End Sub</P>
<P><BR>Private Sub MapCon_OnMouseDown(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long, ByVal mapX As Double, ByVal mapY As Double)<BR>If button = 1 Then<BR>    If pFinishCol.PointCount = 0 Then<BR>        If SnapPointFlag = False Then<BR>            Set pClickPoint = MapCon.ToMapPoint(x, y)<BR>            Set pPrePoint = pClickPoint<BR>            pFinishCol.AddPoint pPrePoint '加到完成点集中<BR>            pTempCol.AddPoint pPrePoint '加到临时点集中<BR>            ClickFlag = False<BR>        Else<BR>            <BR>        End If<BR>    Else<BR>        '加入捕捉<BR>        If SnapPointFlag = False Then<BR>            pTempCol.RemovePoints 0, 1<BR>            Set pClickPoint = MapCon.ToMapPoint(x, y)<BR>            Set pPrePoint = pClickPoint<BR>            pFinishCol.AddPoint pPrePoint<BR>            MapCon.DrawShape pFinishPolyline, pSymbol<BR>            pTempCol.AddPoint pPrePoint<BR>        Else<BR>            <BR>        End If<BR>    End If<BR>ElseIf button = 2 Then<BR>    MapCon.DrawShape pFinishPolyline<BR>    Do While pTempCol.PointCount <> 0<BR>        pTempCol.RemovePoints 0, 1<BR>    Loop<BR>    Do While pFinishCol.PointCount <> 0<BR>        pFinishCol.RemovePoints 0, 1<BR>    Loop<BR>    <BR>End If<BR>End Sub</P>
<P>Private Sub MapCon_OnMouseMove(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long, ByVal mapX As Double, ByVal mapY As Double)<BR>Set pMovePoint = New Point<BR>pMovePoint.x = mapX<BR>pMovePoint.y = mapY<BR>If pTempCol.PointCount = 0 Then<BR>    Exit Sub<BR>Else<BR>    Set pNextPoint = pMovePoint<BR>    If ClickFlag = False Then '如果前面的mousedown是第一次点击<BR>        pTempCol.AddPoint pNextPoint<BR>        MapCon.FlashShape pTempPolyline, 3, 3<BR>        pTempCol.RemovePoints 1, 1<BR>    End If<BR>End If</P>
<P>End Sub</P><img src="images/post/smile/dvbbs/em07.gif" /><img src="images/post/smile/dvbbs/em07.gif" /><img src="images/post/smile/dvbbs/em07.gif" />

学习一下。。。。。。。。。。。

像素化也没有问题了，经过调试，ok了，上面的程序不变，但是在清空点集的时候需要注意，必须要等创建完feature再清空，否则就不显示了：）

<img src="images/post/smile/dvbbs/em01.gif" /><img src="images/post/smile/dvbbs/em02.gif" />