[internetadami]

Oyun için gerekli olan nesneler
3 command button,4 maskeditbox,2 label,1 listbox(labeller yerine değişken de kullanabilirsiniz)
isteyenler oyunun orjinal şeklini
[Üye Özel | Für Mitglieder | For Members]
adresinden indirebilir.
SAYI BULMA OYUNU
Const OLE_ACTIVATE = 7
Dim i As Variant
Dim j As Integer
Dim check As Boolean
Dim a As Variant
Dim değer As Variant
Dim b(1 To 4) As Variant
Dim sonuç As Integer
Dim giriş As Variant
Dim rastgelesayı(1 To 4) As Integer
Dim girilensayı(1 To 4) As Variant
Dim dizi1(1 To 4) As Variant
Dim dizi2(1 To 6) As Variant
Dim dizi3(1 To 4) As Variant
Dim dizi4(1 To 24) As Variant
Dim dizi5(1 To 36) As Variant
Dim dizi6(1 To 8) As Variant
Dim dizi7(1 To 12) As Variant
Dim dizi8(1 To 6) As Variant
Dim dizi9(1 To 12) As Variant
Dim dizi10(1 To 42) As Variant
Dim dizi11(1 To 44) As Variant
Dim dizi12(1 To 7) As Variant
Dim dizi15(1 To 207) As Variant
Private Sub Command1_Click()
t(0).SetFocus
'Kullanıcı tarafından girilen sayıları diziye aktaralım
For i = 1 To 4
girilensayı(i) = t(i - 1)
Next i
'Listbox'ta kullanıcının girdiği değerleri görmesi için
'giriş değişkenine aktaralım
giriş = t(0) & t(1) & t(2) & t(3)
'kutulara girilen karakterlerin boş ve alfanimerik olmamasını sağlayalım
For i = 1 To 4
b(i) = InStr(1, l, girilensayı(i))
Next i
'karşılaştırmada kullanacağımız sonuçları değer değişkenine aktaralım
l1 = b(1) & b(2) & b(3) & b(4)
değer = Val(l1)
'Karşılaştırmaları yapalım
For i = 0 To 3
If değer = dizi1(4)(i) Then
sonuç = 1
Exit For
End If
Next i
For i = 0 To 5
If değer = dizi2(6)(i) Then
sonuç = 2
Exit For
End If
Next i
For i = 0 To 3
If değer = dizi3(4)(i) Then
sonuç = 3
Exit For
End If
Next i
For i = 0 To 23
If değer = dizi4(24)(i) Then
sonuç = 4
Exit For
End If
Next i
For i = 0 To 35
If değer = dizi5(36)(i) Then
sonuç = 5
Exit For
End If
Next i
For i = 0 To 7
If değer = dizi6(8)(i) Then
sonuç = 6
Exit For
End If
Next i
For i = 0 To 11
If değer = dizi7(12)(i) Then
sonuç = 7
Exit For
End If
Next i
For i = 0 To 5
If değer = dizi8(6)(i) Then
sonuç = 8
Exit For
End If
Next i
For i = 0 To 11
If değer = dizi9(12)(i) Then
sonuç = 9
Exit For
End If
Next i
For i = 0 To 41
If değer = dizi10(42)(i) Then
sonuç = 10
Exit For
End If
Next i
For i = 0 To 43
If değer = dizi11(44)(i) Then
sonuç = 11
Exit For
End If
Next i
For i = 0 To 6
If değer = dizi12(7)(i) Then
sonuç = 12
Exit For
End If
Next i
If değer = 1234 Then
sonuç = 13
l.Visible = True
End If
If değer = 0 Then
sonuç = 14
End If
'Girilen sayının boş karakter olmamasını sağlayalım
For i = 0 To 3
If Not IsNumeric(t(i)) Then
yanlışgiriş
Exit For
End If
Next i
'Aynı sayıların tekrar girilmemesini sağlayalım
If t(0) = t(1) Or t(0) = t(2) Or t(0) = t(3) Or t(1) = t(2) Or t(1) = t(3) Or t(2) = t(3) Then yanlışgiriş2
'sonuçları listbox'a yazdıralım
Select Case sonuç
Case 1: OLE5.Action = OLE_ACTIVATE
lbx.AddItem giriş + " +3"
Case 2: OLE5.Action = OLE_ACTIVATE
lbx.AddItem giriş + " +2"
Case 3: OLE5.Action = OLE_ACTIVATE
lbx.AddItem giriş + " +1"
Case 4: OLE5.Action = OLE_ACTIVATE
lbx.AddItem giriş + " +1 -1"
Case 5: OLE5.Action = OLE_ACTIVATE
lbx.AddItem giriş + " +1 -2"
Case 6: OLE5.Action = OLE_ACTIVATE
lbx.AddItem giriş + " +1 -3"
Case 7: OLE5.Action = OLE_ACTIVATE
lbx.AddItem giriş + " +2 -1"
Case 8: OLE5.Action = OLE_ACTIVATE
lbx.AddItem giriş + " +2 -2"
Case 9: OLE5.Action = OLE_ACTIVATE
lbx.AddItem giriş + " -1"
Case 10: OLE5.Action = OLE_ACTIVATE
lbx.AddItem giriş + " -2"
Case 11: OLE5.Action = OLE_ACTIVATE
lbx.AddItem giriş + " -3"
Case 12: OLE5.Action = OLE_ACTIVATE
lbx.AddItem giriş + " -4"
Case 13: OLE2.Action = OLE_ACTIVATE
lbx.AddItem giriş + " TEBRİKLER"
l.Visible = True
Case 14: OLE3.Action = OLE_ACTIVATE
lbx.AddItem giriş + " Hiçbiri Yok"
End Select

End Sub
'Yanlış giriş için altyordam
Private Sub yanlışgiriş()
OLE4.Action = OLE_ACTIVATE
MsgBox "Kutuları Boş bırakamaz ve sadece rakam girebilirsiniz.!!! "
sonuç = 0

End Sub
'Yanlış giriş için altyordam
Private Sub yanlışgiriş2()
OLE4.Action = OLE_ACTIVATE
MsgBox "Aynı rakamı iki kere giremezsiniz!!! "
sonuç = 0

End Sub

Private Sub Command2_Click()
'Çıkış için seçenek tanıyalım
seçim = MsgBox("Çıkmak istediğinizden emin misiniz?", 20, "Sayı Bulma Oyunu")
If seçim = 6 Then
OLE6.Action = OLE_ACTIVATE
MsgBox "Program hakkındaki düşünce ve önerilerinizi [Üye Özel | Für Mitglieder | For Members] adresine mail atarsanız sevinirim."
End
Else
Form1.Refresh
End If
End Sub
'Yeniden oynamak için seçenek
Private Sub Command3_Click()
seçim = MsgBox("Yeniden başlamak istediğinizden emin misiniz?", 20, "Sayı Bulma Oyunu")
If seçim = 6 Then
sayıüret
Else
Form1.Refresh
End If
End Sub
'Yeniden oynamak için alt yordam
Private Sub sayıüret()
Randomize
l = ""
lbx.Clear
rastgelesayı(1) = Int(Rnd * 10)
For i = 2 To 4
Do
rastgelesayı(i) = Int(Rnd * 10)
check = True
For j = 1 To i - 1
If rastgelesayı(i) = rastgelesayı(j) Then
check = False
Exit For
End If
Next j
Loop Until check
Next i
'Rastgele üretilen sayıyı karşılaştırma yapabilmek için string'e çevirelim
've oyun sonunda göstermek için l label'ine atalım
For i = 1 To 4
l = l & rastgelesayı(i)
Next i
l = CStr(l)
l.Visible = False
End Sub
Private Sub Form_Load()
Randomize
OLE1.Action = OLE_ACTIVATE
OLE7.Action = OLE_ACTIVATE
'Aşağıdaki tanımlanan diziler matamatiksel olarak manuel 'hesaplanmıştır. 4 basamaklı 2 variant değerin karşılaş
'tırılması sonucu albileceği değerlerdir.
dizi1(4) = Array(1230, 1204, 1034, 234)
dizi2(6) = Array(1200, 1030, 1004, 230, 204, 34)
dizi3(4) = Array(1000, 200, 30, 4)
dizi4(24) = Array(1400, 1040, 1020, 1002, 1300, 1003, 3200, 203, 4200, 240, 210, 201, 31, 130, 2030, 32, 4030, 430, 14, 104, 2004, 24, 3004, 304)
dizi5(36) = Array(132, 213, 243, 324, 432, 314, 431, 124, 241, 1023, 2031, 3024, 4032, 1043, 3014, 4031, 1042, 2014, 1302, 3201, 2304, 4203, 1403, 3104, 1402, 2104, 4201, 1320, 2130, 3210, 2430, 3240, 1340, 4130, 1420, 4210)
dizi6(8) = Array(1423, 1342, 4213, 3241, 2431, 4132, 2314, 3124)
dizi7(12) = Array(1203, 1240, 1032, 1430, 1024, 1304, 4230, 231, 3204, 214, 2034, 134)
dizi8(6) = Array(1243, 1432, 1324, 4231, 3214, 2134)
dizi9(12) = Array(100, 10, 1, 2000, 20, 2, 3000, 300, 3, 4000, 400, 40)
dizi10(42) = Array(4300, 4003, 4020, 4002, 4100, 4010, 4001, 3400, 2400, 420, 403, 402, 410, 401, 43, 42, 41, 340, 140, 3040, 2040, 2300, 2003, 2100, 2010, 2001, 21, 120, 3020, 320, 23, 12, 102, 3002, 302, 3100, 3010, 3001, 310, 301, 13, 103)
dizi11(44) = Array(2103, 2301, 2310, 2013, 3120, 3102, 3012, 3021, 123, 312, 321, 4320, 4302, 4023, 2403, 2340, 2043, 3420, 3402, 3042, 423, 342, 4103, 4310, 4301, 4013, 3410, 3401, 3140, 3041, 413, 143, 341, 4120, 4102, 4021, 4012, 2410, 2401, 2140, 2041, 412, 421, 142)
dizi12(7) = Array(4321, 4312, 4123, 3421, 3412, 2143, 2341)
'dizi 15 diğer dizi elemanlarının toplamıdır
dizi15(207) = Array(2103, 2301, 2310, 2013, 3120, 3102, 3012, 3021, 123, 312, 321, 4320, 4302, 4023, 2403, 2340, _
2043, 3420, 3402, 3042, 423, 342, 4103, 4310, 4301, 4013, 3410, 3401, 3140, 3041, 413, 143, 341, 4120, 4102, _
4021, 4012, 2410, 2401, 2140, 2041, 412, 421, 142, 1230, 1204, 1034, 234, 1200, 1030, 1004, 230, 204, 34, 1000, _
200, 30, 4, 1400, 1040, 1020, 1002, 1300, 1003, 3200, 203, 4200, 240, 210, 201, 31, 130, 2030, 32, 4030, 430, _
14, 104, 2004, 24, 3004, 304, 1243, 1432, 1324, 4231, 3214, 2134, 132, 213, 243, 324, 432, 314, 431, 124, 241, _
1023, 2031, 3024, 4032, 1043, 3014, 4031, 1042, 2014, 1302, 3201, 2304, 4203, 1403, 3104, 1402, 2104, 4201, _
1320, 2130, 3210, 2430, 3240, 1340, 4130, 1420, 4210, 1203, 1240, 1032, 1430, 1024, 1304, 4230, 231, 3204, 214, _
2034, 134, 1423, 1342, 4213, 3241, 2431, 4132, 2314, 3124, 100, 10, 1, 2000, 20, 2, 3000, 300, 3, 4000, 400, 40, _
4321, 4312, 4123, 3421, 3412, 2143, 2341, 4300, 4003, 4020, 4002, 4100, 4010, 4001, 3400, 2400, 420, 403, 402, _
410, 401, 43, 42, 41, 340, 140, 3040, 2040, 2300, 2003, 2100, 2010, 2001, 21, 120, 3020, 320, 23, 12, 102, 3002, _
302, 3100, 3010, 3001, 310, 301, 13, 103, 1234, 0)
'rastgele sayı üretelim ve aynı sayının tekrarlanmamsını sağlayalım
rastgelesayı(1) = Int(Rnd * 10)
For i = 2 To 4
Do
rastgelesayı(i) = Int(Rnd * 10)
check = True
For j = 1 To i - 1
If rastgelesayı(i) = rastgelesayı(j) Then
check = False
Exit For
End If
Next j
Loop Until check
Next i
'Rastgele üretilen sayıyı karşılaştırma yapabilmek için string'e çevirelim
've oyun sonunda göstermek için l label'ine atalım
For i = 1 To 4
l = l & rastgelesayı(i)
Next i
l = CStr(l)
End Sub
'kullanıcının t dizisine giriş yapmasını kolaylaştırmak için
'selllenght ve autotab özelliklerini ayarlayalım
Private Sub t_Change(Index As Integer)
For i = 0 To 3
t(i).SelLength = 2
Next i
End Sub