Bır ıslem egzersızı

ODTÜ Matematik Topluluğu - Az Kelime Çok İşlem Yarışması - İşlem Egzersiz Programı


'************************************************* *******************************************
'* ODTÜ Matematik Topluluğu'nda 2005 yılından beri düzenlenen Az Kelime Çok İşlem Yarışması
'* katılımcılarının egzersiz amacıyla kullanmaları için hazırlanmış programın kodlarıdır.
'************************************************* *******************************************
'* Aşağıdaki kontrolleri kendi göz zevkinize göre yerleştirin.
'************************************************* *******************************************
'* lblHedef : Hedef burada gösterilecek; Label
'* lblSayi(0 to 5) : Sayılar burada gösterilecek; Label Array
'* fraZemin : Yukarıdaki kontrolleri barındıracak; Frame
'* cmdTamsonuc : Tamsonuç bulununca basılacak düğme; CommandButton
'* tmrSayilar : Sayıları sırayla ve efektli seçmek için kullanılır; Timer
'* tmrSayac : Çözüm için geri sayım yapar; Timer
'* fraKomut : Aşağıdaki kontrolleri barındıracak; Frame
'* sliSure : Süre burada belirlenecek ve gösterilecek; Slider
'* cmdYeni : Yeni soru üretecek düğme; CommandButton
'* cmdKapat : Programdan çıkmak için basılacak düğme; CommandButton
'************************************************* *******************************************
'* Hazırlayan : Selçuk Soner Akgül - 23.KASIM.2007
'************************************************* *******************************************

Kod:

Option Explicit

Dim hedef As Integer 'Ulaşmamız gereken 3 basamaklı sayı
Dim sayilar(0 To 5) As Integer 'Hedefe ulaşmak için kullanacağımız sayılar
Dim sayac As Integer 'Sayılara dönme efekti vermek için kullanılan değişken
Dim limit As Integer 'Çözüm süresi olarak belirleyeceğimiz değişken
Dim siradaki As Integer 'Gösterilecek sayının sırasını belirleyen değişken
Dim buyuk(0 To 7) As Integer 'Hedefe ulaşmak için kullanacağımız büyük sayıların dizisi

Private Function Rastgele(ByVal EnAz As Integer, ByVal EnCok As Integer, Optional Haric As Integer = 0) As Integer
'Rastgele sayı seçme fonksiyonu
Dim sectim As Integer
Do
sectim = Int(Rnd * 10 ^ 6) Mod (EnCok - EnAz + 1) + EnAz
Loop While sectim = Haric
Rastgele = sectim
End Function

Private Sub Buyukler()
'Büyük sayıların değerleri burada belirleniyor
'Dilerseniz diziyi genişletip başka sayılar da ekleyebilirsiniz
Dim i As Integer
'40 ile 90 arası 10'un katları
'Küçük değişikliklerle 10 ile 100 arası bile yapılabilir
For i = 1 To 6
buyuk(i) = 10 * (i + 3)
Next
'25 ve 75
For i = 0 To 7 Step 7
buyuk(i) = 50 * (i / 7) + 25
Next
End Sub

Private Sub cmdKapat_Click()
'Tek kelimelik komut için uzun bir açıklamaya gerek var mı :)
End
End Sub

Private Sub cmdTamSonuc_Click()
'Tamsonuç bulunduğunda yapılacaklar
Dim mesaj As VbMsgBoxResult
Dim stil As VbMsgBoxStyle
'Süreyi durdur
tmrSayac.Enabled = False
stil = vbInformation + vbOKOnly
'Tebrik et ve rapor göster
mesaj = MsgBox("Tebrikler! " & (limit - sliSure.Value) & " saniyede buldun." & vbCrLf & "Şimdi çözümü konuşarak yaptır.", stil, "Tam Sonuç")
'Herşeyi yeniden başlayacak hale getir
If mesaj = vbOK Then
fraKomut.Enabled = True
cmdYeni.SetFocus
sliSure.Value = limit
cmdTamSonuc.Enabled = False
End If
End Sub

Private Sub cmdYeni_Click()
'Herşeyi yeniden başlayacak hale getir
Sifirla
'Efekt hızını buradan değiştirebiliriz
tmrSayilar.Interval = 150
tmrSayilar.Enabled = True
End Sub

Private Sub Form_Load()
Randomize
'Büyük sayıları belirle
Buyukler
'Süre sınırını belirle
limit = sliSure.Max
End Sub

Private Sub Sifirla()
'Herşeyi yeniden başlayacak hale getir
fraKomut.Enabled = False
sayac = 0
Dim i As Integer
'Renk ayarlarını yap
For i = 0 To 5
With lblSayi(i)
.ForeColor = RGB(255, 0, 0)
.Caption = ""
End With
Next
With lblHedef
.ForeColor = RGB(0, 0, 255)
.Caption = ""
End With
'Soru yoksa Tamsonuç da olmaz
cmdTamSonuc.Enabled = False
'Limit değerini eski haline getir
limit = sliSure.Value
End Sub

Private Function HedefSec() As Integer
'Hedefimizi belirleyip sunan fonksiyon
Dim sectim As Integer
Do
sectim = Rastgele(301, 999)
Loop While sectim Mod 50 = 0
HedefSec = sectim
End Function

Private Sub tmrSayac_Timer()
'Geri sayım sayacı
sliSure.Value = sliSure.Value - 1
'Süre bitince yapılacaklar
If sliSure.Value = 0 Then
'Kendini durdur
tmrSayac.Enabled = False
Dim mesaj As VbMsgBoxResult
Dim stil As VbMsgBoxStyle
stil = vbQuestion + vbRetryCancel
'Soruyu gizle
fraZemin.Visible = False
'Uyarı yap ve sor
mesaj = MsgBox("Süre doldu. Yeniden denemek ister misin?", stil, "Süre Doldu!")
sliSure.Value = limit
If mesaj = vbRetry Then
'Tekrar denemek için
tmrSayac.Enabled = True
Else
'Başka soruya geçmek için
Sifirla
fraKomut.Enabled = True
cmdYeni.SetFocus
End If
'Tekrar görünür kıl
fraZemin.Visible = True
End If
End Sub

Private Sub tmrSayilar_Timer()
'Sayıları seçme ve efekt sayacı
'Gerekli ayarlamalar yapılıp hedef en son da gösterilebilir
sayac = sayac + 1
Select Case sayac
Case 1 To 10
'Her defasında farklı bir hedef seç ve göster
hedef = HedefSec
lblHedef.Caption = hedef
If sayac = 10 Then
'Gerçek hedefi gösterince renk değiştir
lblHedef.ForeColor = RGB(255, 0, 0)
End If
Case 11 To 60
'Her defasında farklı bir sayı seç ve göster
siradaki = (sayac - 11) \ 10
sayilar(siradaki) = Rastgele(1, 9)
lblSayi(siradaki).Caption = sayilar(siradaki)
If sayac Mod 10 = 0 Then
'Gerçek sayıyı gösterince renk değiştir
lblSayi(siradaki).ForeColor = RGB(0, 0, 255)
End If
Case 61 To 70
'Her defasında farklı bir büyük sayı seç ve göster
sayilar(5) = buyuk(Rastgele(0, 7))
lblSayi(5).Caption = sayilar(5)
If sayac = 70 Then
'Gerçek büyük sayıyı gösterince renk değiştir
lblSayi(5).ForeColor = RGB(0, 0, 255)
End If
Case Else
'Soru üretilip hepsi gösterilince yapılacaklar
'Kendini durdur
tmrSayilar.Enabled = False
'Sayacı sıfırla
sayac = 0
'Geri sayım sayacını başlat
tmrSayac.Enabled = True
'Tamsonuç butonunu aktif hale geçir
With cmdTamSonuc
.Enabled = True
.SetFocus
End With
End Select
End Sub