Visual Basic Örnekler

Açıklama : “Kullandığım bütün değişkenleri ve ne işe yaradıklarını Yakında V.BASIC anlatımında bulabilirsiniz..
Arkadaslar örneklere geçme önce bu kısmı okursanız iyi olur bu örnekler programlamaya yeni giriş yapanlar için değildir az çok programlama hakkında bilgisi olanlar içindir.Buj örnekler tamamen uygulanmış ve çalışan örneklerdir.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 Sürdürmesi Dileğiyle.!!!!

ÖR:Bu şifre girişi yapılacak bir programdır.Eğer şifre doğru ise Form açı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


ÖR:Girilen sayının çift 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


ÖR:Text1 ‘ e girilen örneğin bir adın bas ve son karekterinin yerlerini değiştiriyor.
Ör : “ MusTaFa “ Sonuc böyle 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


ÖR:Aşağıdaki örnekte girilen bir cümle içindeki aranan karekterden kaç tane olduğunu buluyor ve mesaj penceresi ile haber yeriyor.Bosluk ta dahil!!!.
ÖR: “ 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 Cümle 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


ÖR: Girilen Türk lirası hesabından girilen parayı Ytl ye çeviren 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


ÖR:Windows Hesap makinesı
Örnekteki button ve eklememiz gerekenleri yazacağım.

Acıklama:
“Öncelikle 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 böyle olması siz isterseniz değiştire bilirsiniz.10-13 üncü butonları arasına + , - , * , / ibarelerini butonların caption bölümüne yazın. 14. buton “=” botonu olacak.17. buton “backspace” tusunun yerini alıyor. 18. buton karekök butonudur.”


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


Private Sub Command10_Click()
seç = "+"
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



ÖR:Örneğimizde iki tane list ve 4 tane butonumuz var 1.button list1 den seçilen elemenı list2 ye atıyor. 2. button ise list1 deki bütün elemanları karsıya atıyor. 3.button list2 den seçilen elemenı list1 ye atıyor. 4.button ise list2 deki bütün 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 "Çağrı"
List1.AddItem "Mustafa"
List1.AddItem "Tuğrul"
List1.AddItem "Turabi"
List1.AddItem "Hüseyin"
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



ÖR: 3 tane text ve bir tane butonumuz var.Textlere girilen notların ortalamasını hesaplayan ve sonuc 50 den kucukse kaldı buyukse geçti 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


ÖR: Bu Örneğ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("kaç kişi gireceksiniz")
For I = 1 To d
a(I) = InputBox("adı-soyadını gir")
b(I) = InputBox("Öğ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






ÖR: 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





ÖR: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ı büyütün"
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




ÖR:Bir stok programıdır.Kullanıcı Stok çeşidini seçer adedini seçer 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ı şeçince 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ı ürünü " + 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ı ürünü " + 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ı ürünü " + 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ı ürünü " + Text4.Text + " Liraya Aldınız "
End If

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

End Sub


ÖRosyalama İle Kayıt Ekleme ve Listeleme
Şimdi Örneğimiz için Yeni bir Form açın ve 1 tane buton(command1) ve bir tanede list(List1) ekleyin bundan sonra kodlarınızı yazın

Açıklama
“ Aşşağıdakı ornekte Dosyalama ile yapılmıştır program çalış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 görülmüş olacak ama liste kutusunda gözükmeyecek nedeni ise listeleme işleminin formun başlangıcında giriş bölümünden sonra listeleme yapılması “

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

Private Sub Command1_Click()
Düzelt = InputBox("Düzeltilecek 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 Düzelt <> 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


ÖR:Aşağıdaki Örnekte Rastgele erişimli dosyalarda kayıt ekleme arama , listeleme,silme işlemlerini yapan program.
Programımız için 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



ÖR: 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 seçildikten sonra bunları liste ekleyen ve urunu arayan silen veya özelliklerini 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 Ürünün 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:\Ürün.txt"
End Sub

Private Sub Command5_Click()
düzelt = InputBox("Düzeltilecek Ürünün 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 düzelt <> ug Then
Write #2, un, ua, ug, uf, uade
Else
yn = InputBox("Yeni Ürün 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:\Ürün.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



ÖR : Dosyalama ile bir örnek daha (kayıt ekleme,Değiştirme)

Açıklama :
” Program çalış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İ… !!!