سحب وفلت الكائنات في النموذج Drag drop

[شريف كونكت]

محتاج كود تحريك العنصر داخل النموذج عن طريق السحب والافلات زى الكود ده بس للاسف لما نزلته  الكود مشفر لو سمحتو وشكرا مقدما

[Foksh]

بدايةً ارجو منك اخي الكريم @شريف كونكت الإلتزام بقوانين المنتدى ومن ضمنها وصف المشكلة في العنوان ، ثم ارفاق ملف حتى لو الكود مشفر 🤗

[شريف كونكت]

3 ساعات مضت, Foksh said:

بدايةً ارجو منك اخي الكريم @شريف كونكت الإلتزام بقوانين المنتدى ومن ضمنها وصف المشكلة في العنوان ، ثم ارفاق ملف حتى لو الكود مشفر 🤗

ببساطه شديه انا عندى كود سحب وافلات العناصر بس المشكله عندى بعد عمليه السحب والافلات مش بيحفظ مكان التكست بوكس الجديد انا محتاج كود الحفظ  وشكرا جزيلا وانا حملت ليكو الان الكود المشفر محتاج زى ده او كود تانى يحفظ مكان التكست الجديد

PCTW_4.zip

[Foksh]

7 ساعات مضت, شريف كونكت said:

عندى كود سحب وافلات العناصر

أخي شريف ، عندك كود !!!
أين الكود ؟؟؟؟؟؟

المرفق السابق ملف MDE أي لا يمكن الوصول إلى الأكواد أو طريقة عرض التصميم !!!!!!!!!!!!

وإذا كان المقصد من كلمة متشفرة = محمية بكلمة مرور فهذا شيء آخر يختلف عن ملف مقفل Accde أو MDE .

 

على العموم انت تريد موضوع جديد من البداية وليس تعديل على الكود لعدم وجوده أساساً .

 

بالنسبة لي سأرى ما يمكن فعله وأتابع معك في هذه الفكرة 

تم تعديل يوليو 5 بواسطه Foksh

[Foksh]

على العموم ، من خلال تجربة سابقة لي في أحد برامجي ، جرب هذه الفكرة التي تتيح لك اختيار العنصر الذي تريد تحريكه ( مربع نص ، زر ، كومبوبوكس ) .... إلخ .

• بدايةً سنقوم بإنشاء مديول عام ولنفترض اسمه Drag_Drop وسيحتوي على هذا الكود البسيط :-

Option Compare Database
Option Explicit

Public DragControl As Control
Public XOffset As Single
Public YOffset As Single

Public Sub StartDrag(ctrl As Control, X As Single, Y As Single)
    Set DragControl = ctrl
    XOffset = X
    YOffset = Y
End Sub

Public Sub Dragging(X As Single, Y As Single)
    If Not DragControl Is Nothing Then
        DragControl.Left = DragControl.Left + (X - XOffset)
        DragControl.Top = DragControl.Top + (Y - YOffset)
    End If
End Sub

Public Sub EndDrag()
    Set DragControl = Nothing
End Sub

للتوضيح والشرح للمديول :-

1.  المتغير DragControl هو متغير من نوع Control يتم فيه تخزين العنصر الذي يتم سحبه حاليًا .
2. المتغيران XOffset و YOffset هما من نوع Single وظيفتهما تخزن إحداثيات الماوس عند بداية عملية السحب .
3. الدالة StartDrag التي ستعيد بدء عملية السحب للعنصر المحدد . حيث أنها تستقبل ثلاث معاملات [ ctrl (العنصر الذي يتم سحبه)، X و Y (إحداثيات الماوس في نقطة النقر) ] .
4. الدالة Dragging التي تستخدم أثناء جر العنصر . حيث ستقوم بتحديث موقع DragControl (العنصر المحدد للسحب) بناءً على إحداثيات الماوس الحالية . وستستخدم XOffset و YOffset لضمان تحديث العنصر بالشكل الصحيح مع تحريك الماوس .
5. الدالة EndDrag التي سوف تنهي عملية السحب بتفريغ قيمة DragControl ، مما يعني أنه لم يعد هناك عنصر يتم تحريكه .

 

• سنحتاج الجدول ControlPositions يتم تخزين قيم الموقع والإحداثيات لكل عنصر داخل أي نموذج . وسنحتاج إلى الحقول التالية ( ID و FormName و ControlName و ControlLeft و ControlTop ) . وهي بعد الحقل ID ترقيم تلقائي ( حقل لإسم النموذج ، وحقل لاسم العنصر داخل هذا النموذج ، وحقلين للإحداثيات ( اليسار والأعلى ) لكل عنصر .

 

• الآن في النموذج الذي سيتم التنفيذ عليه ؛ نقوم بوضع هذه الأكواد ( حجز المتغيرات والثوابت ، والإحداث عن الاغلاق والفتح ، والتحريك للماوس ) للنموذج فقط ..

Option Compare Database
Option Explicit

Public DragControl As Control
Public XOffset As Single
Public YOffset As Single

Public Sub StartDrag(ctrl As Control, X As Single, Y As Single)
    Set DragControl = ctrl
    XOffset = X
    YOffset = Y
End Sub

Public Sub Dragging(X As Single, Y As Single)
    If Not DragControl Is Nothing Then
        DragControl.Left = DragControl.Left + (X - XOffset)
        DragControl.Top = DragControl.Top + (Y - YOffset)
        UpdateControlPosition DragControl
    End If
End Sub

Public Sub EndDrag()
    Set DragControl = Nothing
End Sub

Private Sub Form_Load()
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim strSQL As String
    Dim ctrl As Control
    Set db = CurrentDb
    Set rs = db.OpenRecordset("ControlPositions", dbOpenDynaset)
    Do While Not rs.EOF
        For Each ctrl In Me.Controls
            If ctrl.Name = rs!ControlName Then
                ctrl.Left = rs!ControlLeft
                ctrl.Top = rs!ControlTop
                Exit For
            End If
        Next ctrl
        rs.MoveNext
    Loop
    rs.Close
    Set rs = Nothing
    Set db = Nothing
End Sub

Private Sub Form_Close()
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim strSQL As String
    Dim ctrl As Control
    Set db = CurrentDb
    Set rs = db.OpenRecordset("ControlPositions", dbOpenDynaset)
    strSQL = "DELETE * FROM ControlPositions WHERE FormName='" & Me.Name & "'"
    db.Execute strSQL, dbFailOnError
    For Each ctrl In Me.Controls
        If TypeOf ctrl Is Control Then
            strSQL = "INSERT INTO ControlPositions (FormName, ControlName, ControlLeft, ControlTop) " & _
                     "VALUES ('" & Me.Name & "', '" & ctrl.Name & "', " & ctrl.Left & ", " & ctrl.Top & ")"
            db.Execute strSQL, dbFailOnError
        End If
    Next ctrl
    rs.Close
    Set rs = Nothing
    Set db = Nothing
End Sub

Private Sub UpdateControlPosition(ctrl As Control)
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim strSQL As String
    Set db = CurrentDb
    Set rs = db.OpenRecordset("ControlPositions", dbOpenDynaset)
    strSQL = "SELECT * FROM ControlPositions WHERE FormName = '" & Me.Name & "' AND ControlName = '" & ctrl.Name & "'"
    If Not rs.EOF Then
        rs.Edit
        rs.Fields("ControlLeft").Value = ctrl.Left
        rs.Fields("ControlTop").Value = ctrl.Top
        rs.Update
    Else
        rs.AddNew
        rs.Fields("FormName").Value = Me.Name
        rs.Fields("ControlName").Value = ctrl.Name
        rs.Fields("ControlLeft").Value = ctrl.Left
        rs.Fields("ControlTop").Value = ctrl.Top
        rs.Update
    End If
    rs.Close
    Set rs = Nothing
    Set db = Nothing
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Not Me.ActiveControl Is Nothing Then
        StartDrag Me.ActiveControl, X, Y
    End If
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 1 Then
        Dragging X, Y
    End If
End Sub

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

 

• الآن نأتي للأحداث الخاصة بالعناصر التي نرغب في منح المستخدم حرية تغيير مواقعها .

وسأبدأ بالتنفيذ على ( مربع نص TextBox1 و زر Command10 ) فقط ، والباقي مجرد تكرار مع تغيير الأسماء للعناصر .

Private Sub TextBox1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Form_MouseDown Button, Shift, X, Y
End Sub

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

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

Private Sub Command10_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Form_MouseDown Button, Shift, X, Y
End Sub

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

Private Sub Command10_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Form_MouseUp Button, Shift, X, Y
    UpdateControlPosition Me.ActiveControl
End Sub

 

• وهذا المرفق تنفيذ ما تم شرحه سابقاً 
• Move And Drops.accdb

 

تم تعديل يوليو 5 بواسطه Foksh
تعديل على شمولية جميع أنواع العناصر

[شريف كونكت]

4 ساعات مضت, Foksh said:

على العموم ، من خلال تجربة سابقة لي في أحد برامجي ، جرب هذه الفكرة التي تتيح لك اختيار العنصر الذي تريد تحريكه ( مربع نص ، زر ، كومبوبوكس ) .... إلخ .

•  

اولا اشكرك اخى الحبيب ثانيا هل هذا الكود هيشتغل كويس على التقرير وليس النموزج ؟ لانى جربت كتير ومفيش حاجه ظبط مع التقرير (  Report ) لانه بعد السحب والتحريك للمكان المطلوب عند الضغط على زر طباعه التقرير مش بيحفظ الاماكن هل هذا الكود هيكون تمام مع التقارير ولا ده كده للنمازج فقط انا يهمنى التقرير بتاع الطباعه وشكرا جزيلا اخى الكريم واسف لتعبك معى منتظر ردر حضرتك

[Foksh]

3 ساعات مضت, شريف كونكت said:

اولا اشكرك اخى الحبيب ثانيا هل هذا الكود هيشتغل كويس على التقرير وليس النموزج ؟ لانى جربت كتير ومفيش حاجه ظبط مع التقرير (  Report ) لانه بعد السحب والتحريك للمكان المطلوب عند الضغط على زر طباعه التقرير مش بيحفظ الاماكن هل هذا الكود هيكون تمام مع التقارير ولا ده كده للنمازج فقط انا يهمنى التقرير بتاع الطباعه وشكرا جزيلا اخى الكريم واسف لتعبك معى منتظر ردر حضرتك

لم اقم بالتجربة على التقارير فعلاً كونك لم تأتي بتحديد التقارير ، ولكن جرب انت واخبرنا بالنتيجة ، وأنا سأقوم بالتجربة غداً أيضاً ، وإن لم يتم الامر على التقارير سنقوم باللازم.

تم تعديل يوليو 5 بواسطه Foksh

[شريف كونكت]

معلش ياغالى انا تعبتك معايا بس انا عملت حاجه كده على التقارير شغاله كويس بس للاسف مش بيحفظ المكان الجديد عند الطباعه عموما هبعتلك نسخه من اللى عملته معلش هتعبك معايا لو امكن بس تخليه يحفظ التغييرات عند الطباعه وتبعتهولى تانى ده لو مش هتعبك وانا اسف جدا لازعاجك الشغل كله هتلاقيه فى صفحه ال main اسم المستخدم 1989 والباسورد 19

رابط تحميل النسخه 

https://top4top.io/downloadf-3109uh7in1-rar.html

ومره كمان اسف جدا لازعاجك معلش هتعبك معايا ياهندسه

منتظر ردك 

[Foksh]

10 دقائق مضت, شريف كونكت said:

معلش ياغالى انا تعبتك معايا بس انا عملت حاجه كده على التقارير شغاله كويس بس للاسف مش بيحفظ المكان الجديد عند الطباعه عموما هبعتلك نسخه من اللى عملته معلش هتعبك معايا لو امكن بس تخليه يحفظ التغييرات عند الطباعه وتبعتهولى تانى ده لو مش هتعبك وانا اسف جدا لازعاجك الشغل كله هتلاقيه فى صفحه ال main اسم المستخدم 1989 والباسورد 19

رابط تحميل النسخه 

https://top4top.io/downloadf-3109uh7in1-rar.html

ومره كمان اسف جدا لازعاجك معلش هتعبك معايا ياهندسه

منتظر ردك 

لا شكر على واجب اخي الكريم @شريف كونكت ..

في أقرب فرصة إن شاء الله اليوم نوصل لحل في التقرير عند وضع الطباعة 🤗

تم تعديل يوليو 6 بواسطه Foksh