منتدى فيجوال بيسك لكل العرب | منتدى المبرمجين العرب
[سؤال] كيف اجعل صورتين تغيران مواقعهما بسحب احدهما - نسخة قابلة للطباعة

+- منتدى فيجوال بيسك لكل العرب | منتدى المبرمجين العرب (http://vb4arb.com/vb)
+-- قسم : قسم لغة الفيجوال بيسك VB.NET (http://vb4arb.com/vb/forumdisplay.php?fid=182)
+--- قسم : قسم اسئلة VB.NET (http://vb4arb.com/vb/forumdisplay.php?fid=183)
+--- الموضوع : [سؤال] كيف اجعل صورتين تغيران مواقعهما بسحب احدهما (/showthread.php?tid=36350)

كيف اجعل صورتين تغيران مواقعهما بسحب احدهما - عبد الهادي بهاب - 10-09-20

السلام عليكم

في المشروع السابق 

لعبة المقارنة بين الاطوال 

http://vb4arb.com/vb/showthread.php?tid=36328

اعتمدنا طريقة التقر على صورتين لتغير مواقعهما

هل فيه لقطة بحيث استعمل mouse move  لسحب صورة نحو صورة فيتم تغير مواقعهما

طبعا نحن نتعامل فقط بالسحب على خط افقي اي لا يتغير y بل فقط  x

حتى ذلكم الحين شكرا

RE: كيف اجعل صورتين تغيران مواقعهما بسحب احدهما - Anas Mahmoud - 10-09-20

تفضل اخي الكريم : 

اضفت الاكواد التالية الى مشروعك بعد اذنك  بدلا من حدث الضغط على الصور :

كود :
   Dim movingPicOriginalLeft As Integer
   Dim movingPic As PictureBox

   Dim mX As Integer

كود :
   Private Sub PictureBox9_MouseDown(sender As Object, e As MouseEventArgs)
       Dim pic As PictureBox = sender
       pic.BringToFront()
       movingPic = pic
       movingPicOriginalLeft = pic.Left
       mX = e.X
   End Sub

كود :
   Private Sub PictureBox9_MouseMove(sender As Object, e As MouseEventArgs)
       Dim pic As PictureBox = sender
       If pic Is movingPic Then
           pic.Left += e.X - mX
       End If
   End Sub

كود :
   Private Sub PictureBox9_MouseUp(sender As Object, e As MouseEventArgs)
       Dim pic As PictureBox = sender
       Dim OverlappingPic As PictureBox = GetOvelapping(pic)
       RestoreLocation()
       If Not OverlappingPic Is Nothing Then
           SwapPicture(pic, OverlappingPic)
       End If
   End Sub
كود :
   Function GetOvelapping(picturebox As PictureBox) As PictureBox
       For Each pic In Pict
           If pic.Visible = False Then Continue For
           If pic Is picturebox Then Continue For
           If IsOverlapping(pic, picturebox) Then Return pic
       Next
       Return Nothing
   End Function

   Function IsOverlapping(pic1 As PictureBox, pic2 As PictureBox) As Boolean
       Return ((pic1.Left + pic1.Width) > pic2.Left) And
           ((pic1.Left) < pic2.Left + pic2.Width)

   End Function

   Sub SwapPicture(pic1 As PictureBox, pic2 As PictureBox)
       Dim tmpLeft As Integer
       tmpLeft = pic1.Left
       pic1.Left = pic2.Left
       pic2.Left = tmpLeft
   End Sub

   Sub RestoreLocation()
       If movingPic Is Nothing Then Return
       movingPic.Left = movingPicOriginalLeft
       movingPic = Nothing
       movingPicOriginalLeft = Nothing
       mX = Nothing
   End Sub

واضفت ايضا في الفورم لود :

كود :
       For Each pic In Pict
           AddHandler pic.MouseDown, AddressOf PictureBox9_MouseDown
           AddHandler pic.MouseUp, AddressOf PictureBox9_MouseUp
           AddHandler pic.MouseMove, AddressOf PictureBox9_MouseMove
       Next

وعملت كما طلبت اعتقد 
جرب واعطني رأيك

RE: كيف اجعل صورتين تغيران مواقعهما بسحب احدهما - عبد الهادي بهاب - 10-09-20

(10-09-20, 03:51 PM)Anas Mahmoud كتب : تفضل اخي الكريم : 

جرب واعطني رأيك

ما شاء الله ربي يجازيك خيرا استاذ انس

ممتاز  و سلس ......... ربي لا يحرمنا منك و من خدماتك

دوما خدوم للاخرين
سؤال سيدي الكريم

ما دور GetOvelapping(pic)

Swap


ما معنى Continue For

RE: كيف اجعل صورتين تغيران مواقعهما بسحب احدهما - Anas Mahmoud - 10-09-20

(10-09-20, 04:50 PM)عبد الهادي بهاب كتب : سؤال سيدي الكريم

ما دور GetOvelapping(pic)

Swap


ما معنى Continue For


GetOvelapping تبحث عن مربع صورة يتقاطع مع مربع الصورة المرسل ، لتحديد مربعين الصور المطلوب تبديل موقعهما

Swap تقوم بتبديل اماكن مربعين الصور

Continue For تقوم بتخطي باقي دورة For الحالية والانتقال الى الدورة القادمة

RE: كيف اجعل صورتين تغيران مواقعهما بسحب احدهما - عبد الهادي بهاب - 10-09-20

تحية طيبة استاذ انس