Sujet Précédent Sujet Suivant

Création de traint en dehors d'une picture box

Résolu
cs_dogi Messages postés 7 Date d'inscription mardi 27 septembre 2005 Statut Membre Dernière intervention 15 avril 2006 - 13 avril 2006 à 17:20
 Utilisateur anonyme - 15 avril 2006 à 20:08
Bonjour,
je voudrais savoir s'il est possible de créer des traits directement sur la form sans passer par une picturebox ?
Merci à vous.

12 réponses

Réponse 1 / 12
Utilisateur anonyme
13 avril 2006 à 17:29
Salut,

(En VB6 puisque non présiser)
Tu appelle les fonction de dessin mais cette fois a partir de ta form (ici me remplace ta form)
Me.Line (10, 10)-(50, 50) '(En scalemode = 3)

Kenji

<HR width="100%" SIZE=2>


Merci de cliquer sur "Réponse acceptée" si une réponse vous convient.
3
Réponse 2 / 12
Utilisateur anonyme
15 avril 2006 à 19:16
Re,

Méthode en plus élaboré mais qui ne corespond pas exactement à ce que tu veux faire.
On clique, on laissant le bouton enfoncé on déplace la souris et on relache pour valider

Option Explicit

Private Type TLine
StartX As Single
StartY As Single
EndX As Single
EndY As Single
End Type

Dim Trace As Boolean
Dim StartX As Single, StartY As Single
Dim EndX As Single, EndY As Single
Dim Lines() As TLine
Dim NbLine As Integer

Private Sub Form_Load()
NbLine = -1
Me.AutoRedraw = True

End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
StartX = X
StartY = Y
Trace = True
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Trace = True Then
Me.Line (StartX, StartY)-(EndX, EndY), Me.BackColor EndX X : EndY Y
Call ReDrawLines()
Me.Line (StartX, StartY)-(EndX, EndY)
End If
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Trace = True Then
NbLine = NbLine + 1
ReDim Preserve Lines(NbLine) As TLine
Lines(NbLine).StartX = StartX
Lines(NbLine).StartY = StartY
Lines(NbLine).EndX = EndX
Lines(NbLine).EndY = EndY
Trace = False
Call ReDrawLines()
End If
End Sub

Private Sub ReDrawLines()
Dim iLine As Integer
For iLine = 0 To NbLine
Me.Line (Lines(iLine).StartX, Lines(iLine).StartY)-(Lines(iLine).EndX, Lines(iLine).EndY), vbRed
Next iLine
End Sub

Kenji

<HR width="100%" SIZE=2>


Merci de cliquer sur "Réponse acceptée" si une réponse vous convient.
3
Réponse 3 / 12
cs_dogi Messages postés 7 Date d'inscription mardi 27 septembre 2005 Statut Membre Dernière intervention 15 avril 2006
14 avril 2006 à 11:38
Merci de ta réponse mais je me suis mal exprimé en fait,

En fait ce que je veux, c'est un bouton option qui permet de choisir un trait.

Et ensuite dans la form créer les traits à la souris en cliquant sur un premier endroit pour créer le début du trait et en en cliquant sur un autre endroit pour finir le trait.

Voici le code de mon groupe de boutons d'options :
Private Sub Option1_Click(Index As Integer)
If Index 0 Then outil "trait"

End Sub

Mais ensuite je ne sais pas comment faire pour gérer le trait sur la form

Faut-il faire un Form1_MouseMove ou un Form1_MouseUp ?
0
Réponse 4 / 12
cs_dogi Messages postés 7 Date d'inscription mardi 27 septembre 2005 Statut Membre Dernière intervention 15 avril 2006
14 avril 2006 à 12:05
J'ai réussi à faire un trait sur ma form mais quand je veux en faire un second le premier disparait.

Voici mon code :
-----------------------------------------------------------------------------------------------

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

If outil = "trait" Then
If nbclick = 1 Then
Form1.Cls
Form1.Line (x1, y1)-(X, Y), Picture2.BackColor
End If


End If



End Sub

--------------------------------------------------------------------------------------------


Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)


'Cette partie determine les points en X et Y


If outil = "trait" Then

If Button <> 0 Then

nbclick = nbclick + 1

If nbclick = 1 Then
Form1.Picture = Form1.Image
x1 = X
y1 = Y
End If

If nbclick = 2 Then
x2 = X
y2 = Y
Form1.Cls
Form1.Line (x1, y1)-(x2, y2), Picture2.BackColor
nbclick = 0
End If
End If
End If


End Sub
----------------------------------------------------------------------

Si quelqu'un pouvait m'éclairer ça serait sympa
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 12
Utilisateur anonyme
14 avril 2006 à 18:28
Salut,

Normal, tu fait un cls avant de tracer ton trait.
Retire tout simplement la ligne Form1.Cls

Kenji

<HR width="100%" SIZE=2>


Merci de cliquer sur "Réponse acceptée" si une réponse vous convient.
0
Réponse 6 / 12
cs_dogi Messages postés 7 Date d'inscription mardi 27 septembre 2005 Statut Membre Dernière intervention 15 avril 2006
15 avril 2006 à 18:22
Salut,

J'ai essayé d'enlever cette ligne mais que je l'enlève dans le form_MouseMove ou dans le form_MouseUp ou dans les deux le résultat est le même donc je ne vois vraiment pas comment faire..
0
Réponse 7 / 12
Utilisateur anonyme
15 avril 2006 à 18:56
Salut,

En faite, je vois pas pourquoi tu fais un cls et tu passe l'image vers la picture
Voilà un example qui fait ce que tu veut:

Dim NbClick As Integer
Dim StartX As Single, StartY As Single
Dim EndX As Single, EndY As Single

Private Sub Form_Load()
Me.AutoRedraw = True
End Sub

Private Sub Form_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
NbClick = NbClick + 1
Select Case NbClick
Case Is = 1
StartX = X
StartY = Y
Case Is = 2
EndX = X
EndY = Y
End Select
End Sub

Private Sub Form_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If NbClick >= 2 Then
Me.Line (StartX, StartY)-(EndX, EndY), vbRed
NbClick = 0
End If
End Sub

Kenji

<HR width="100%" SIZE=2>


Merci de cliquer sur "Réponse acceptée" si une réponse vous convient.
0
Réponse 8 / 12
cs_dogi Messages postés 7 Date d'inscription mardi 27 septembre 2005 Statut Membre Dernière intervention 15 avril 2006
15 avril 2006 à 19:19
Merci bien Kenji,
ton code marche bien mais on ne voit pas le trait en train de se tirer ce qui n'est pas très pratique.
0
Réponse 9 / 12
cs_dogi Messages postés 7 Date d'inscription mardi 27 septembre 2005 Statut Membre Dernière intervention 15 avril 2006
15 avril 2006 à 19:23
Merci Kenji, le dernier code marche nickel je te remercie pour le temps que tu 'mas consacré
0
Réponse 10 / 12
Utilisateur anonyme
15 avril 2006 à 19:24
De rien, je suis là pour ca.

Kenji
0
Réponse 11 / 12
cs_dogi Messages postés 7 Date d'inscription mardi 27 septembre 2005 Statut Membre Dernière intervention 15 avril 2006
15 avril 2006 à 19:29
Par contre, lorsque l'on clique une seule fois ca fait un trait un peu n'importe ou.
0
Réponse 12 / 12
Utilisateur anonyme
15 avril 2006 à 20:08
On rajoute une condition pour savoir si on bouger la soursi lors du tracer:

Option Explicit

Private Type TLine
StartX As Single
StartY As Single
EndX As Single
EndY As Single
End Type

Dim Trace As Boolean, IsTrace As Boolean
Dim StartX As Single, StartY As Single
Dim EndX As Single, EndY As Single
Dim Lines() As TLine
Dim NbLine As Integer

Private Sub Form_Load()
NbLine = -1
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
StartX = X
StartY = Y
Trace = True
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Trace = True Then
'Me.Circle (StartX, StartY), Sqr((StartX - EndX) ^ 2 + (StartY - EndY) ^ 2), Me.BackColor
Me.Line (StartX, StartY)-(EndX, EndY), Me.BackColor EndX X : EndY Y
Call ReDrawLines()
'Me.Circle (StartX, StartY), Sqr((StartX - EndX) ^ 2 + (StartY - EndY) ^ 2)
Me.Line (StartX, StartY)-(EndX, EndY)
IsTrace = True
End If
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Trace = True Then
If IsTrace = True Then
NbLine = NbLine + 1
ReDim Preserve Lines(NbLine) As TLine
Lines(NbLine).StartX = StartX
Lines(NbLine).StartY = StartY
Lines(NbLine).EndX = EndX
Lines(NbLine).EndY = EndY
End If
Trace = False
IsTrace = False
Call ReDrawLines()
End If
End Sub

Private Sub ReDrawLines()
Dim iLine As Integer
For iLine = 0 To NbLine
'Me.Circle (Lines(iLine).StartX, Lines(iLine).StartY), Sqr((Lines(iLine).StartX - Lines(iLine).EndX) ^ 2 + (Lines(iLine).StartY - Lines(iLine).EndY) ^ 2), vbRed
Me.Line (Lines(iLine).StartX, Lines(iLine).StartY)-(Lines(iLine).EndX, Lines(iLine).EndY), vbRed
Next iLine
End Sub

Kenji

<HR width="100%" SIZE=2>


Merci de cliquer sur "Réponse acceptée" si une réponse vous convient.
0
Rejoignez-nous