+- منتدى فيجوال بيسك لكل العرب | منتدى المبرمجين العرب (http://vb4arb.com/vb)
+-- قسم : الأقسام التعليمية - المنتدى القديم (http://vb4arb.com/vb/forumdisplay.php?fid=90)
+--- قسم : قسم دورات المنتدى (http://vb4arb.com/vb/forumdisplay.php?fid=113)
+---- قسم : دورة بناء برنامج لإدارة السوبر ماركت من الألف إلى الياء (http://vb4arb.com/vb/forumdisplay.php?fid=128)
+---- الموضوع : الدرس الرابع عشر - اضافة موردين وأنواع والتحكم فيهم (/showthread.php?tid=5702)
الدرس الرابع عشر - اضافة موردين وأنواع والتحكم فيهم - RaggiTech - 15-10-12
كاتب الموضوع : أحمد جمال
بسم الله الرحمن الرحيم .
السلام عليكم ورحمة الله وبركاته .
السلام عليكم ورحمة الله وبركاته .
اضافة موردين ( مصانع ) أو أنواع .
بما أن الشاشتان يقومان بنفس المهمة فسنجعلهم جميعاً في شاشة واحدة توفيراً لعدد الشاشات في التصميم ، وسنفرق بينهم حسب محتويات عنوان الشاشة ( اضافة مورد أو اضافة نوع ) وسنضبط المحتوى عند تشغيل الفورم .
كما يمكننا التفريق بينهم من خلال خاصية Tag ولمن لا يعرف هذه الخاصية فهي عبارة عن قيمة للفورم يمكننا التخزين فيها دون أن تظهر للمستخدم ، ويمكننا مثلاً اخبار البرنامج بإنه إذا كانت tag=0 فهذا معناه الشاشة الأولى ، وإلا فهي الثانية مثلاً ، عموماً لن نستخدم هذه الطريقة وسنعتمد على الطريقة الأولى .
لنصمم فورماً صغيراً كل ما يحتوي عليه هو 4 أزرار للاضافة ، حذف الحالي ، تعديل الاسم ، وللانهاء ، كذلك يحتوي على قائمة بالموردين أو الأنواع الحالية ، ومربع نص لنضع به المورد أو النوع الذي نرغب في اضافته .
وأخيراً اسم الفورم Frm_Add_2
كما يمكننا التفريق بينهم من خلال خاصية Tag ولمن لا يعرف هذه الخاصية فهي عبارة عن قيمة للفورم يمكننا التخزين فيها دون أن تظهر للمستخدم ، ويمكننا مثلاً اخبار البرنامج بإنه إذا كانت tag=0 فهذا معناه الشاشة الأولى ، وإلا فهي الثانية مثلاً ، عموماً لن نستخدم هذه الطريقة وسنعتمد على الطريقة الأولى .
لنصمم فورماً صغيراً كل ما يحتوي عليه هو 4 أزرار للاضافة ، حذف الحالي ، تعديل الاسم ، وللانهاء ، كذلك يحتوي على قائمة بالموردين أو الأنواع الحالية ، ومربع نص لنضع به المورد أو النوع الذي نرغب في اضافته .
وأخيراً اسم الفورم Frm_Add_2
كذلك لا تنس أن تغير الاسم في القائمة من ( اضافة مورد جديد - اضافة نوع جديد ) إلى ( التحكم بالموردين - التحكم بالأنواع ) . حيث أن الأمر لن يقتصر على الاضافة بل سيشمل الحذف والتعديل أيضاً .
والآن إلى أمر اظهار هذه الشاشة :
وهذا جزء من الأمر الكلي للقائمة ...
والآن إلى أمر اظهار هذه الشاشة :
كود :
Case 1
Frm_Add_2.lbl_name = "معلومات الأنواع"
Frm_Add_2.Refresh_Me
Frm_Add_2.Show 1
Case 2
Frm_Add_2.lbl_name = "معلومات الموردين"
Frm_Add_2.Refresh_Me
Frm_Add_2.Show 1والآن ما هو أمر
Refresh_Me ؟
إنه اجراء Sub لكنه من نوع Public بحيث يمكن مناداته من خارج الفورم ، ووظيفته تكمن في ملء القائمة بالمحتويات المناسبة :
لكن وبما أن هذه شاشة متخصصة بعرض الأنواع والموردين ، فلا بد من وضع كلمة بجانب الموردين والأنواع المحذوفة ، لاحظ الكود التالي :
كما ينبغي أيضاً كتابة رقم النوع أو المورد بجانبه ، ولذا سيكون الكود كالتالي :
والآن إلى كتابة أوامر الأزرار ، مبدئياً لا تنس أمر اغلاق الشاشة :
ولنر الكود الخاص بعملية الاضافة ... وسيكون النظام بالشكل التالي :
كود :
Public Sub Refresh_Me()
List1.Clear
If lbl_name.Caption = "معلومات الأنواع" Then
If T2.RecordCount <> 0 Then T2.MoveFirst
For i = 0 To T2.RecordCount - 1
List1.AddItem T2!Name
T2.MoveNext
Next i
Else
If T3.RecordCount <> 0 Then T3.MoveFirst
For i = 0 To T3.RecordCount - 1
List1.AddItem T3!Name
T3.MoveNext
Next i
End If
End Subكود :
If T2!View = False Then List1.AddItem T2!Name & " (محذوف)" Else List1.AddItem T2!Nameكود :
If T2!View = False Then List1.AddItem T2!Number & "-" & T2!Name & " (محذوف)" Else List1.AddItem T2!Number & "-" & T2!Nameكود :
Unload Me* التأكد أولاً من كتابة اسم في مربع النص .
* التأكد من نوع العملية ( اضافة مورد أم اضافة نوع ) .
* التأكد من عدم وجود مورد أو نوع بنفس الاسم سابقاً .
* اضافة النوع أو المورد الجديد إلى قاعدة البيانات .
* تحديث القائمة عن طريق استدعاء أمر
* التأكد من نوع العملية ( اضافة مورد أم اضافة نوع ) .
* التأكد من عدم وجود مورد أو نوع بنفس الاسم سابقاً .
* اضافة النوع أو المورد الجديد إلى قاعدة البيانات .
* تحديث القائمة عن طريق استدعاء أمر
Refresh_Me ، وافراغ مربع النص .
سنضيف جميع هذه الأوامر في اجراء جديد نسميه MyAdd .
والآن ، قبل البدء بأي عملية حذف أو تعديل لا بد من التأكد أن ثم شيئاً محدداً من القائمة ، ويتم التأكد من ذلك بالشكل التالي :
شيء آخر ولكنه موجود في التعديل فقط ، لابد من معرفة هل هناك بيانات في مربع النص أم لا ، ويتم ذلك بالشكل التالي :
الجزء الآخر المطلوب هو معرفة رقم ذلك العنصر ، ولو لاحظت أن هذا الرقم يبدأ من اليمين وباتجاه اليسار وتكون نهايته قبل علامة "-" مباشرة ، فلنر إن كان بإمكاننا تحويل ذلك إلى كود :
هذا صحيح تماماً ، فهنا ستحتوي txt على الرقم ، ولكن بصورة نصية ، وعند الاستعلام سوف نستعلم عن Val(txt) .
والآن لنضع هذا الكود في عمليتي الحذف والتعديل .
كود :
Sub MyAdd()
If Text1.Text = "" Then
MsgBox "لا بد من ادخال اسم البضاعة !", vbExclamation + arabic, "اضافة بضاعة"
Exit Sub
End If
If lbl_name.Caption = "معلومات الأنواع" Then
'add category ...
SQL = "select * from tb_category where name='" & Text1.Text & "'"
Set T4 = D1.OpenRecordset(SQL, dbOpenDynaset)
If T4.RecordCount <> 0 Then
MsgBox "يوجد نوع له نفس الاسم ، فضلاً اختر اسماً آخر", vbExclamation + arabic, "اضافة نوع"
Text1.SetFocus
Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
Exit Sub
End If
T2.AddNew
T2!Name = Text1.Text
T2.Update
Else
'add factory ...
SQL = "select * from tb_factory where name='" & Text1.Text & "'"
Set T4 = D1.OpenRecordset(SQL, dbOpenDynaset)
If T4.RecordCount <> 0 Then
MsgBox "يوجد مورد له نفس الاسم ، فضلاً اختر اسماً آخر", vbExclamation + arabic, "اضافة مورد"
Text1.SetFocus
Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
Exit Sub
End If
T3.AddNew
T3!Name = Text1.Text
T3.Update
End If
Refresh_Me
Text1.Text = ""
End Subوالآن ، قبل البدء بأي عملية حذف أو تعديل لا بد من التأكد أن ثم شيئاً محدداً من القائمة ، ويتم التأكد من ذلك بالشكل التالي :
كود :
If List1.ListIndex = -1 Then
MsgBox "عليك اختيار عنصر من القائمة أولاً", vbExclamation + arabic, "حذف"
Exit Sub
End Ifكود :
If Text1.Text = "" Then
MsgBox "لا بد من ادخال الاسم الجديد لاستبداله بالاسم القديم !", vbExclamation + arabic, "اضافة بضاعة"
Exit Sub
End Ifكود :
Dim txt
Dim i
i = 1
Do While (Mid(List1.Text, i, 1)) <> "-"
txt = txt & Mid(List1.Text, i, 1)
i = i + 1
Loop
MsgBox txtوالآن لنضع هذا الكود في عمليتي الحذف والتعديل .
*** يمكننا وضع هذا الأمر بعد ذلك في دالة حيث نستخدمها من أي مكان عند الحاجة إليها .
يتبع ...
الدرس الرابع عشر - اضافة موردين وأنواع والتحكم فيهم - RaggiTech - 15-10-12
سنبدأ في الأجزاء القادمة في التفصيل ، وسنتعامل الآن مع عملية التعديل .
بحسب نوع العملية ينبغي أن نبحث هل يوجد نوع أو مورد له نفس الاسم قبل الاكمال :
ونفس الامر بالنسبة للموردين .
الجزء الآخر هو الذهاب إلى هذا السجل عن طريق T2 أو T3 ، ويتم ذلك بالدوران حتى العثور على الرقم الذي قمنا بتخزينه في txt .
وكذلك وبنفس الطريقة مع الموردين ، وأخيراً أمر التعديل :
وبذلك يصبح الكود الكامل لزر التعديل :
بحسب نوع العملية ينبغي أن نبحث هل يوجد نوع أو مورد له نفس الاسم قبل الاكمال :
كود :
SQL = "select * from tb_category where name='" & Text1.Text & "'"
Set T4 = D1.OpenRecordset(SQL, dbOpenDynaset)
If T4.RecordCount <> 0 Then
MsgBox "يوجد نوع له نفس الاسم ، فضلاً اختر اسماً آخر", vbExclamation + arabic, "اضافة نوع"
Text1.SetFocus
Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
Exit Sub
End Ifالجزء الآخر هو الذهاب إلى هذا السجل عن طريق T2 أو T3 ، ويتم ذلك بالدوران حتى العثور على الرقم الذي قمنا بتخزينه في txt .
كود :
If T2.RecordCount <> 0 Then T2.MoveFirst
For i = 0 To T2.RecordCount - 1
If T2!Number = Val(txt) Then Exit For
T2.MoveNext
Next iكود :
T2.Edit
T2!Name = Text1.Text
T2.Updateوبذلك يصبح الكود الكامل لزر التعديل :
كود :
If List1.ListIndex = -1 Then
MsgBox "عليك اختيار عنصر من القائمة أولاً", vbExclamation + arabic, "تعديل"
Exit Sub
End If
If Text1.Text = "" Then
MsgBox "لا بد من ادخال الاسم الجديد لاستبداله بالاسم القديم !", vbExclamation + arabic, "اضافة بضاعة"
Exit Sub
End If
Dim txt
Dim i
i = 1
Do While (Mid(List1.Text, i, 1)) <> "-"
txt = txt & Mid(List1.Text, i, 1)
i = i + 1
Loop
If lbl_name.Caption = "معلومات الأنواع" Then
'edit category ...
SQL = "select * from tb_category where name='" & Text1.Text & "'"
Set T4 = D1.OpenRecordset(SQL, dbOpenDynaset)
If T4.RecordCount <> 0 Then
MsgBox "يوجد نوع له نفس الاسم ، فضلاً اختر اسماً آخر", vbExclamation + arabic, "اضافة نوع"
Text1.SetFocus
Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
Exit Sub
End If
If T2.RecordCount <> 0 Then T2.MoveFirst
For i = 0 To T2.RecordCount - 1
If T2!Number = Val(txt) Then Exit For
T2.MoveNext
Next i
T2.Edit
T2!Name = Text1.Text
T2.Update
Else
'edit factory ...
SQL = "select * from tb_factory where name='" & Text1.Text & "'"
Set T4 = D1.OpenRecordset(SQL, dbOpenDynaset)
If T4.RecordCount <> 0 Then
MsgBox "يوجد مورد له نفس الاسم ، فضلاً اختر اسماً آخر", vbExclamation + arabic, "اضافة مورد"
Text1.SetFocus
Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
Exit Sub
End If
If T3.RecordCount <> 0 Then T3.MoveFirst
For i = 0 To T3.RecordCount - 1
If T3!Number = Val(txt) Then Exit For
T3.MoveNext
Next i
T3.Edit
T3!Name = Text1.Text
T3.Update
End If
Refresh_Me
Text1.Text = ""والآن سنعود لاستئناف عملية الحذف .
كنا قد توقفنا عند استخلاص رقم العنصر المحدد ، والآن سننتقل إليه سواء كان مورداً أم نوعاً ، لكننا لن نقوم بحذفه ، بل سوف نجعل View = False
وأخيراً سوف نتأكد من وجود بضائع تحته وإلا فإننا نحذفه نهائياً .
مبدئياً لا بد من تحذيره قبل عملية الحذف :
وبذلك يصبح الكود الكامل بهذه الطريقة :
وهذا هو ملف البرنامج حتى هذه اللحظة ...
والله الموفق ...
والسلام عليكم ورحمة الله وبركاته .
مبدئياً لا بد من تحذيره قبل عملية الحذف :
كود :
Dim sure
sure = MsgBox("هل أنت متأكد أنك تريد القيام بعملية البحث هذه ؟", vbExclamation + vbYesNo + arabic, "تأكيد الحذف !")
If sure = vbNo Then Exit Subكود :
If List1.ListIndex = -1 Then
MsgBox "عليك اختيار عنصر من القائمة أولاً", vbExclamation + arabic, "حذف"
Exit Sub
End If
Dim sure
sure = MsgBox("هل أنت متأكد أنك تريد القيام بعملية الحذف هذه ؟", vbExclamation + vbYesNo + arabic, "تأكيد الحذف !")
If sure = vbNo Then Exit Sub
Dim txt
Dim i
i = 1
Do While (Mid(List1.Text, i, 1)) <> "-"
txt = txt & Mid(List1.Text, i, 1)
i = i + 1
Loop
If lbl_name.Caption = "معلومات الأنواع" Then
'delete category ...
If T2.RecordCount <> 0 Then T2.MoveFirst
For i = 0 To T2.RecordCount - 1
If T2!Number = Val(txt) Then Exit For
T2.MoveNext
Next i
T2.Edit
T2!View = False
T2.Update
SQL = "select count(*) as mycount from tb_product where category=" & Val(txt) & ""
Set T4 = D1.OpenRecordset(SQL, dbOpenDynaset)
If T4!mycount = 0 Then T2.Delete
T4.Close
Else
'delete factory ...
If T3.RecordCount <> 0 Then T3.MoveFirst
For i = 0 To T3.RecordCount - 1
If T3!Number = Val(txt) Then Exit For
T3.MoveNext
Next i
T3.Edit
T3!View = False
T3.Update
SQL = "select count(*) as mycount from tb_product where factory=" & Val(txt) & ""
Set T4 = D1.OpenRecordset(SQL, dbOpenDynaset)
If T4!mycount = 0 Then T3.Delete
T4.Close
End If
Refresh_Me
Text1.Text = ""وهذا هو ملف البرنامج حتى هذه اللحظة ...
والله الموفق ...
والسلام عليكم ورحمة الله وبركاته .