Acıklama : “Kullandığım butun değişkenleri ve ne işe yaradıklarını Yakında V.BASIC anlatımında bulabilirsiniz..
Arkadaslar orneklere gecme once bu kısmı okursanız iyi olur bu ornekler programlamaya yeni giriş yapanlar icin değildir az cok programlama hakkında bilgisi olanlar icindir.Buj ornekler tamamen uygulanmış ve calışan orneklerdir.Programların tam kısmı ve yazılımları yakında yine www.Forumtr.com adresinde bulabileceksiniz.Şimdiden herkeze tesekkur ederim ve www.Forumtr.com a her zaman basarılı ama Devamınıda Surdurmesi Dileğiyle.!!!!

OR:Bu şifre girişi yapılacak bir programdır.Eğer şifre doğru ise Form acılacak değilse program duracak.

Private Sub Form_Load()
Dim a As Byte
Form1.Hide
MsgBox "Hos Geldiniz", , "Merhaba"
a = InputBox("Şifreyi girin")
Select Case a
Case a = "mustafa" :show
Case a "mustafa" : End
End Select
End Sub


OR:Girilen sayının cift veya tek olduğunu bulan program.Eğer sayı tekse List1 e değilse List2 ye eklenir.

Dim b As Byte
Dim a As Byte
Private Sub Text1_Click()
a = Text1.Text
b = a Mod 2
If b = 1 Then List1.AddItem a
If b = 0 Then List2.AddItem a
End Sub


OR:Text1 ‘ e girilen orneğin bir adın bas ve son karekterinin yerlerini değiştiriyor.
Or : “ MusTaFa “ Sonuc boyle oluyor “ ausTaFM “

Private Sub mu_Click()
Dim a, e, d, f, l As String
Dim c, k As Byte
a = Text1.Text
c = Len(a)
e = Mid(a, c, 1)
d = Mid(a, 1, 1)
k = c - 1
f = Mid(a, 2, k - 1)
l = e + f + d
Text1.Text = ""
Text1.Text = l
End Sub


OR:Aşağıdaki ornekte girilen bir cumle icindeki aranan karekterden kac tane olduğunu buluyor ve mesaj penceresi ile haber yeriyor.Bosluk ta dahil!!!.
OR: “ Mustafa “ a karekteri sonuc: 2 tane
Dim e As String
Dim b As String
Dim a As String

Private Sub Command1_Click()
End
End Sub

Private Sub Form_Click()
d = 0
a = InputBox("bir Cumle Girin")
b = InputBox("Aranacak Karakteri girin")
c = Len(a)
For I = 1 To c
e = Mid(a, I, 1)
If e = b Then d = d + 1
Next I
MsgBox d
End Sub


OR: Girilen Turk lirası hesabından girilen parayı Ytl ye ceviren program

Private Sub Command1_Click()
Dim I As Integer
Dim a, c, b As Long
a = (Text1.Text / 1000000)
b = (Text1.Text / 100000)
a = Int(a)
b = Text1.Text - (a * 1000000)
b = (b / 10000)
Text2.Text = a
b = Int(b)
Text3.Text = b
Command1.Enabled = False
End Sub
Private Sub Form_Load()
Command1.Enabled = False
Text3.Enabled = False
Text2.Enabled = False
End Sub

Private Sub Text1_Change()
Command1.Enabled = True
End Sub


OR:Windows Hesap makinesı
Ornekteki button ve eklememiz gerekenleri yazacağım.

Acıklama:
“Oncelikle 18 tane buton olusturun. Butonlara birinci butondan baslayarak 1. butona 1. 2. butona 2 yazın… 9 a kadar yazın ve 15.butonada sıfır yazın nedeni ise kodun boyle olması siz isterseniz değiştire bilirsiniz.10-13 uncu butonları arasına + , - , * , / ibarelerini butonların caption bolumune yazın. 14. buton “=” botonu olacak.17. buton “backspace” tusunun yerini alıyor. 18. buton karekok butonudur.”


Dim a As RasterOpConstants
Dim b As RasterOpConstants
Dim c As Byte
Dim sec As String


Private Sub Command10_Click()
sec = "+"
a = val(Text1.Text)
Text1.Text = " "
End Sub

Private Sub Command11_Click()
sec = "-"
a = Text1.Text
Text1.Text = " "
End Sub

Private Sub Command12_Click()
sec = "*"
a = Text1.Text
Text1.Text = " "
End Sub

Private Sub Command13_Click()
sec = "/"
a = Text1.Text
Text1.Text = " "
End Sub

Private Sub Command14_Click()
b = val(Text1.Text)
Text1.Text = " "
If sec = "+" Then Text1.Text = a + b
If sec = "-" Then Text1.Text = a - b
If sec = "*" Then Text1.Text = a * b
If sec = "/" Then Text1.Text = a / b
End Sub

Private Sub Command15_Click()
Text1.Text = Text1.Text + "0"
End Sub

Private Sub Command16_Click()
Text1.Text = " "
a = 0
b = 0
End Sub

Private Sub Command17_Click()
c = Len(Text1.Text)
Text1.Text = Mid(Text1.Text, 1, c - 1)
End Sub

Private Sub Command18_Click()
Text1.Text = Sqr(Text1.Text)
End Sub

Private Sub Command1_Click()
Text1.Text = Text1.Text + "1"
End Sub

Private Sub Command2_Click()
Text1.Text = Text1.Text + "2"
End Sub

Private Sub Command3_Click()
Text1.Text = Text1.Text + "3"
End Sub

Private Sub Command4_Click()
Text1.Text = Text1.Text + "4"
End Sub

Private Sub Command5_Click()
Text1.Text = Text1.Text + "5"
End Sub

Private Sub Command6_Click()
Text1.Text = Text1.Text + "6"
End Sub

Private Sub Command7_Click()
Text1.Text = Text1.Text + "7"
End Sub

Private Sub Command8_Click()
Text1.Text = Text1.Text + "8"
End Sub

Private Sub Command9_Click()
Text1.Text = Text1.Text + "9"
End Sub

Private Sub Form_Load()
Command17.Enabled = False
a = 0
b = 0
Command14.Enabled = False
End Sub

Private Sub Text1_Change()
Command14.Enabled = True
Command17.Enabled = True
End Sub



OR:Orneğimizde iki tane list ve 4 tane butonumuz var 1.button list1 den secilen elemenı list2 ye atıyor. 2. button ise list1 deki butun elemanları karsıya atıyor. 3.button list2 den secilen elemenı list1 ye atıyor. 4.button ise list2 deki butun elemanları karsıya atıyor.

Private Sub Command4_Click()
For I = 0 To List2.ListCount - 1
List2.ListIndex = I
List1.AddItem (List2.Text)
Next I
List2.Clear
Command3.Enabled = False
End Sub

Private Sub Form_Load()
Command1.Enabled = False
Command3.Enabled = False
List1.AddItem "Mustafa"
List1.AddItem "Cağrı"
List1.AddItem "Mustafa"
List1.AddItem "Tuğrul"
List1.AddItem "Turabi"
List1.AddItem "Huseyin"
End Sub

Private Sub Command1_Click()
List2.AddItem (List1.Text)
List1.RemoveItem (List1.ListIndex)
Command1.Enabled = False
End Sub

Private Sub Command2_Click()
For I = 0 To List1.ListCount - 1
List1.ListIndex = I
List2.AddItem (List1.Text)
Next I
List1.Clear
Command1.Enabled = False
End Sub

Private Sub Command3_Click()
List1.AddItem (List2.Text)
List2.RemoveItem (List2.ListIndex)
Command3.Enabled = False
End Sub

Private Sub List1_Click()
Command1.Enabled = True
End Sub
Private Sub List2_Click()
Command3.Enabled = True
End Sub



OR: 3 tane text ve bir tane butonumuz var.Textlere girilen notların ortalamasını hesaplayan ve sonuc 50 den kucukse kaldı buyukse gecti mesajını veren Vb programı

Private Sub Command1_Click()
Dim a As RasterOpConstants
a = Val(Text1.Text) + Val(Text2.Text) + Val(Text3.Text)
a = a / 3
Label4.Caption = a
If a < 50 Then MsgBox " Adamın Canını Sıkma Kaldın İşte Kaybol şurdan Yıh Yıh Yıh", vbOKOnly, " Babandandamı Utanmıyon !!! ? ? ?"
Command1.Enabled = False
End Sub

Private Sub Form_Load()
Command1.Enabled = False
End Sub
Private Sub Text3_Change()
Command1.Enabled = True
End Sub


OR: Bu Orneğimizde kullanıcıdan istediği kardaer bilgi girişi yapması ve bilgi girişi bittikten sonra bunları listeleyen ve kullanıcı tarafından istenen bir no’yu arayan ve textlere yazan program.
1 tane list1 ve 1 tane buton ve tanede text ekleyin.
Dim a(20) As String
Dim b(20) As String
Dim c(20) As String
Dim d As Byte
Dim I As Byte
Private Sub Command1_Click()
d = InputBox("kac kişi gireceksiniz")
For I = 1 To d
a(I) = InputBox("adı-soyadını gir")
b(I) = InputBox("Oğrenci noyu girin")
c(I) = InputBox("tel noyu girin")
List1.AddItem a(I) + " " + b(I) + " " + c(I)
e = e + 1
Next I
End Sub

Private Sub Command2_Click()
For I = 1 To d
If Text4.Text = b(I) Then
Text1.Text = a(I)
Text2.Text = b(I)
Text3.Text = c(I)
End If
Next I
End Sub

Private Sub Form_Load()

End Sub






OR: 5 tane text imiz var ve bu textlere rastgele sayı uretılecek ve bunları textlerede sıralayan program.
5 tane text ekleyin 2 tane buton ekleyin.

Private Sub Command1_Click()
Dim s(5) As Integer
Dim I, j As Integer
Dim gd As Integer
s(1) = Text1.Text
s(2) = Text2.Text
s(3) = Text3.Text
s(4) = Text4.Text
s(5) = Text5.Text
For I = 1 To 5 - 1
For j = I + 1 To 5
If s(I) < s(j) Then
gd = s(I)
s(I) = s(j)
s(j) = gd
Text1.Text = s(1)
Text2.Text = s(2)
Text3.Text = s(3)
Text4.Text = s(4)
Text5.Text = s(5)

End If
Next j
Next I
Command1.Enabled = False
End Sub

Private Sub Command2_Click()
Randomize
Text1.Text = Rnd
Text1.Text = Right(Text1.Text, 2)
Text2.Text = Rnd
Text2.Text = Right(Text2.Text, 2)
Text3.Text = Rnd
Text3.Text = Right(Text3.Text, 2)
Text4.Text = Rnd
Text4.Text = Right(Text4.Text, 2)
Text5.Text = Rnd
Text5.Text = Right(Text5.Text, 2)
Command1.Enabled = True
End Sub

Private Sub Form_Load()
Command1.Enabled = False
End Sub





OR:bu bir Oyundur.

Dim a As String
Dim c As Byte
Private Sub Command1_Click()
c = InputBox("1-20 arasında bir sayi girin")
If c < a Then
List1.AddItem "SAyıyı buyutun"
ElseIf c = a Then
List1.AddItem "bildiniz"
ElseIf c > a Then
List1.AddItem "Sayıyı Kucultun"
End If
End Sub

Private Sub Command2_Click()
Dim I As Byte
Randomize
For I = 1 To 1
a = Rnd(20)
a = Right(a, 2)
Next I
End Sub
Private Sub Command3_Click()
List1.Clear
End Sub

Private Sub Command4_Click()
End
End Sub

Private Sub Form_Load()

End Sub




OR:Bir stok programıdır.Kullanıcı Stok ceşidini secer adedini secer ve KDV veya KDV siz istediğiniz şekilde hesaplar.Yanlızca işlemlerde bi farklılık vardır. KDV Ve KDV siz Option butonları var ve Bunları şecince işlemleri yapacak program.
2 tanede Option Buton ,4 tane text ekleyin text2 miktarı text3 fiyatı text4 te sonucu olacak.

Private Sub Command1_Click()
End
End Sub

Private Sub Form_Load()
Combo1.AddItem "Bilgisayar"
Combo1.AddItem "Gida"
Combo1.AddItem "Giyim"
End Sub

Private Sub Option1_Click()
Dim a, b, c, d, I As RasterOpConstants
If Combo1.Text = "Bilgisayar" Then
a = (Text3.Text / 100) * 18
c = (a + Val(Text3.Text)) * Text2.Text
c = Int(c)
Text4.Text = c
MsgBox Text1.Text + " Adlı urunu " + Text4.Text + " Liraya Aldınız "
End If
If Combo1.Text = "Gida" Then
a = (Text3.Text / 100) * 2
c = (a + Val(Text3.Text)) * Text2.Text
c = Int(c)
Text4.Text = c
MsgBox Text1.Text + " Adlı urunu " + Text4.Text + " Liraya Aldınız "
End If

If Combo1.Text = "Giyim" Then
a = (Text3.Text / 100) * 6
c = (a + Val(Text3.Text)) * Text2.Text
c = Int(c)
Text4.Text = c
MsgBox Text1.Text + " Adlı urunu " + Text4.Text + " Liraya Aldınız "
End If

End Sub

Private Sub Option2_Click()
If Combo1.Text = "Bilgisayar" Then
Text4.Text = Text2.Text * Text3.Text
MsgBox Text1.Text + " Adlı urunu " + Text4.Text + " Liraya Aldınız "
End If

If Combo1.Text = "Gida" Then
Text4.Text = Text2.Text * Text3.Text
MsgBox Text1.Text + " Adlı urunu " + Text4.Text + " Liraya Aldınız "
End If
If Combo1.Text = "Giyim" Then
Text4.Text = Text2.Text * Text3.Text
MsgBox Text1.Text + " Adlı urunu " + Text4.Text + " Liraya Aldınız "
End If

End Sub


ORosyalama İle Kayıt Ekleme ve Listeleme
Şimdi Orneğimiz icin Yeni bir Form acın ve 1 tane buton(command1) ve bir tanede list(List1) ekleyin bundan sonra kodlarınızı yazın

Acıklama
“ Aşşağıdakı ornekte Dosyalama ile yapılmıştır program calıştığında kullanıcıdan ad telefon ve numarası istenecektir ve kullanıcı istediği kadar isim ve tel no gire bilecek.Grişleri yaptıktan sonra Devam edilsinmi mesajına hayır diyince Form ekranı gelecek ve Girilen bilgiler listelenecek.Ve daha sonra Değistir adlı butona basınca istenilen kayıt aranacak bulunca yeni değerler istenecek işlemler bitince yeni değer gorulmuş olacak ama liste kutusunda gozukmeyecek nedeni ise listeleme işleminin formun başlangıcında giriş bolumunden sonra listeleme yapılması “

Dim k As Byte
Dim a, b, c As String

Private Sub Command1_Click()
Duzelt = InputBox("Duzeltilecek Adı girin")
Open "D:mustisoft.dat" For Input As #1
Open "D:yedek.dat" For Output As #2
Do While Not EOF(1)
Input #1, a, b, c
If Duzelt a Then
Write #2, a, b, c
Else
yeniad = InputBox("Yeni aD")
yenisn = InputBox("Yeni no")
yenitn = InputBox("Yeni Telno")
Write #2, yeniad, yenisn, yenitn
End If

End Sub

Private Sub Form_Load()
Open "D:mustisoft.dat" For Append As #1
X:
a = InputBox("Adı Girin")
b = InputBox("numaranı Gir")
c = InputBox("Telefon numaranızı girin")
Write #1, a, b, c
k = MsgBox("Kayita Devam Edilsin mi Edilmesin mi?", vbOKCancel, "Uyari")
If k = 1 Then GoTo X
Close #1
If k = 2 Then
Open "D:mustisoft.dat" For Input As #1
Do While Not EOF(1)
Input #1, a, b, c
If a z Then
List1.AddItem a + " " + b + " " + c
End If
Loop
End If
Close #1
End Sub


OR:Aşağıdaki Ornekte Rastgele erişimli dosyalarda kayıt ekleme arama , listeleme,silme işlemlerini yapan program.
Programımız icin list1.ve 4 tanede buton ekleyin. 1 button kayit ekleme 2. buton listeleme 3.button arama 4.butto silme. Olsun.
Dim kayit As Dosya

Private Sub Command1_Click()
Open "d:mustisoft.txt" For Random As #1 Len = Len(kayit)
kayit.kn = Text1.Text
kayit.ka = Text2.Text
kayit.ya = Text3.Text
kayit.be = Text4.Text
kayit.bt = Text5.Text
kayit.tk = kayit.tk + 1
Put #1, kayit.tk, kayit
Close #1
End Sub

Private Sub Command2_Click()
Dim I As Byte
Open "d:mustisoft.txt" For Random As #1 Len = Len(kayit)
For I = 1 To kayit.tk
Get #1, I, kayit
List1.AddItem kayit.kn + " " + kayit.ka + " " + kayit.ya + " " + kayit.be + " " + kayit.bt
Next I
Close #1
End Sub

Private Sub Command3_Click()
Dim I As Byte
aranan = InputBox("Aranacak Kitabın Adını Girin")
Open "d:mustisoft.txt" For Random As #1 Len = Len(kayit)
For I = 1 To kayit.tk
Get #1, I, kayit
If aranan = Trim(kayit.ka) Then
Text1.Text = kayit.kn
Text2.Text = kayit.ka
Text3.Text = kayit.ya
Text4.Text = kayit.be
Text5.Text = kayit.bt
End If
Next I
Close #1
End Sub

Private Sub Command4_Click()
Dim I As Byte
aranan = InputBox("Silinecek Kitabın Adını Girin")
Open "d:mustisoft.txt" For Random As #1 Len = Len(kayit)
Open "d:yedek.txt" For Random As #2 Len = Len(kayit)
For I = 1 To kayit.tk
Get #1, I, kayit
If Trim(kayit.ka) aranan Then
Put #2, I, kayit
End If
Next I
Close #1
Close #2
Kill "d:mustisoft.txt"
Name "d:yedek.txt" As "D:mustisoft.txt"
End Sub



OR: Bu program yukardaki programın biraz daha gelişmiş halidir ve Dosylama sistemi ile yapılmıştır. Urun adı nosu veya fiyatı gurubu felan secildikten sonra bunları liste ekleyen ve urunu arayan silen veya ozelliklerini değiştiren program. 4 tane text ekleyin. 1 tanede list ekleyin.

Dim un, ua, ug, uf, uade As String
Private Sub Command1_Click()
Open "d:mustafa.dat" For Append As #1
un = Text1.Text
ua = Text2.Text
ug = Combo1.Text
uf = Text3.Text
uade = Text4.Text
Write #1, un, ua, ug, uf, uade
Text1.Text = " "
Text2.Text = " "
Combo1.Text = " "
Text3.Text = " "
Text4.Text = " "
Close #1
End Sub

Private Sub Command2_Click()
List1.Visible = True
List1.Clear
Open "d:mustafa.dat" For Input As #1
Do While Not EOF(1)
Input #1, un, ua, ug, uf, uade
List1.AddItem " " + un
List1.AddItem " " + ua
List1.AddItem " " + ug
List1.AddItem " " + uf
List1.AddItem " " + uade
Loop
Close #1
End Sub

Private Sub Command3_Click()
Dim ara As String
ara = InputBox("Aranacak Urun Grubunu secin...")
Open "D:mustafa.dat" For Input As #1
Do While Not EOF(1)
Input #1, un, ua, ug, uf, uade
If ara = ug Then
Text1.Text = un
Text2.Text = ua
Combo1.Text = ug
Text3.Text = uf
Text4.Text = uade
End If
Loop
Close #1
End Sub

Private Sub Command4_Click()
sil = InputBox("Silinecek Urunun Grubunu Giriniz...")
Open "d:Mustafa.dat" For Input As #1
Open "d:yedek.dat" For Output As #2
Do While Not EOF(1)
Input #1, un, ua, ug, uf, uade
If sil ug Then
Write #2, un, ua, ug, uf, uade
List1.Clear
End If
Loop
Close #1
Close #2
Kill "d:mustafa.dat"
Name "d:Yedek.dat" As "d:Urun.txt"
End Sub

Private Sub Command5_Click()
duzelt = InputBox("Duzeltilecek Urunun Grubunu Giriniz...")
Open "d:mustafa.dat" For Input As #1
Open "d:yedek.dat" For Output As #2
Do While Not EOF(1)
Input #1, un, ua, ug, uf, uade
If duzelt ug Then
Write #2, un, ua, ug, uf, uade
Else
yn = InputBox("Yeni Urun Nosunu Giriniz..")
ya = InputBox("Yeni Adi Giriniz..")
yg = InputBox("Yeni Grubu Giriniz..")
yf = InputBox("Yeni Fiyatı Giriniz..")
yad = InputBox("Yeni Adeti Giriniz..")
Write #2, yn, ya, yg, yf, yad
End If
Loop
Close #1
Close #2
Kill "d:mustafa.dat"
Name "d:Yedek.dat" As "d:Urun.txt"
End Sub

Private Sub Command6_Click()
End
End Sub

Private Sub Form_Load()
Combo1.AddItem "Beyaz Eşya"
Combo1.AddItem "Elektronik Eşya"
Combo1.AddItem "Oturma Grubu"
Combo1.AddItem "Giyecek"
Combo1.AddItem "Gıda"
Combo1.AddItem "Ecza"
List1.Visible = False
End Sub



OR : Dosyalama ile bir ornek daha (kayıt ekleme,Değiştirme)

Acıklama :
” Program calıştırılınca istediğimiz kadar bilgi girişi yapıla bilecek. Bilgi girişi yapıldıktan sonra formda girilen adlardan birini değiştirebilir.ve değiştirme sonunda kayıtlı bilgiler list1de listelenir.”

Dim ya, yn, sil As String

Private Sub Command1_Click()
sil = InputBox("Değişirilecek Adı Girin")
Open "C:mustafa.dat" For Input As #1
Open "C:TLMusTi.dat" For Output As #2
Do While Not EOF(1)
Input #1, ad, nt
If sil ad Then
Write #2, ad, nt
Else
ya = InputBox("Yeni Adı Girin")
yn = InputBox("Yeni noyu Girin")
Write #2, ya, yn
End If
Loop
Close #1
Close #2
Kill "C:mustafa.dat"
Name "C:TLMusTi.dat" As "C:mustafa.dat"
List1.Clear
Open "C:mustafa.dat" For Input As #1
Do While Not EOF(1)
Input #1, ad, nt
sil = " "
If sil ad Then List1.AddItem ad +” “+ nt
Loop
Close #1
End Sub

Private Sub Command2_Click()
End
End Sub

Private Sub Form_Load()
Dim b As Byte
Dim a As Byte
Open "C:mustafa.dat" For Append As #1
X:
ad = InputBox("Adınızı Girin ?")
nt = InputBox("Telefon Adresini Girin")
Write #1, ad, nt
List1.AddItem ad + nt
b = MsgBox("Devam Etmek İstiYo musunuz!", vbOKCancel, "Dikkat")
IF b=1 then Goto X
Close #1
End Sub

Arkadaslar kusura bakmayın yazdığım programlardan bulabildiklerim bu kadar ama devamı da var herkeze kolay gelsin.!!!!!!!!!

The BİTTİ… !!!
__________________