شرح كامل كيفية عمل لعبة الأفلام بالفيجوال بيسك

سلام عليكم و رحمة الله ة و بركاته
هذا درس سأشرح فيه ان شاء الله لعبة الأفلام هي كالآتي
شرح اللعبة :1-يقوم المستخم بادخال اسم الفيلم باسخدام Inputbox
2-يظهر للمستخدم الفورم و به Labels تحوي علامة "?" و يكون عدد الLabels بنفس عدد حروف الفيلم
3-يقوم البرنامج بوضع علامة "-" بدلا من علامة "?" عند وجود مسافة
4-يقوم المستخدم بالضغط على أحد الحروف اذا كان الحرف فعلاً أحد حروف
الفيلم يقوم البرنامج باستبدال العلامة "?" بالحرف الصحيح الذي ضغط عله
المستخدم
5-يوجد للمستخدم 3 محاولات اذا انتهت ينتهي البرنامج و ت ظهر رسال باسم الفيلم
6-اذا نجح يظهر للمستخدم رسالة تهنئه بنجاحه و تخبره باسم الفيلم


لنبدأ:

بسم الله الرحمن الرحيم

قم بفتح البرنامج و اختر مشروع جديد Standard EXE

قم بضبط خصائص الفورم كالآتي
Caption:لعبة الأفلام
Backcolor:&H0080C0FF&
Borderstyle:Fixed Single

يجب أن يكون شكله كالآتي



قم بوضع Label جديد
قم بضبط الخصائص الآتية
Name:lblName
Caption : ?
Visible : False
Back Color:&H80000006&

قم بعمل نسخة منها
سيخبرك البرنامج بوجود أداة بتفس الاسم و انه يريد عمل مصفوفة
قم بالضغط Yes
قم بعمل 18 نسخة أخرى ليصبح عندك 20 Label

يجب أن يكون شكل الفورم كالآتي


قم بعمل Label جديدة
و اضبط الخصائص التالية
Caption : عدد المحاولات المتبقية
Right to Left:True
Alignment :Right

قم بعمل Label أخرى
و اضبط الخصائص التالية
Name:lblTrys
Caption : 3
Right to Left:True
Alignment :Center
Borderstyle :Fixed Single

و هذا هو شكل الفورم النهائي


و الآن انتهينا من مرحاة تصميم الفورم و سنبدأ في مرحلة الكود و هو طبعاً اساس العبة
1-قم بفتح نافذة الأكود و قم بتعريف هذا المتغير في قسم لتصريحات General Decleration

كود:

Dim Inputval
Dim Trys As Integer
Dim Truea
Dim Sp
Dim M

ثم اكتب الكود التالي في الكائن Form حدث Load


كود:

'To Return Again
start:
'Entering Movie Name
Inputval = InputBox("أدخل اسم الفيم", "اسم الفيلم")
'Case No Name
If Len(Inputval) = 0 Then
MsgBox "يجب أن تدخل اسم الفيلم", vbCritical, "خطأ"
GoTo start
End If
'Case Long Name
If Len(Inputval) > 20 Then
MsgBox "يجب ألا يتعدى اسم الفيلم عشرون حرفا", vbCritical, "خطأ"
GoTo start
End If
Inputval = Trim(Inputval)
'Label Showing
For i = 0 To Len(Inputval) - 1
lblName(i).Visible = True
Next i

و هذا شرح لأجزاء الكود
ملحوظة الجمل التي تبدأ بالعلامة ' هي فقط تعليقات و لا يوجد أي وظيقة لهل

الجزء الأول:

كود:

start:

Inputval = InputBox("أدخل اسم الفيم", "اسم الفيلم")

الجملة start: سنقوم بشرحها في الجزء القادم ان شاء الله
الجملة التالية: نقوم باستخدام الدالة Inputbox التي تسخدم لاظهار رسالة تطلب من المستخدم ادخال اسم الفيلم بعنوان اسم الفيلم

الجزء الثاني:


كود:

If Len(Inputval) = 0 Then
MsgBox "يجب أن تدخل اسم الفيلم", vbCritical, "خطأ"
GoTo start
End If

نقوم باستخدام الجملة الشرطية If لنعرف ما اذا كان عدد القيمة
المدخلة باستخدام الدالة Len التي تقيس أحرف التعبير فاذا وجد البرنامج
عدد أحرف البرنامج 0 أي لم يقم المستخدم بادخال اي نص تظهر رسالة خطأ
باستخدام الدالة Msgbox لعدم وجود نص
في السطر الذي يليه يقوم البرنامج بالعودة الى القسم start الذي تحدثنا عنه في الجزء السابق العادة بدأ البرناج

الجزء الثالث:


كود:

If Len(Inputval) > 20 Then
MsgBox "يجب ألا يتعدى اسم الفيلم عشرون حرفا", vbCritical, "خطأ"
GoTo start
End If

نقوم باستخدام الجملة الشرطية If لنعرف ما اذا كان عدد القيمة
المدخلة باستخدام الدالة Len فاذا وجد البرنامج عدد أحرف البرنامج 20 تظهر
رسالة خطأ باستخدام الدالة Msgbox لتجاوز عدد الحروف 20 حرفا الذي لن
يمكنا من عرض الفيلم في الLabels
في السطر الذي يليه يقوم البرنامج بالعودة الى القسم مرة أخرى العادة بدأ البرناج من جديد

اما السطر الذي يليه

كود:

Inputval = Trim(Inputval)

هو فقط لحذف المسافات في أول و أخر اسم الفيم
هكذا نكون انتهينا من أول قسم
الآن أضف الكود التالي اسفل الكود السابف في نفس الحدث

كود:

'Label Showing
For i = 0 To Len(Inputval) - 1
lblName(i).Visible = True
Next i

و هنا النستخدم الحلقة التكرارية loop بعدد أحرف النص المدخل و قد
قمنا بطرح رقم 1 من حجم النص المدخل لان الحلقة تبدأ بصفر بين حجم النص
يبدأ بـ1
باستخدام الحلقة التكرارية ن قوم باظهار عددا من الLabel يساوي عدد حروف النص المدخل

الآن نحن نريد استبدال علامة الاستفهام ب العلامة "-" عند وجود مسافة لفصل كلمات الفيلم

لذا سنضيف الكود التالي


كود:

'Exchanging Spaces with -
For l = 0 To Len(Inputval) - 1
If Mid(Inputval, l + 1, 1) = Chr(32) Then lblName(l).Caption = "-"
Sp = Sp + 1
Next l

و قد استخدمنا الحلقة التكرارية مرة أخرى لاختبار كل حرف في النص فاذا كان مسافة يقوم باستبدال قيمة الlblName الذي يوازيه ب "-"
و الوظيقة Mid تقوم بقص جزء من النص ثم نقوم باختبار ما اذا كان مسافة و رمز المسافة هو 32 و نستخدم الدالة chr للدلالة على انه حرف
اما الجزء الخاث بالمتغير Sp فنستفاد منه لاحقاً

و الآن قم بكتاابة الكود التالي في الكئن فورم لكن هذه المرو حذث Keypress


كود:

If KeyAscii = 32 Then Exit Sub
M = 0
For x = 0 To Len(Inputval) - 1
If Asc(Mid(Inputval, x + 1, 1)) = KeyAscii Then
lblName(x).Caption = Mid(Inputval, x + 1, 1)
Truea = Truea + 1
M = 1
End If
Next x
If Not M = 1 Then
Trys = Trys + 1
lblTrys.Caption = Val(lblTrys.Caption) - 1
If Trys = 3 Then
MsgBox "للأسف لمم تمكن من معرفة اسم الفيلم" & Chr(13) & "اسم الفيلم هو " & Inputval, , "لقد خسرت"
End
End If
If Truea = Len(Inputval) - Sp Then
MsgBox "أحسنت لقد تمكن من معرفة اسم الفيلم" & Chr(13) & "اسم الفيلم هو " & Inputval, , "مبروك"
End
End If
End Sub

شرح الكود
أولاً يجب أن تعرف أننا سنستخد الصطلح Keyascii لتحديد الزر الذي ضغط عليه المستخد
و في أول سطر

كود:

If KeyAscii = 32 Then Exit Sub

يقوم البرنامج بالخروج من الكود اذا كان رمز الحرف هو 32 أي رمز المسافة لاننا لا نريد اللعبة ان تحتسب المسافة
أما السطر
كود:

M=0

فهو خاص بحذف قيمة المتغير لاننا سنحتاجه لاحقاً

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

كود:

For x = 0 To Len(Inputval) - 1
If Asc(Mid(Inputval, x + 1, 1)) = KeyAscii Then
lblName(x).Caption = Mid(Inputval, x + 1, 1)
Truea = Truea + 1
M = 1
End If
Next x

و قد استخدمنا الحلقة التكرارية مرة أخرى لاختبار الحرف المدخل مع
كل حروف الفيلم فانكان يطابقه يقوم بوضعه في lblName ثم يضيف 1 للمتغير
Truea كما يقوم باسناد القيمة 1 للمتغير M للدلالة على أن الحرف صحيح و
ستعرف لماذا

اما الجزء الأخير من الكود

كود:

If Not M = 1 Then
Trys = Trys + 1
lblTrys.Caption = Val(lblTrys.Caption) - 1
If Trys = 3 Then
MsgBox "للأسف لمم تمكن من معرفة اسم الفيلم" & Chr(13) & "اسم الفيلم هو " & Inputval, , "لقد خسرت"
End
End If
If Truea = Len(Inputval) - Sp Then
MsgBox "أحسنت لقد تمكن من معرفة اسم الفيلم" & Chr(13) & "اسم الفيلم هو " & Inputval, , "مبروك"
End
End If

قينقسم لثلاث أجزاء
الجزء الأول عند ادخال رقم خاطئ و هذا ما نستنتجه من المتغير فانه يقوم بزيادة عدد المتغير Trys أي زيادة عدد المحاولات الفاشلة
ثم يقوم بطرح قيمة 1 من الـlblTrys


كود:

If Not M = 1 Then
Trys = Trys + 1
lblTrys.Caption = Val(lblTrys.Caption) - 1

الجزء الثاني

كود:

If Trys = 3 Then
MsgBox "للأسف لمم تمكن من معرفة اسم الفيلم" & Chr(13) & "اسم الفيلم هو " & Inputval, , "لقد خسرت"
End
End If

يقوم البرنامج باختبار عدد المحاولات الفاشلة فان وصلت الى ثلات محاولات تظهر رسالة للمستخدم تفيد بنفاذ المحاولات ثم ينتهي البرنامج

الجزء الثالث
If Truea = Len(Inputval) - Sp Then
MsgBox "أحسنت لقد تمكن من معرفة اسم الفيلم" & Chr(13) & "اسم الفيلم هو " & Inputval, , "مبروك"
End
End If

يقوم البرنامج باختبار عدد الحروف الصحيحة المخزن في المتغير Truea مع عدد
حوف الفيلم بعد طرح المسافات التي عرفنا عددها عن طريق المتغير Sp فان
تساوو فهذا يدل على نجاحه في معرفة اسم الفيلم فتظهر رسالة تهنئة ثم ينتهي
البرنامج

وهذا هو كود البرنامج كاملاً بعد كل التعديلات

كود:

Dim Inputval
Dim Trys As Integer
Dim Truea
Dim Sp
Dim M

Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = 32 Then Exit Sub
M = 0
For x = 0 To Len(Inputval) - 1
If Asc(Mid(Inputval, x + 1, 1)) = KeyAscii Then
lblName(x).Caption = Mid(Inputval, x + 1, 1)
Truea = Truea + 1
M = 1
End If
Next x
If Not M = 1 Then
Trys = Trys + 1
lblTrys.Caption = Val(lblTrys.Caption) - 1
If Trys = 3 Then
MsgBox "للأسف لمم تمكن من معرفة اسم الفيلم" & Chr(13) & "اسم الفيلم هو " & Inputval, , "لقد خسرت"
End
End If
If Truea = Len(Inputval) - Sp Then
MsgBox "أحسنت لقد تمكن من معرفة اسم الفيلم" & Chr(13) & "اسم الفيلم هو " & Inputval, , "مبروك"
End
End If
End Sub

Private Sub Form_Load()
'To Return Again
start:
'Entering Movie Name
Inputval = InputBox("أدخل اسم الفيم", "اسم الفيلم")
'Case No Name
If Len(Inputval) = 0 Then
MsgBox "يجب أن تدخل اسم الفيلم", vbCritical, "خطأ"
GoTo start
End If
'Case Long Name
If Len(Inputval) > 20 Then
MsgBox "يجب ألا يتعدى اسم الفيلم عشرون حرفا", vbCritical, "خطأ"
GoTo start
End If
Inputval = Trim(Inputval)
'Label Showing
For i = 0 To Len(Inputval) - 1
lblName(i).Visible = True
Next i
'Exchanging Spaces with -
For l = 0 To Len(Inputval) - 1
If Mid(Inputval, l + 1, 1) = Chr(32) Then
lblName(l).Caption = "-"
Sp = Sp + 1
End If
Next l
End Sub

الآن يوجد مشكلة في الكود الأول
و يجب تعديل الكود الى الشكل التالي


كود:

Dim Inputval
Dim Trys As Integer
Dim Truea
Dim Sp
Dim M
Dim C()

Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = 32 Then Exit Sub
For i = 0 To Len(Inputval) - 1
If C(i) = KeyAscii Then Exit Sub
Next i
M = 0
For x = 0 To Len(Inputval) - 1
If Asc(Mid(Inputval, x + 1, 1)) = KeyAscii Then
lblName(x).Caption = Mid(Inputval, x + 1, 1)
Truea = Truea + 1
M = 1
C(x) = KeyAscii
End If
Next x
If Not M = 1 Then
Trys = Trys + 1
lblTrys.Caption = Val(lblTrys.Caption) - 1
End If
If Trys = 3 Then
MsgBox "للأسف لمم تمكن من معرفة اسم الفيلم" & Chr(13) & "اسم الفيلم هو " & Inputval, , "لقد خسرت"
End
End If
If Truea = Len(Inputval) - Sp Then
MsgBox "أحسنت لقد تمكن من معرفة اسم الفيلم" & Chr(13) & "اسم الفيلم هو " & Inputval, , "مبروك"
End
End If
End Sub

Private Sub Form_Load()
'To Return Again
start:
'Entering Movie Name
Inputval = InputBox("أدخل اسم الفيم", "اسم الفيلم")
'Case No Name
If Len(Inputval) = 0 Then
MsgBox "يجب أن تدخل اسم الفيلم", vbCritical, "خطأ"
GoTo start
End If
'Case Long Name
If Len(Inputval) > 20 Then
MsgBox "يجب ألا يتعدى اسم الفيلم عشرون حرفا", vbCritical, "خطأ"
GoTo start
End If
Inputval = Trim(Inputval)
'Label Showing
For i = 0 To Len(Inputval) - 1
lblName(i).Visible = True
Next i
'Exchanging Spaces with -
For l = 0 To Len(Inputval) - 1
If Mid(Inputval, l + 1, 1) = Chr(32) Then
lblName(l).Caption = "-"
Sp = Sp + 1
End If
Next l
ReDim C(Len(Inputval))
End Sub

المشلكة في الكود الأول هو أنه عندما يضغط المستخدم على حرف صحيح عدة مرات فانه يحتسبه مرة أخرى في عدد المحاولات لذا فعلنا الآتي
1-قمنا باعلان عن مصفوفة جديد باسم C بلا Index

كود:

Dim C()

ثم قمنا باعادة الاعلان عنها بعد أن أدخل المستخدم اسم الفيلم ليصبح الIndex الخاص بالمصفوفة يساوى عدد حروف الفيلم

كود:

Redim C(Len(Inputval))

ثم في الحدث Keypress أضفنا شيئان
الأول : عند الضغط على مفتاح صحيح يقوم البرنامج بوضع الرمز الخاص به في المصفوفة

كود:

C(x) = KeyAscii

الثاني: يقوم البرنامج باختبار رمز المفتاح الذي تم الضغط عليه مع جميع عناصر المصفوفة فاذا تطابق مع أحد العناصر فانه يخرج من الكود

كود:

For i = 0 To Len(Inputval) - 1
If C(i) = KeyAscii Then Exit Sub
Next i


اتمنى ان يكون الشرح واضح و انا جاهز لاي استفسارات

لتحميل المشروع بعد التعديلا اضغط على السيرفر الذي تريده و انا انصح ب9q9q فهو اسهلهم

Download Project from Rapidshare

Download Project From Megaupload

Download Project From Bluehost.to

Download Project From 9q9q

و هذه قائم بالأزرار ورموزها في الفيجوال بيسك 6.0 و دوت نت لمن يحتاجها


Download From Rapidshare

Download From Megaupload

Download From Bluehost.to

Download From 9q9

مشاركة مهمة جداً شكر خاص للعضو اسيهي على هذه المشاركة


اقتباس:

المشاركة الأصلية كتبت بواسطة آسيهي اخي طالب _ العلم بعد اذنك اني قمت باضافة كود للهذه اللعبة اي انها عندما يتم انهاء المحاولات يسألك البرنامج اذا تريد ان تلعب مرة اخرى ام لا واذا نجحت في كتابة الاسم بصورة صحيحة فارجو ان ترى الكود و تقول رأيك فيه اللعية هنـــــــــــــــــــــــــــــا

Public Const EWX_LOGOFF = 0
Public Const EWX_SHUTDOWN = 1
Public Const EWX_REBOOT = 2
Public Const EWX_FORCE = 4
Public Const EWX_POWEROFF = 8


#If Win32 Then
Public Declare Function ShutdownWindows Lib "user32" Alias
"ExitWindowsEx" (ByVal uFlags As Long, ByVal dwReserved As Long) As
Long
#Else
Public Declare Function ShutdownWindows Lib "UseR" Alias "ExitWindows"
(ByVal wReturnCode As Integer, ByVal dwReserved As Integer) As Integer
#End If

Const SE_PRIVILEGE_ENABLED = &H2
Const TokenPrivileges = 3
Const TOKEN_ASSIGN_PRIMARY = &H1
Const TOKEN_DUPLICATE = &H2
Const TOKEN_IMPERSONATE = &H4
Const TOKEN_QUERY = &H8
Const TOKEN_QUERY_SOURCE = &H10
Const TOKEN_ADJUST_PRIVILEGES = &H20
Const TOKEN_ADJUST_GROUPS = &H40
Const TOKEN_ADJUST_DEFAULT = &H80
Const SE_SHUTDOWN_NAME = "SeShutdownPrivilege"
Const ANYSIZE_ARRAY = 1
Private Type LARGE_INTEGER
LowPart As Long
HighPart As Long
End Type
Private Type LUID
LowPart As Long
HighPart As Long
End Type
Private Type LUID_AND_ATTRIBUTES
'pLuid As Luid
pLuid As LARGE_INTEGER
Attributes As Long
End Type
Private Type TOKEN_PRIVILEGES
PrivilegeCount As Long
Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES
End Type
Private Declare Function InitiateSystemShutdown Lib "advapi32.dll"
Alias "InitiateSystemShutdownA" (ByVal lpMachineName As String, ByVal
lpMessage As String, ByVal dwTimeout As Long, ByVal bForceAppsClosed As
Long, ByVal bRebootAfterShutdown As Long) As Long
Private Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal
ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As
Long) As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias
"LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As
String, lpLuid As LARGE_INTEGER) As Long
Private Declare Function AdjustTokenPrivileges Lib "advapi32.dll"
(ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long,
NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState
As TOKEN_PRIVILEGES, ReturnLength As Long) As Long
Private Declare Function GetComputerName Lib "kernel32" Alias
"GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetLastError Lib "kernel32" () As Long

Public Function InitiateShutdownMachine(ByVal Machine As String,
Optional force As Variant, Optional restart As Variant, Optional
AllowLocalShutdown As Variant, Optional Delay As Variant, Optional
message As Variant) As Boolean
On Error Resume Next
Dim hProc As Long
Dim OldTokenStuff As TOKEN_PRIVILEGES
Dim OldTokenStuffLen As Long
Dim NewTokenStuff As TOKEN_PRIVILEGES
Dim NewTokenStuffLen As Long
Dim pSize As Long
If IsMissing(force) Then force = False
If IsMissing(restart) Then restart = True
If IsMissing(AllowLocalShutdown) Then AllowLocalShutdown = False
If IsMissing(Delay) Then Delay = 0
If IsMissing(message) Then message = ""

If InStr(Machine, "\\") = 1 Then
Machine = Right(Machine, Len(Machine) - 2)
End If

If (LCase(GetMyMachineName) = LCase(Machine)) Then

If AllowLocalShutdown = False Then Exit Function

If OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, hProc) = 0 Then
MsgBox "OpenProcessToken Error: " & GetLastError()
Exit Function
End If

If LookupPrivilegeValue(vbNullString, SE_SHUTDOWN_NAME, OldTokenStuff.Privileges(0).pLuid) = 0 Then
MsgBox "LookupPrivilegeValue Error: " & GetLastError()
Exit Function
End If
NewTokenStuff = OldTokenStuff
NewTokenStuff.PrivilegeCount = 1
NewTokenStuff.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED
NewTokenStuffLen = Len(NewTokenStuff)
pSize = Len(NewTokenStuff)

If AdjustTokenPrivileges(hProc, False, NewTokenStuff, NewTokenStuffLen, OldTokenStuff, OldTokenStuffLen) = 0 Then
MsgBox "AdjustTokenPrivileges Error: " & GetLastError()
Exit Function
End If

If InitiateSystemShutdown("\\" & Machine, message, Delay, force, restart) = 0 Then
Exit Function
End If
NewTokenStuff.Privileges(0).Attributes = 0
If AdjustTokenPrivileges(hProc, False, NewTokenStuff, Len(NewTokenStuff), OldTokenStuff, Len(OldTokenStuff)) = 0 Then
Exit Function
End If
Else

If InitiateSystemShutdown("\\" & Machine, message, Delay, force, restart) = 0 Then
Exit Function
End If
End If
InitiateShutdownMachine = True
End Function
Function GetMyMachineName() As String
On Error Resume Next
Dim sLen As Long
GetMyMachineName = Space(100)
sLen = 100

If GetComputerName(GetMyMachineName, sLen) Then
GetMyMachineName = Left(GetMyMachineName, sLen)
End If
End Function

Function REBOOT()
InitiateShutdownMachine GetMyMachineName, 0, True, EWX_REBOOT
End Function

Function POWEROFF()
InitiateShutdownMachine GetMyMachineName, 0, 0, EWX_POWEROFF
End Function