Déplacer une copie d'un PictureBox avec le curseur souris.

**excalybur** · 15/12/2015, 10h24

Bonjour à tous !

Nouveau sur la rubrique VisualBasic.Net je migre depuis la rubrique VB6 car j'ai pris la grande décision de convertir mon programme en VB2012 express.

Je considère humblement que je suis débutant vu les grandes différences qu'il y a entre les deux langages. Il faut bien un début à tous ! Mon parcours en basic a commencé en 1980 ... avec 640ko de mémoire ...

Mon projet :
Déplacer une copie d'un PictureBox avec le curseur souris. L'idée est de remplir un échiquier vide PictureBox1 avec des pièces d'échecs disponibles sur le form par glissé-déposé.

Trois photos valent mieux qu'un long discours. Avec le code ci-dessous j'obtiens ces photos des phases qui ne correspondent pas exactement à mes attentes (voir mon cahier des charges ci-dessous) :

Position Initial :
Nom : init.JPG
Affichages : 920
Taille : 18,9 Ko

Nom : init.JPG
Affichages : 920
Taille : 18,9 Ko

Mouvement en cours avec la souris (il manque le curseur de la souris sur la dame en mouvement non photographié par capture d'écran):
Nom : déplacement.jpg
Affichages : 1015
Taille : 16,2 Ko

Nom : déplacement.jpg
Affichages : 1015
Taille : 16,2 Ko

Position final :
Nom : final.JPG
Affichages : 905
Taille : 17,7 Ko

Pour cela j'ai Créé une form avec deux PictureBox en AutoSize. Attention le pictureBox1 de l'échiquier doit être créé en premier sinon les pièces glisseront derrière l'image de l'échiquier.

J'ai appliqué ce code qui ne me donne pas entière satisafction :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
 
Public Class Form1
    Private pointDown As Point
    Private isMouseDown As Boolean = False
    Private originalColor As Color
 
    Private Sub PictureBox4_MouseDown(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox4.MouseDown
 
        If e.Button = MouseButtons.Left Then
            'récupere position du click
            pointDown = e.Location
 
            'active  deplacement
            isMouseDown = True
        End If
 
    End Sub
 
    Private Sub PictureBox4_MouseMove(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox4.MouseMove
        If isMouseDown Then  'deplacement active oui?
            Dim pointMove As Point = e.Location
 
            'le déplacement relatif  
            Dim deltaPoint As Point = pointMove - pointDown
 
            'ajouter à Location actuelle du  PictureBox4
            PictureBox4.Location = Me.PictureBox4.Location + deltaPoint
 
        End If
    End Sub
 
    Private Sub PictureBox4_MouseUp(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox4.MouseUp
        If e.Button = MouseButtons.Left Then
            'desactive  deplacement
            isMouseDown = False
 
        End If
    End Sub
 
End Class

Le principe est bon mais ne respecte pas mon cahier des charges car il déplace les PictureBox des pièces :

1/ Les pièces sur le form doivent rester en place et visibles, seul une "image" de la pièce sélectionnée doit bouger avec le clickdown de la souris en mode drag jusqu'au moment du dépôt sur le PictureBox1.
2/ Au clickup l'image doit se positionner sur la case chevauchée avec précision (c'est un second problème que je doit pouvoir résoudre avec mon algorithme en Vb6 qui devrait fonctionner).

Donc en clair : comment créer une image 'flottante' de l'objet sélectionné par le curseur de la souris. Cette image accompagnera le mouvement de la souris jusqu'au clickup ou elle sera déposé.

Autre question : Je voulais essayer DragMoveProvider dont il est fait état dans les forums au DVP.NET, mais je ne trouve pas où le télécharger? Il . Est-il compatible en Vb2012 ?

Par avance merci pour vos idée.

**ACIVE_CS** · 17/12/2015, 00h44

Bonjour,
J'avais fait un petit "truc" dans ce genre il y a quelques temps, ça ressemble un peu à ça:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
 
Public Class Form1
    Dim IsResizing As Boolean = False
    Dim isDragging As Boolean = False
    Dim MoveImg As Boolean = False
    Dim CurrentX As Integer, CurrentY As Integer
 
    Private Sub PictureBox1_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseDown
        If e.Button = MouseButtons.Left Then
            isDragging = True
            CurrentX = e.X
            CurrentY = e.Y
            MoveImg = False
        ElseIf e.Button = MouseButtons.Right Then
            IsResizing = True
        End If
    End Sub
 
    Private Sub PictureBox1_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseMove
        If isDragging Then
            PictureBox1.Top += (e.Y - CurrentY)
            PictureBox1.Left += (e.X - CurrentX)
        ElseIf e.Button = MouseButtons.Right Then
            If IsResizing = True Then PictureBox1.Size = New Size(e.X, e.Y)
        End If
    End Sub
 
    Private Sub PictureBox1_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseUp
        IsResizing = False
        isDragging = False
    End Sub
End Class

A propos,
Mon parcours en basic a commencé en 1980 ... avec 640ko de mémoire ...
Je ne pense pas qu'en 1980 t'aurais eu 640 Ko de mémoire... (plutôt 64)
J'imagine que ça resssemblait à un synclair zx80 (qui est sorti en 1982, donc pas en 80) moi j'ai commencé en 1986 avec la meme chose
Bref, ça nous rajouni pas du tout mais on a appris "dans le dur"...

**excalybur** · 20/12/2015, 22h23

Bonsoir,

Excuse-moi pour ce retard à répondre. Ton code correspond au mien et déplace la picturebox1. Or je veux laisser la picturebox1 à l'emplacement initial et la souris déplace une image 'volante' de picturebox 1 pour la déposer sur la picturebox 2

Apparemment pas simple et pourtant quelqu'un l'a forcément écrit quelque part on le voit dans de nombreuse applications.

Je continu la ré-écriture de mon programme et j'aurais surement d'autres questions.

A vous lire

bonne soirée.

**chrismonoye** · 21/12/2015, 11h09

Bonjour,
voir peut-être du coté des événements glisser-déplacer qui par la méthode DragDropEffects, permet la copie.
Ci dessous un exemple à tester :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
Public Class Form1
 
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As  _
    System.EventArgs) Handles MyBase.Load
 
        With PictureBox1
            AddHandler .MouseDown, AddressOf pictSource_MouseDown
        End With
 
        With PictureBox2
            .AllowDrop = True
            AddHandler .DragDrop, AddressOf pictTarget_DragDrop
            AddHandler .DragEnter, AddressOf pictTarget_DragEnter
        End With
 
    End Sub
 
#Region " DRAG DROP "
 
    Private Sub pictSource_MouseDown(ByVal sender As Object, ByVal e As MouseEventArgs)
 
        Dim pictSource As PictureBox = CType(sender, PictureBox)
        pictSource.DoDragDrop(pictSource.Image, DragDropEffects.Copy)
 
    End Sub
 
    Private Sub pictTarget_DragEnter(ByVal sender As Object, ByVal e As DragEventArgs)
 
        If e.Data.GetDataPresent(DataFormats.Bitmap) Then
            e.Effect = DragDropEffects.Copy
        Else
            e.Effect = DragDropEffects.None
        End If
 
    End Sub
 
    Private picture As Image
    Private pictureLocation As Point
 
    Private Sub pictTarget_DragDrop(ByVal sender As Object, ByVal e As DragEventArgs)
 
        If TypeOf (sender) Is PictureBox Then
            Dim pictTarget As PictureBox = CType(sender, PictureBox)
            ' Assignation de l'image à la variable image.
            Me.picture = CType(e.Data.GetData(DataFormats.Bitmap), Image)
            ' Transformation du point de chute, de coordonnées "écran" en coordonnées "client".
            pictureLocation = pictTarget.PointToClient(New Point(CInt(e.X), CInt(e.Y)))
            ' Application du rapport d'échelle.
            If (Me.picture IsNot Nothing) And Not (Me.pictureLocation.Equals(Point.Empty)) Then
                Dim g As Graphics
                g = Graphics.FromImage(pictTarget.Image)
                g.DrawImage(Me.picture, New Rectangle(pictureLocation.X, pictureLocation.Y, picture.Width, picture.Height))
                g.Save()
            End If
 
            pictTarget.Invalidate()
        End If
 
    End Sub
 
#End Region
 
End Class

**ACIVE_CS** · 21/12/2015, 14h59

Re:
Essaye ce code et tu me diras si ça ressemble un peu plus à ce que tu veux faire:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
 
Public Class Form1
    Dim isDragging As Boolean = False
    Dim CurrentX As Integer, CurrentY As Integer
    Dim Bouton(64) As Button
 
    Private Sub PictureBox1_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseDown
        If e.Button = MouseButtons.Left Then
            isDragging = True
            CurrentX = e.X
            CurrentY = e.Y
        End If
    End Sub
 
    Private Sub PictureBox1_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseMove
        If isDragging Then
            PictureBox1.Top += (e.Y - CurrentY)
            PictureBox1.Left += (e.X - CurrentX)
        End If
    End Sub
 
    Private Sub PictureBox1_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseUp
        isDragging = False
        For i As Integer = 0 To 63
            If (((PictureBox1.Location.X + 15) >= Bouton(i).Location.X) And ((PictureBox1.Location.X + 15) <= Bouton(i).Location.X + 30)) And _
               (((PictureBox1.Location.Y + 15) >= Bouton(i).Location.Y) And ((PictureBox1.Location.Y + 15) <= Bouton(i).Location.Y + 30)) Then
                PictureBox1.Location = Bouton(i).Location
                Exit For
            End If
        Next
    End Sub
 
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        CrééTableau(20, 40)
        PictureBox1.Size = New Size(30, 30)
    End Sub
 
    Private Sub CrééTableau(ByVal PosX As Integer, ByVal PosY As Integer)
        Dim Index As Integer = 0
        Dim Ligne(4) As TextBox
 
        'Ligne gauche
        Ligne(0) = New TextBox
        With Ligne(0)
            .Multiline = True
            .Size = New Size(2, (30 * 8))
            .Location = New Point(PosX, PosY)
            .BorderStyle = BorderStyle.FixedSingle
        End With
        Me.Controls.Add(Ligne(0))
 
        'Ligne droite
        Ligne(1) = New TextBox
        With Ligne(1)
            .Multiline = True
            .Size = New Size(2, (30 * 8))
            .Location = New Point(PosX + (30 * 8), PosY)
            .BorderStyle = BorderStyle.FixedSingle
        End With
        Me.Controls.Add(Ligne(1))
 
        'Ligne haut
        Ligne(2) = New TextBox
        With Ligne(2)
            .Multiline = True
            .Size = New Size((30 * 8), 2)
            .Location = New Point(PosX, PosY)
            .BorderStyle = BorderStyle.FixedSingle
        End With
        Me.Controls.Add(Ligne(2))
 
        'Ligne bas
        Ligne(3) = New TextBox
        With Ligne(3)
            .Multiline = True
            .Size = New Size((30 * 8) + 2, 2)
            .Location = New Point(PosX, PosY + (30 * 8))
            .BorderStyle = BorderStyle.FixedSingle
        End With
        Me.Controls.Add(Ligne(3))
 
        For a As Integer = 0 To 7
            For b As Integer = 0 To 7
                Bouton(Index) = New Button
                With Bouton(Index)
                    .Size = New Size(30, 30)
                    .Location = New Point((a * 30) + 2 + PosX, (b * 30) + 2 + PosY)
                    .FlatAppearance.BorderSize = 0
                    .FlatStyle = FlatStyle.Flat
                End With
                Select Case a
                    Case 0, 2, 4, 6
                        Select Case b
                            Case 0, 2, 4, 6
                                Bouton(Index).BackColor = Color.White
                            Case 1, 3, 5, 7
                                Bouton(Index).BackColor = Color.LightGray
                        End Select
                    Case 1, 3, 5, 7
                        Select Case b
                            Case 0, 2, 4, 6
                                Bouton(Index).BackColor = Color.LightGray
                            Case 1, 3, 5, 7
                                Bouton(Index).BackColor = Color.White
                        End Select
                End Select
                Me.Controls.Add(Bouton(Index))
                Index += 1
            Next
        Next
    End Sub
End Class

**excalybur** · 21/12/2015, 19h18

Envoyé par ACIVE_CS

Re:
Essaye ce code et tu me diras si ça ressemble un peu plus à ce que tu veux faire:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
 
Public Class Form1
    Dim isDragging As Boolean = False
    Dim CurrentX As Integer, CurrentY As Integer
    Dim Bouton(64) As Button
 
    Private Sub PictureBox1_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseDown
        If e.Button = MouseButtons.Left Then
            isDragging = True
            CurrentX = e.X
            CurrentY = e.Y
        End If
    End Sub
 
    Private Sub PictureBox1_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseMove
        If isDragging Then
            PictureBox1.Top += (e.Y - CurrentY)
            PictureBox1.Left += (e.X - CurrentX)
        End If
    End Sub
 
    Private Sub PictureBox1_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseUp
        isDragging = False
        For i As Integer = 0 To 63
            If (((PictureBox1.Location.X + 15) >= Bouton(i).Location.X) And ((PictureBox1.Location.X + 15) <= Bouton(i).Location.X + 30)) And _
               (((PictureBox1.Location.Y + 15) >= Bouton(i).Location.Y) And ((PictureBox1.Location.Y + 15) <= Bouton(i).Location.Y + 30)) Then
                PictureBox1.Location = Bouton(i).Location
                Exit For
            End If
        Next
    End Sub
 
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        CrééTableau(20, 40)
        PictureBox1.Size = New Size(30, 30)
    End Sub
 
    Private Sub CrééTableau(ByVal PosX As Integer, ByVal PosY As Integer)
        Dim Index As Integer = 0
        Dim Ligne(4) As TextBox
 
        'Ligne gauche
        Ligne(0) = New TextBox
        With Ligne(0)
            .Multiline = True
            .Size = New Size(2, (30 * 8))
            .Location = New Point(PosX, PosY)
            .BorderStyle = BorderStyle.FixedSingle
        End With
        Me.Controls.Add(Ligne(0))
 
        'Ligne droite
        Ligne(1) = New TextBox
        With Ligne(1)
            .Multiline = True
            .Size = New Size(2, (30 * 8))
            .Location = New Point(PosX + (30 * 8), PosY)
            .BorderStyle = BorderStyle.FixedSingle
        End With
        Me.Controls.Add(Ligne(1))
 
        'Ligne haut
        Ligne(2) = New TextBox
        With Ligne(2)
            .Multiline = True
            .Size = New Size((30 * 8), 2)
            .Location = New Point(PosX, PosY)
            .BorderStyle = BorderStyle.FixedSingle
        End With
        Me.Controls.Add(Ligne(2))
 
        'Ligne bas
        Ligne(3) = New TextBox
        With Ligne(3)
            .Multiline = True
            .Size = New Size((30 * 8) + 2, 2)
            .Location = New Point(PosX, PosY + (30 * 8))
            .BorderStyle = BorderStyle.FixedSingle
        End With
        Me.Controls.Add(Ligne(3))
 
        For a As Integer = 0 To 7
            For b As Integer = 0 To 7
                Bouton(Index) = New Button
                With Bouton(Index)
                    .Size = New Size(30, 30)
                    .Location = New Point((a * 30) + 2 + PosX, (b * 30) + 2 + PosY)
                    .FlatAppearance.BorderSize = 0
                    .FlatStyle = FlatStyle.Flat
                End With
                Select Case a
                    Case 0, 2, 4, 6
                        Select Case b
                            Case 0, 2, 4, 6
                                Bouton(Index).BackColor = Color.White
                            Case 1, 3, 5, 7
                                Bouton(Index).BackColor = Color.LightGray
                        End Select
                    Case 1, 3, 5, 7
                        Select Case b
                            Case 0, 2, 4, 6
                                Bouton(Index).BackColor = Color.LightGray
                            Case 1, 3, 5, 7
                                Bouton(Index).BackColor = Color.White
                        End Select
                End Select
                Me.Controls.Add(Bouton(Index))
                Index += 1
            Next
        Next
    End Sub
End Class

Bonjour

En fait un savant cocktail des deux solutions s'approche de mon idée.

Cet exemple que tu propose avec l'échiquier reconstruit est probablement une bonne voie de recherche pour le drop qui se positionne pile sur la case ad'hoc. Il répond au cahier des charges. Merci !

Reste que la picturebox1 d'origine disparait et ceci est gênant quand il faut mettre huit pions sur l'échiquier puisqu'il il faut donc recommencer le drag and dop 7 autre fois à partir de la picturebox1 d'origine.

De la à traiter l'échiquier comme 8x8 = 64 picturebox ?! Un peu fastidieux je pense est probablement assez lent à l'utilisation.

Le code en Vb6 de mon précédent programme considère les position x et y en pixel de la frame (dans la form) contenant l'échiquier en autoredraw.

encore merci pour tes recherches.

A+

**excalybur** · 21/12/2015, 19h00

Envoyé par chrismonoye

Bonjour,
voir peut-être du coté des événements glisser-déplacer qui par la méthode DragDropEffects, permet la copie.
Ci dessous un exemple à tester :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
Public Class Form1
 
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As  _
    System.EventArgs) Handles MyBase.Load
 
        With PictureBox1
            AddHandler .MouseDown, AddressOf pictSource_MouseDown
        End With
 
        With PictureBox2
            .AllowDrop = True
            AddHandler .DragDrop, AddressOf pictTarget_DragDrop
            AddHandler .DragEnter, AddressOf pictTarget_DragEnter
        End With
 
    End Sub
 
#Region " DRAG DROP "
 
    Private Sub pictSource_MouseDown(ByVal sender As Object, ByVal e As MouseEventArgs)
 
        Dim pictSource As PictureBox = CType(sender, PictureBox)
        pictSource.DoDragDrop(pictSource.Image, DragDropEffects.Copy)
 
    End Sub
 
    Private Sub pictTarget_DragEnter(ByVal sender As Object, ByVal e As DragEventArgs)
 
        If e.Data.GetDataPresent(DataFormats.Bitmap) Then
            e.Effect = DragDropEffects.Copy
        Else
            e.Effect = DragDropEffects.None
        End If
 
    End Sub
 
    Private picture As Image
    Private pictureLocation As Point
 
    Private Sub pictTarget_DragDrop(ByVal sender As Object, ByVal e As DragEventArgs)
 
        If TypeOf (sender) Is PictureBox Then
            Dim pictTarget As PictureBox = CType(sender, PictureBox)
            ' Assignation de l'image à la variable image.
            Me.picture = CType(e.Data.GetData(DataFormats.Bitmap), Image)
            ' Transformation du point de chute, de coordonnées "écran" en coordonnées "client".
            pictureLocation = pictTarget.PointToClient(New Point(CInt(e.X), CInt(e.Y)))
            ' Application du rapport d'échelle.
            If (Me.picture IsNot Nothing) And Not (Me.pictureLocation.Equals(Point.Empty)) Then
                Dim g As Graphics
                g = Graphics.FromImage(pictTarget.Image)
                g.DrawImage(Me.picture, New Rectangle(pictureLocation.X, pictureLocation.Y, picture.Width, picture.Height))
                g.Save()
            End If
 
            pictTarget.Invalidate()
        End If
 
    End Sub
 
#End Region
 
End Class

bonjour,

Merci pour ta première réponse. Le principe du glisser copie d'image et dépot est bon. Il laisse l'image initial sur la case de départ et en dépose une autre sur le picture d'arrivée.

1er bémol si le picture d'arrivée (un échiquier 8x8 cases) est plus grand que l'image à droper il apparait ce message d'erreur :

Nom : erreur.JPG
Affichages : 889
Taille : 94,9 Ko

Nom : erreur.JPG
Affichages : 889
Taille : 94,9 Ko

pourtant tous mes objets sont bien en .bmp

Je ne comprend pas ce message d'erreur.

2ème bémol : lors du mouvement dragmove l'image de la pièce est remplacé par un stationnement interdit. C'est pas très parlant.

Déplacer une copie d'un PictureBox avec le curseur souris.

VB.NET

Vue hybride

Discussions similaires

Partager

Partager