Bonjour à tous !
Programme en VB.NET Visual Studio Community 2020
Mon programme (Jeu de Cartes) consiste à déplacer une carte(PictureBox) vers une autre carte(PictureBox)
En utilisant les fonctions Drag'Drop, pas de problème tout fonctionne bien la carte est bien déplacée vers l'autre
carte. Mais le déplacement de la carte (via la souris) se fait avec un icône de déplacement et non la carte elle-même.
Donc pour déplacement réellement la carte de manière visuelle il existe une API qui le fait très bien : ReleaseCapture()
Avec cette fonction le déplacement de la carte se fait très bien avec la souris.
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 Public Sub Cartes_MouseMove(sender As Object, e As MouseEventArgs) Dim Larg = sender.Width : Dim Haut = sender.Height : Dim Ws = Me.ClientSize.Width : Dim Hs = Me.ClientSize.Height Dim Largeur = sender.Width : Hauteur = sender.Height : Dim L = sender.Left : Dim T = sender.Top Dim lHwnd As IntPtr lHwnd = sender.Handle If lHwnd = 0 Then Exit Sub Me.Cursor = Cursors.Hand ReleaseCapture() If L < Cadre_Boutons.Left + Cadre_Boutons.Width Then sender.Left = Cadre_Boutons.Left + Cadre_Boutons.Width ElseIf L > Ws - Largeur Then sender.Left = Ws - Larg ElseIf T < Cadre_Boutons.Top Then sender.Top = Cadre_Boutons.Top ElseIf T > Hs - Haut Then sender.Top = Hs - Haut End If SendMessage(lHwnd, &HA1, 2, 0&) End Sub
Mais comment faire pour tester lorsque la carte déplacée touchera une autre carte
ce que faisait très bien le drag n' drop(voir ci-après) parce que le Drag And Drop
fournit une valeur Source et C0ible (DragEnter) ce que ne fait pas Capture().
J'espère avoir Clair dans mon problème et que quelqu'un pourra m'apporter la solution
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 Public Sub Cartes_MouseMove(sender As Object, e As MouseEventArgs) If m_MouseIsDown Then Source.DoDragDrop(Source, DragDropEffects.Move) : m_MouseIsDown = False End Sub Public Sub Cartes_DragEnter(sender As Object, e As DragEventArgs) If TypeOf (sender) Is PictureBox Then If Test_Tapis(Source, sender) Then ' Si la Carte va sur le Tapis inclus une Case-vide et sur joueur e.Effect = DragDropEffects.Move End If Else e.Effect = DragDropEffects.None End If End Sub Public Sub Cartes_DragDrop(sender As Object, e As DragEventArgs) If Mid(sender.name, 5, 1) = "1" Or Mid(sender.name, 5, 1) = "0" Then Exit Sub Create_Carte(sender) ' on crée la carte du déplacement sur le Tapis If Flag Then Flag = False : Change() ' on passe la main à l'ordinateur ou au joueur suivant End If End Sub
D'avance Merci !
Partager