Line et mode XOR

Bonjour,

J'ai un pictureBox sur une form.

Je possede une classe générique FncOutil, une classe dérivée OutilLigne
(cf code ci-dessous)

Sur l'evenement Mouse_down, Mouse_Move sont respectivement déclanché
RealiseClick et RéaliseMove de l'objet générique qui appel l'objet
spécifique Outilligne

Le Probleme est le suivant :

La ligne tracée en mode XOR sur le DC de picturebox laisse parfois une
trace quelques pixels de la ligne préc ou beaucoup plus ou pas de trace
... Bref qq chose d'irregulier
Comme si la ligne n'était pas retracée au même endroit.

J'ai vérifier les coordonnées pixels qui sont envoyées à la fonction
ligne elle ne varient pas , ça ne vient donc pas d'un pb d'arrondi.

Une autre piste est que le DC ne soit pas correctement rendu à VB, mais
je ne pense pas,
Cf code classe MDC

Voilà le code si certains ont une idée elle est la bien venue

Christophe


'classe FncOutil
Option Explicit


Public Sub RealiseClick(mdc As metricDC, x As Single, Y As Single)
'click sur picturebox
End Sub

Public Sub RealiseMove(mdc As metricDC, x As Single, Y As Single)
'mouse move sur picturebox
End Sub

Public Sub RealiseDblClick(mdc As metricDC, x As Single, Y As Single)
'dblclick sur pictureBox
End Sub

Public Sub RealiseRightClick(mdc As metricDC, x As Single, Y As Single)
'click droit
End Sub


'Classe OutilLigne

Option Explicit
Implements FncOutil
Private mFncOutil As FncOutil
Private mX1 As Single
Private mY1 As Single
Private mX2 As Single
Private mY2 As Single
Private FirstClick As Boolean




Private Sub Class_Initialize()
FirstClick = True
End Sub


Private Sub FncOutil_RealiseClick(mdc As metricDC, x As Single, Y As Single)
Dim x1 As Double
Dim x2 As Double
Dim y1 As Double
Dim y2 As Double

'si premier click
If FirstClick = True Then
mX1 = x
mY1 = Y
mX2 = x
mY2 = Y
FirstClick = False
Else
mX2 = x
mY2 = Y
FirstClick = True
mdc.PeriphReel mX1, mY1
x1 = mdc.Xencours
y1 = mdc.Yencours

mdc.PeriphReel mX2, mY2
x2 = mdc.Xencours
y2 = mdc.Yencours

mdc.linereal x1, y1, x2, y2, RGB(255, 0, 0)

End If
End Sub

Private Sub FncOutil_RealiseDblClick(mdc As metricDC, x As Single, Y As
Single)

End Sub

Private Sub FncOutil_RealiseMove(mdc As metricDC, x As Single, Y As Single)
'si pas click
Dim x1 As Double
Dim y1 As Double
Dim x2 As Double
Dim y2 As Double

If FirstClick = False Then

mdc.PeriphReel mX1, mY1
x1 = mdc.Xencours
y1 = mdc.Yencours

mdc.PeriphReel mX2, mY2
x2 = mdc.Xencours
y2 = mdc.Yencours


Debug.Print "ancienne ligne"
mdc.LinePeriph mX1, mY1, mX2, mY2, RGB(255, 0, 255), 7


mdc.PeriphReel x, Y
x2 = mdc.Xencours
y2 = mdc.Yencours
mX2 = x
mY2 = Y
Debug.Print "nouvelle ligne"
mdc.LinePeriph mX1, mY1, mX2, mY2, RGB(255, 0, 255), 7

Else
mX1 = 0
mY1 = 0
mX2 = 0
mY2 = 0
End If

End Sub


Private Sub FncOutil_RealiseRightClick(mdc As metricDC, x As Single, Y
As Single)
'si pas click
Dim x1 As Double
Dim y1 As Double
Dim x2 As Double
Dim y2 As Double

If FirstClick = False Then

mdc.PeriphReel mX1, mY1
x1 = mdc.Xencours
y1 = mdc.Yencours

mdc.PeriphReel mX2, mY2
x2 = mdc.Xencours
y2 = mdc.Yencours

mdc.linereal x1, y1, x2, y2, RGB(0, 255, 255), 7

End If
End Sub



'Classe MetricDC

Public Sub setmetrique()


m_savedDC& = SaveDC&(mPicture.hdc)

dummy& = SetMapMode&(mPicture.hdc, MM_HIMETRIC)
dummy& = SetViewportOrgEx&(mPicture.hdc, mViewOrgX, mviewOrgY,
mypoint)
dummy& = SetWindowOrgEx&(mPicture.hdc, mWinOrgX, mWinOrgY, mypoint)
End Sub

Public Sub exitmetrique()
m_savedDC& = RestoreDC(mPicture.hdc, m_savedDC&)
End Sub


Public Sub linereal(x1 As Double, y1 As Double, x2 As Double, y2 As
Double, couleur As Long, Optional mode As Long = 13)
Dim p1 As POINTGEO 'structure point avec X et Y as double
Dim p2 As POINTGEO
Dim ap1 As POINTAPI
Dim ap2 As POINTAPI
Dim OldPen&
Dim UsePen&
Dim dummy&
Dim oldmode&

p1.x = x1
p1.Y = y1
p2.x = x2
p2.Y = y2
setmetrique

oldmode = SetROP2(mPicture.hdc, mode)

UsePen& = CreatePen(PS_SOLID, 1, couleur)
OldPen& = SelectObject(mPicture.hdc&, UsePen&)

ap1 = RtoL(p1) 'convertit les coordonnées réelles en logique
ap2 = RtoL(p2)

dummy& = MoveToEx&(mPicture.hdc&, ap1.x, ap1.Y, ap1)
dummy& = LineTo(mPicture.hdc&, ap2.x, ap2.Y)

Debug.Print "Xf " & Str(ap2.x) & " Yf " & Str(ap2.Y)

dummy& = SelectObject(mPicture.hdc&, OldPen&)
dummy& = DeleteObject(UsePen&)
dummy& = SetROP2(mPicture.hdc, oldmode)
exitmetrique

End Sub