VİSUAL BASİC DOWNLOAD BÖLÜMÜ

VİSUAL BASİC İNDİR



HAZIR VİSUAL BASİCC KODLARI İNDİR

Visual Basic 6.0 ile yapilan bazi programlarin Windows isletim sisteminde çalismasi için bazi dosyalara ihtiyaci vardir. Bu program iste bu programlarin çalismasi için gerekli olan dosyalari içerir.
İNDİRMEK İÇİN TIKLA


İNDİR

visual basicc video anlatım

visual basicc oyun yapımı



animasyon

Visual Basicte Basit bir Telefon Programı visual basicc

Numara kaydedebilen telefon programı

'Bu Program bekir demir tarafından genel amaçlı olarak yazılıp kopyalanması ve dağıtılması yasak degildir
Option Explicit

DefInt A-Z

Dim CancelFlag

Private Sub CancelButton_Click()
CancelFlag = True
CancelButton.Enabled = False
End Sub

Private Sub Dial(N$)
Dim DialString$, FromModem$, dummy

DialString$ = "ATDT" + N$ + ";" + vbCr

' Bağlantı Port ayarları
MSComm1.CommPort = 3
MSComm1.Settings = "9600,N,8,1"

' Bağlantı portunu aç
On Error Resume Next
MSComm1.PortOpen = True
If Err Then
Exit Sub
End If

MSComm1.InBufferCount = 0

'Numarayı çevir
MSComm1.Output = DialString$

' modeme geri dönmek için tamamı bekle
Do
dummy = DoEvents()
If MSComm1.InBufferCount Then
FromModem$ = FromModem$ + MSComm1.Input
' Tamam'ı Kontrol et
If InStr(FromModem$, "OK") Then
'Kullanıcı telefonu kaldırırsa
Beep
MsgBox "Lütfen Ahizeyi Kaldırıp ENTER a Basın"
Exit Do
End If
End If

' Kullanıcı iptali seçerse
If CancelFlag Then
CancelFlag = False
Exit Do
End If
Loop

' Modemle bağlantıyı kes
MSComm1.Output = "ATH" + vbCr

' Portu kapat
MSComm1.PortOpen = False
End Sub

Private Sub Command1_Click(Index As Integer)
Durum.Text = Durum.Text + Command1(Index).Caption
End Sub

Private Sub Command2_Click()
Text1.Visible = False
Text2.Visible = False
Command2.Visible = False
End Sub

Private Sub Command3_Click()
Durum.Text = Num.Caption
Command4.Visible = True
End Sub

Private Sub Command4_Click()
Data1.Refresh
Command4.Visible = False
Command3.Visible = True

End Sub

Private Sub Data1_Validate(Action As Integer, Save As Integer)
On Error Resume Next
End Sub

Private Sub DialButton_Click()
Dim N$, T$

DialButton.Enabled = False
QuitButton.Enabled = False
CancelButton.Enabled = True
' Çevirmek için gerekli numara
N$ = Durum.Text

T$ = Durum
Durum = "Çevriliyor - " + N$

' Çevrilecek Telefon Numarasını Seç
Dial N$

DialButton.Enabled = True
QuitButton.Enabled = True
CancelButton.Enabled = False

Durum = T$
End Sub

Private Sub Form_Load()
MSComm1.InputLen = 0

End Sub

Private Sub Kay_Click()
Data1.Recordset.AddNew
Text2.Visible = True
Command2.Visible = True
Text1.Visible = True
End Sub

Private Sub Label1_DblClick()
Data1.Refresh
End Sub

Private Sub Label4_Click()

End Sub

Private Sub QuitButton_Click()
End
End Sub

Private Sub Sil_Click()
On Error Resume Next

şekilli pencere visual basicc

Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Long) As Long

Private Sub Form_Load()
Dim hr&, dl&
Dim usew&, useh&
usew& = Me.Width / Screen.TwipsPerPixelX
useh& = Me.Height / Screen.TwipsPerPixelY
' Olusturuluyor...
hr& = CreateEllipticRgn(-150, -210, usew, useh) 'Bu sayilari degistirerek pencere ile oynayabilirsiniz..
' Gosteriliyor...
dl& = SetWindowRgn(Me.hWnd, hr, True)
End Sub

sayıyı yazıya çeviren program visual basicc

Sayın Bülent Yenilmez sayıyı yazıya çeviren bir fonksiyon yollamış, kendisine teşekkür ediyorum. Ayrıca sorununada şöyle bir ipucu vereyim ingilizcede 11 ve 19 arası sayıların sesletimleri türkçede olduğu gibi 1 'on' ve 'bir' kelimelerinin birleşmeleri ile meydana gelmez. yani 11 için 'eleven' kelimesi ingilizce 10 'ten' ve 1 'one' kelimelerinden oluşmaz. Bu durumda bu sayılar için fonksiyon içinde özel bir bölüm gerekiyor.
Tüm kod aşağıdadır


'Bu fonksiyon cok güzel bir şekilde çalışıyor. Dileyen arkadaşlar kullanabilir.
'Bir isteğim olacak. Bu fonksiyondan yola çıkarak aynı şekilde ingilizcesini yazdırmak istediğimde
'11 den 19 a kadar olan sayılarda "eleven" yerine "tenone" çıkıyor. Bu sorunu çözebilen olursa
'lütfen bana haber versin... Şimdiden Teşekkürler.

Dim b$(9)
Dim y$(9)
Dim m$(4)
Dim v(15)
Dim c(3)
Private Sub Form_Load()
Text1.Text = Yaziyla$(15000)
End Sub

Function Yaziyla$(sayi)

b$(0) = ""
b$(1) = "Bir"
b$(2) = "İki"
b$(3) = "Üç"
b$(4) = "Dört"
b$(5) = "Beş"
b$(6) = "Altı"
b$(7) = "Yedi"
b$(8) = "Sekiz"
b$(9) = "Dokuz"

y$(0) = ""
y$(1) = "On"
y$(2) = "Yirmi"
y$(3) = "Otuz"
y$(4) = "Kırk"
y$(5) = "Elli"
y$(6) = "Altmış"
y$(7) = "Yetmiş"
y$(8) = "Seksen"
y$(9) = "Doksan"

m$(0) = "Trilyon"
m$(1) = "Milyar"
m$(2) = "Milyon"
m$(3) = "Bin"
m$(4) = ""

a$ = Str(sayi)
If Left$(a$, 1) = " " Then pozitif = 1 Else pozitif = 0
a$ = Right$(a$, Len(a$) - 1)
For x = 1 To Len(a$)
If (Asc(Mid$(a$, x, 1)) > Asc("9")) Or (Asc(Mid$(a$, x, 1)) < Asc("0")) Then GoTo hata
Next x
If Len(a$) > 15 Then GoTo hata
a$ = String(15 - Len(a$), "0") + a$
For x = 1 To 15
v(x) = Val(Mid$(a$, x, 1))
Next x

s$ = ""
For x = 0 To 4
c(1) = v((x * 3) + 1)
c(2) = v((x * 3) + 2)
c(3) = v((x * 3) + 3)
If c(1) = 0 Then
e$ = ""
ElseIf c(1) = 1 Then
e$ = "Yüz"
Else
e$ = b$(c(1)) + "Yüz"
End If
e$ = e$ + y$(c(2)) + b$(c(3))
If e$ <> "" Then e$ = e$ + m$(x)
If (x = 3) And (e$ = "BirBin") Then e$ = "Bin"
s$ = s$ + e$
Next x

If s$ = "" Then s$ = "Sıfır"
If pozitif = 0 Then s$ = "Eksi" + s$
Yaziyla$ = s$
GoTo tamam
hata: Yaziyla$ = "Hata"
tamam:
End Function

Sayısal Loto visual basicc kodu sayısal loto programı

Sayısal Loto
--------------------------------------------------------------------------------
Güzel bir numara sallama örneği; önce üç tane commmand buton koy sonra 6 Text box ve kodu kopyala


Private Sub Command1_Click()
Dim NumberList(5) As Integer
' Numaraların her zaman farklı olması için bunu yazıyoruz
Randomize Timer
Text1.Text = Int(Rnd * 49) + 1
Text2.Text = Int(Rnd * 49) + 1
Text3.Text = Int(Rnd * 49) + 1
Text4.Text = Int(Rnd * 49) + 1
Text5.Text = Int(Rnd * 49) + 1
Text6.Text = Int(Rnd * 49) + 1
'Sallanan numaraların aynı olma ihtimali çok yüksektir bundan dolyı bu kodları ekliyoruz
If Text1.Text = Text2.Text Or Text1.Text = Text3.Text Or Text1.Text = Text4.Text Or Text1.Text = Text5.Text Or Text1.Text = Text6.Text Then
Text1.Text = Int(Rnd * 49) + 1
End If
If Text2.Text = Text1.Text Or Text2.Text = Text3.Text Or Text2.Text = Text4.Text Or Text2.Text = Text5.Text Or Text2.Text = Text6.Text Then
Text2.Text = Int(Rnd * 49) + 1
End If
If Text3.Text = Text1.Text Or Text3.Text = Text2.Text Or Text3.Text = Text4.Text Or Text3.Text = Text5.Text Or Text3.Text = Text6.Text Then
Text3.Text = Int(Rnd * 49) + 1
End If
If Text4.Text = Text1.Text Or Text4.Text = Text2.Text Or Text4.Text = Text3.Text Or Text4.Text = Text5.Text Or Text4.Text = Text6.Text Then
Text4.Text = Int(Rnd * 49) + 1
End If
If Text5.Text = Text1.Text Or Text5.Text = Text2.Text Or Text5.Text = Text3.Text Or Text5.Text = Text4.Text Or Text5.Text = Text6.Text Then
Text5.Text = Int(Rnd * 49) + 1
End If
If Text6.Text = Text1.Text Or Text6.Text = Text2.Text Or Text6.Text = Text3.Text Or Text6.Text = Text4.Text Or Text6.Text = Text5.Text Then
Text6.Text = Int(Rnd * 49) + 1
End If
'Bu kodlar text boxlardaki değerlerin küçükten büyüğe sıralanmasını sağlar
NumberList(0) = CInt(Text1.Text)
NumberList(1) = CInt(Text2.Text)
NumberList(2) = CInt(Text3.Text)
NumberList(3) = CInt(Text4.Text)
NumberList(4) = CInt(Text5.Text)
NumberList(5) = CInt(Text6.Text)
For j = 0 To 5
For i = 0 To 4
If NumberList(i) > NumberList(i + 1) Then
temp = NumberList(i)
NumberList(i) = NumberList(i + 1)
NumberList(i + 1) = temp
End If
Next i
Next j
Text1.Text = NumberList(0)
Text2.Text = NumberList(1)
Text3.Text = NumberList(2)
Text4.Text = NumberList(3)
Text5.Text = NumberList(4)
Text6.Text = NumberList(5)
End Sub

Private Sub Command2_Click()
mesaj = MsgBox("Bu Program Şükrü Sanioğlu tarafından yapılmıştır (C). 2003-2004 | SS-Yazılım |", 10, "Sayısal Loto 6/49 Programı Hakkında")
End Sub

Private Sub Command3_Click()
End
End Sub

ram ölçer visual basicc kod

Bir adet Timer ekleyin forma kopyalayın..

Private Type MEMORYSTATUS
dwLength As Long
dwMemoryLoad As Long
dwTotalPhys As Long
dwAvailPhys As Long
dwTotalPageFile As Long
dwAvailPageFile As Long
dwTotalVirtual As Long
dwAvailVirtual As Long
End Type
Private Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As MEMORYSTATUS)

Private Sub Form_load()
Timer1.Interval = 1000
End Sub

Private Sub Timer1_Timer()
Cls
Dim m As MEMORYSTATUS
GlobalMemoryStatus m
Print "Bellek Kullanımı %:", m.dwMemoryLoad
Print "Toplam RAM:", , m.dwTotalPhys / 1024 / 1024 & " MB"
Print "Boş RAM:", , m.dwAvailPhys / 1024 / 1024 & "MB"
End Sub