Objet evenements et tracé de lignes

Bonjour,

Je galère depuis quatre jours avec le même problème:

j'ai une classe générique fncoutil.
Une classe dérivée OutilLigne
qui sur premierclick enregistre X et Y de la souris
sur move trace en mode XOR la ligne premier point - point precedent
puis premier point - point actuel de la souris.
sur second click trace la ligne

Le problème est le suivant la ligne laisse des traces de manière
aléatoire. Ci dessous le code (beaucoup plus concis que le précédent
post), je joint également l'entête de form1 des fois que les propriétés
du pictureBox soient erronées ...

Il faut jute un copier coller dans deux modules pour constater le
problème, svp de l'aide !

christophe

'************* Classe générique FncOutil

Option Explicit

Public Sub RealiseClick(X As Single, Y As Single)
'click sur picturebox
End Sub

Public Sub RealiseMove(X As Single, Y As Single)
'mouse move sur picturebox
End Sub

Public Sub RealiseDblClick(X As Single, Y As Single)
'dblclick sur pictureBox
End Sub

Public Sub RealiseRightClick(X As Single, Y As Single)
'click droit
End Sub



' ************************outilligne
Option Explicit
Implements FncOutil
Private mX1 As Single
Private mY1 As Single
Private mX2 As Single
Private mY2 As Single
Private FirstClick As Boolean
Public mpicture1 As PictureBox

Private Sub Class_Initialize()
FirstClick = True
End Sub
Public Sub initdc(Picture1 As PictureBox)
Set mpicture1 = Picture1
End Sub

Private Sub Class_Terminate()
Set mpicture1 = Nothing
End Sub

Private Sub FncOutil_RealiseClick(X As Single, Y As Single)
'si premier click
If FirstClick = True Then

mX1 = X
mY1 = Y
mX2 = X
mY2 = Y

FirstClick = False

Else

mX2 = X
mY2 = Y

FirstClick = True

mpicture1.Line (mX1, mY1)-(mX2, mY2), RGB(255, 0, 0)

End If

End Sub

Private Sub FncOutil_RealiseDblClick(X As Single, Y As Single)

End Sub

Private Sub FncOutil_RealiseMove(X As Single, Y As Single)
'si pas click

If FirstClick = False Then
mpicture1.DrawMode = 7
mpicture1.Line (mX1, mY1)-(mX2, mY2), RGB(0, 255, 255)
mX2 = X
mY2 = Y
mpicture1.Line (mX1, mY1)-(mX2, mY2), RGB(0, 255, 255)
mpicture1.DrawMode = 13
Else
mX1 = 0
mY1 = 0
mX2 = 0
mY2 = 0
End If

End Sub


Private Sub FncOutil_RealiseRightClick(X As Single, Y As Single)
'si pas click
If FirstClick = False Then

End If

End Sub

VERSION 5.00
Begin VB.Form Ftest
Caption = "Form1"
ClientHeight = 6135
ClientLeft = 165
ClientTop = 450
ClientWidth = 9285
LinkTopic = "Form1"
ScaleHeight = 6135
ScaleWidth = 9285
StartUpPosition = 3 'Windows Default
Begin VB.PictureBox Picture1
BackColor = &H00FFFFFF&
CausesValidation= 0 'False
ClipControls = 0 'False
Height = 5895
Left = 120
ScaleHeight = 389
ScaleMode = 3 'Pixel
ScaleWidth = 597
TabIndex = 2
Top = 120
Width = 9015
End
Begin VB.CommandButton Command9
Caption = "Command9"
Height = 615
Left = 8640
TabIndex = 1
Top = 9000
Width = 615
End
Begin VB.CommandButton Command7
Caption = "Command7"
Height = 615
Left = 7800
TabIndex = 0
Top = 9000
Width = 615
End
End
Attribute VB_Name = "Ftest"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private outil As FncOutil

Private Sub Form_Load()
Dim Foutil As OutilLigne

Set outil = New FncOutil
Set Foutil = New OutilLigne

Foutil.initdc Picture1

Set outil = Foutil
Set Foutil = Nothing

End Sub

Private Sub Form_Unload(Cancel As Integer)
Set outil = Nothing
End Sub


Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As
Single, Y As Single)
If Button And vbLeftButton Then
outil.RealiseClick X, Y
End If

If Button And vbRightButton Then
outil.RealiseRightClick X, Y
End If

End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As
Single, Y As Single)
outil.RealiseMove X, Y
End Sub

Bonjour,

Je viens de tester ton code et cela marche trés bien chez moi.
Essaye de nous envoyer une capture d'écran et ton projet dans un autre
message.
Dominique.

"christophe-pasde<> @wanadoo.fr>" <"christophe-pasde<> a écrit dans le
message de news: ciep1l$pla$1@news-reader1.wanadoo.fr...

Bonjour,

Je galère depuis quatre jours avec le même problème:

j'ai une classe générique fncoutil.
Une classe dérivée OutilLigne
qui sur premierclick enregistre X et Y de la souris
sur move trace en mode XOR la ligne premier point - point precedent
puis premier point - point actuel de la souris.
sur second click trace la ligne

Le problème est le suivant la ligne laisse des traces de manière
aléatoire. Ci dessous le code (beaucoup plus concis que le précédent
post), je joint également l'entête de form1 des fois que les propriétés
du pictureBox soient erronées ...

Il faut jute un copier coller dans deux modules pour constater le
problème, svp de l'aide !

christophe

'************* Classe générique FncOutil

Option Explicit

Public Sub RealiseClick(X As Single, Y As Single)
'click sur picturebox
End Sub

Public Sub RealiseMove(X As Single, Y As Single)
'mouse move sur picturebox
End Sub

Public Sub RealiseDblClick(X As Single, Y As Single)
'dblclick sur pictureBox
End Sub

Public Sub RealiseRightClick(X As Single, Y As Single)
'click droit
End Sub



' ************************outilligne
Option Explicit
Implements FncOutil
Private mX1 As Single
Private mY1 As Single
Private mX2 As Single
Private mY2 As Single
Private FirstClick As Boolean
Public mpicture1 As PictureBox

Private Sub Class_Initialize()
FirstClick = True
End Sub
Public Sub initdc(Picture1 As PictureBox)
Set mpicture1 = Picture1
End Sub

Private Sub Class_Terminate()
Set mpicture1 = Nothing
End Sub

Private Sub FncOutil_RealiseClick(X As Single, Y As Single)
'si premier click
If FirstClick = True Then

mX1 = X
mY1 = Y
mX2 = X
mY2 = Y

FirstClick = False

Else

mX2 = X
mY2 = Y

FirstClick = True

mpicture1.Line (mX1, mY1)-(mX2, mY2), RGB(255, 0, 0)

End If

End Sub

Private Sub FncOutil_RealiseDblClick(X As Single, Y As Single)

End Sub

Private Sub FncOutil_RealiseMove(X As Single, Y As Single)
'si pas click

If FirstClick = False Then
mpicture1.DrawMode = 7
mpicture1.Line (mX1, mY1)-(mX2, mY2), RGB(0, 255, 255)
mX2 = X
mY2 = Y
mpicture1.Line (mX1, mY1)-(mX2, mY2), RGB(0, 255, 255)
mpicture1.DrawMode = 13
Else
mX1 = 0
mY1 = 0
mX2 = 0
mY2 = 0
End If

End Sub


Private Sub FncOutil_RealiseRightClick(X As Single, Y As Single)
'si pas click
If FirstClick = False Then

End If

End Sub

VERSION 5.00
Begin VB.Form Ftest
Caption = "Form1"
ClientHeight = 6135
ClientLeft = 165
ClientTop = 450
ClientWidth = 9285
LinkTopic = "Form1"
ScaleHeight = 6135
ScaleWidth = 9285
StartUpPosition = 3 'Windows Default
Begin VB.PictureBox Picture1
BackColor = &H00FFFFFF&
CausesValidation= 0 'False
ClipControls = 0 'False
Height = 5895
Left = 120
ScaleHeight = 389
ScaleMode = 3 'Pixel
ScaleWidth = 597
TabIndex = 2
Top = 120
Width = 9015
End
Begin VB.CommandButton Command9
Caption = "Command9"
Height = 615
Left = 8640
TabIndex = 1
Top = 9000
Width = 615
End
Begin VB.CommandButton Command7
Caption = "Command7"
Height = 615
Left = 7800
TabIndex = 0
Top = 9000
Width = 615
End
End
Attribute VB_Name = "Ftest"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private outil As FncOutil

Private Sub Form_Load()
Dim Foutil As OutilLigne

Set outil = New FncOutil
Set Foutil = New OutilLigne

Foutil.initdc Picture1

Set outil = Foutil
Set Foutil = Nothing

End Sub

Private Sub Form_Unload(Cancel As Integer)
Set outil = Nothing
End Sub


Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As
Single, Y As Single)
If Button And vbLeftButton Then
outil.RealiseClick X, Y
End If

If Button And vbRightButton Then
outil.RealiseRightClick X, Y
End If

End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As
Single, Y As Single)
outil.RealiseMove X, Y
End Sub