VB Örnek Kodlar

Kodla Büyü

gökalp

Seçkin Üye
Seçkin Üye
Mesajlar
506
Hesap Makinesi:

Dim a As Double
Dim b As Double ' a ve b adında iki double değişken atıyoruz.

Private Sub Command1_Click() ' Command1 adlı düğmeye tıklandığında gerçekleşecek olaylar

Label1.Caption = a & "1"

a = Label1.Caption

If a = 1 Then

Label1.Caption = "1"

End If

End Sub

Private Sub Command2_Click()

Label1.Caption = a & "2"

a = Label1.Caption

If a = 2 Then

Label1.Caption = "2"

End If

End Sub



Private Sub Command3_Click()

Label1.Caption = a & "3"

a = Label1.Caption

If a = 3 Then

Label1.Caption = "3"

End If

End Sub

Private Sub Command4_Click()

Label3.Caption = Val(a) + Val(b)

End Sub

Private Sub Command5_Click()

Label3.Caption = Val(a) * Val(b)

End Sub

Private Sub Command6_Click()

Label2.Caption = b & "1"

b = Label2.Caption

If b = 1 Then

Label2.Caption = "1"

End If

End Sub

Private Sub Command7_Click()

Label2.Caption = b & "2"

b = Label2.Caption

If b = 2 Then

Label2.Caption = "2"

End If

End Sub

Private Sub Command8_Click()

Label2.Caption = b & "3"

b = Label2.Caption

If b = 3 Then

Label2.Caption = "3"

End If

End Sub
 
Araba Yarışı

Araçlar : 1) iki tane Shape ekliyoruz bunlar araba olucak bu Shape adını Shape1 ve Shape2 yapıyoruz.

2) Timer ekliyoruz Left 5280 Top 3120 olarak değiştiriyoruz.

3) Command buton ekliyoruz

Aşağıda vermiş olduğum kodu ekliyoruz bu kadar.



-----------------------------------



Private Sub Command1_Click()

Timer1.Interval = 10

Timer2.Interval = 10



End Sub



Private Sub Form_Load()



End Sub



Private Sub Timer1_Timer()

Randomize

g = Rnd(100) * 100

Shape1.Move Shape1.Left + g

If Shape1.Left >= 8000 Then

MsgBox ("kazanan pembe araba")

End

End If

End Sub



Private Sub Timer2_Timer()

Randomize

f = Rnd(100) * 100

Shape2.Move Shape2.Left + f

If Shape2.Left >= 8000 Then

MsgBox ("kazanan beyaz araba")

End
End If

End Sub
 
Metin şifreleme :

Public Function EncryptSifre(ByVal pswd As String) As String
Dim Metin As String
Dim lg As Integer
Dim i As Integer
Dim j As Integer
Dim Tablo() As Integer
Dim s As Integer
Const MINTAILLE = 16
Const MAXTAILLE = 32
EncryptSifre = ""
pswd = Trim(pswd)

' Şifreyi bulana kadar
' 32 karakter
Metin = ""
While Len(Metin) < MAXTAILLE
Metin = Metin & UCase(pswd) & LCase(pswd)
Wend

ReDim Tablo(MAXTAILLE + 2)


For i = 1 To MAXTAILLE
Tablo(i) = Asc(Mid$(Metin, i, 1))
Next
s = 0
'herşeyi şifrele


For i = 1 To MINTAILLE


For j = i + 1 To i + MINTAILLE


Select Case s
Case 0: Tablo(i) = (Tablo(i) + Tablo(j)) Mod (255 - i)
Case 1: Tablo(i) = (Tablo(i) / Tablo(j)) Mod (255 - i)
Case 2: Tablo(i) = (Tablo(i) * Tablo(j)) Mod (255 - i)
Case 3: Tablo(i) = (Tablo(i) - Tablo(j)) Mod (255 - i)
End Select
s = (s + 1) Mod 4
Next
Next

Metin = ""


For i = 1 To MINTAILLE
EncryptSifre = EncryptSifre & Chr$(Abs(Tablo(i)))
Next
End Function
 
Geri
Üst