السلام عليكم
في المشروع السابق
لعبة المقارنة بين الاطوال
http://vb4arb.com/vb/showthread.php?tid=36328
اعتمدنا طريقة التقر على صورتين لتغير مواقعهما
هل فيه لقطة بحيث استعمل mouse move لسحب صورة نحو صورة فيتم تغير مواقعهما
طبعا نحن نتعامل فقط بالسحب على خط افقي اي لا يتغير y بل فقط x
حتى ذلكم الحين شكرا
تفضل اخي الكريم :
اضفت الاكواد التالية الى مشروعك بعد اذنك بدلا من حدث الضغط على الصور :
كود :
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
وعملت كما طلبت اعتقد
جرب واعطني رأيك
(10-09-20, 03:51 PM)Anas Mahmoud كتب : [ -> ]تفضل اخي الكريم :
جرب واعطني رأيك
ما شاء الله ربي يجازيك خيرا استاذ انس
ممتاز و سلس ......... ربي لا يحرمنا منك و من خدماتك
دوما خدوم للاخرين
سؤال سيدي الكريم
ما دور GetOvelapping(pic)
Swap
ما معنى Continue For
(10-09-20, 04:50 PM)عبد الهادي بهاب كتب : [ -> ]سؤال سيدي الكريم
ما دور GetOvelapping(pic)
Swap
ما معنى Continue For
GetOvelapping تبحث عن مربع صورة يتقاطع مع مربع الصورة المرسل ، لتحديد مربعين الصور المطلوب تبديل موقعهما
Swap تقوم بتبديل اماكن مربعين الصور
Continue For تقوم بتخطي باقي دورة For الحالية والانتقال الى الدورة القادمة