Jumat, 15 Februari 2013

Ok yang pertama adalah kode program PENJUMLAHAN


PENJUMLAHAN
Private Sub Label2_Click()

End Sub

Private Sub CmdKeluar_Click()
End
End Sub

Private Sub CmdTambah_Click()
Dim a, b, c As Byte
a = Val(TxtA.Text)
b = Val(TxtB.Text)
c = a + b
TxtC.Text = Str(c)
End Sub

ketikkan kode program seperti gambar diatas yaaa...

lalu jalankan program dengan menekan tombol F5 pada Keyboard
 
Mengubah nama form dengan command button
Private Sub Cmddouble_Click()
Form1.Caption = "Jl.Iskandar Muda"
End Sub
 
 Pengurangan

Private Sub Label2_Click()
End Sub
Private Sub CmdKeluar_Click()
End
End Sub
Private Sub CmdTambah_Click()
Dim a, b, c As Byte
a = Val(TxtA.Text)
b = Val(TxtB.Text)
c = a + b
TxtC.Text = Str(c)
End Sub
 
 
Latihan Membuat Kalkulator
Private Sub Command1_Click()
Dim a, b, c As Double
a = Val(Text1.Text)
b = Val(Text2.Text)
c = a + b
Text3.Text = Str(c)
End Sub

Private Sub Command3_Click()
Dim a, b, c As Double
a = Val(Text1.Text)
b = Val(Text2.Text)
c = a - b
Text3.Text = Str(c)
End Sub

Private Sub Command4_Click()
Dim a, b, c As Double
a = Val(Text1.Text)
b = Val(Text2.Text)
c = a \ b
Text3.Text = Str(c)
End Sub

Private Sub Command5_Click()
Dim a, b, c As Double
a = Val(Text1.Text)
b = Val(Text2.Text)
c = a * b
Text3.Text = Str(c)
End Sub

Private Sub Command6_Click()
Dim a, b, c As Double
a = Val(Text1.Text)
b = Val(Text2.Text)
c = a ^ b
Text3.Text = Str(c)
End Sub

Private Sub Command7_Click()
End
End Sub

Private Sub Command8_Click()

End Sub
 
Belajar Tentang Variabel
Private Sub Label2_Click()

End Sub

Private Sub CmdKeluar_Click()
End
End Sub

Private Sub CmdTambah_Click()
Dim a, b, c As Byte
a = Val(TxtA.Text)
b = Val(TxtB.Text)
c = a + b
TxtC.Text = Str(c)
End Sub
 
Membuat Grafik
Dim r As Single

Private Sub Form_Load()
r = 100
End Sub

Private Sub Form_Paint()
Circle (1500, 1500), 1500
Circle (2500, 3500), 1500
Circle (3500, 1500), 1500
Circle (4500, 3500), 1500
Circle (5500, 1500), 1500
Circle (10000, 1500), 1000
Circle (10000, 3500), 1000
Circle (12000, 1500), 1000
Circle (12000, 3500), 1000
Circle (11000, 2500), 1000
End Sub

Private Sub pct1_paint()
pct1.Line (0, 0)-(3000, 3000)
pct1.Line (-10, 10)-(3000, 3000)
End Sub

Private Sub Timer1_Timer()
pct1.Circle (pct1.ScaleWidth / 2, pct1.ScaleHeight / 2), r
r = r + 50
If r > 1000 Then
r = 100
pct1.Cls
End If
End Sub

Private Sub Timer2_Timer()
pct1.Top = pct1.Top + 50
If pct1.Top > FrmGrafik.Height Then
pct1.Top = -pct1.Height
End If
End Sub

Private Sub Timer3_Timer()
pct1.Left = pct1.Left + 50
If pct1.Left > FrmGrafik.Height Then
pct1.Left = -pct1.Height
End If
End Sub
Belajar Membuat Print tulisan di FORM

Private Sub Cmddouble_Click()
Form1.Caption = "Jl.Iskandar Muda"
End Sub

Private Sub Form_Load()

End Sub

MEMBUAT GAME
Private Sub CmdAtas_Click()
Timer1.Enabled = True
CmdAtas.Enabled = False
CmdKiri.Enabled = True


End Sub

Private Sub CmdBawah_Click()
PctGambar.Top = PctGambar.Top + 30
End Sub

Private Sub CmdKanan_Click()
PctGambar.Left = PctGambar.Left + 30
End Sub

Private Sub CmdKiri_Click()
Timer1.Enabled = False
CmdAtas.Enabled = True
CmdKiri.Enabled = False
Timer2.Enabled = True


End Sub


Private Sub Form_Load()

End Sub

Private Sub Timer1_Timer()
PctGambar.Top = PctGambar.Top - 30
End Sub

Private Sub Timer2_Timer()
PctGambar.Left = PctGambar.Left - 50
End Sub


MEMBUAT PENENTUAN BEASISWA


Private Sub Label2_Click()

End Sub

Private Sub Cmdbeasiswa_Click()
Dim ip As Single
ip = Val(TxtIP.Text)
TxtKet.Text = "Tidak Dapat Beasiswa"
If (ip > 3) Then
TxtKet.Text = "Dapat Beasiswa"
End If
End Sub


Private Sub Cmdexit_Click()
End
End Sub

Private Sub TxtIP_Change()
Dim ip As Single
ip = Val(TxtIP.Text)
If (ip > 3) Then
TxtKet.Text = "Dapat Beasiswa"
End If
End Sub


MEMBUAT ZODIAK
Dim tanggal As Date
Dim tglLhr, blnLhr  As Integer
Dim panggil As String

Private Sub cmdbersih_Click()
Text1.Text = " "
lblZodiak.Caption = " "
End Sub

Private Sub cmdEnter_Click()
    tanggal = Me.DTPicker1.Value
    tglLhr = Day(tanggal)
    blnLhr = Month(tanggal)
   
    If (tglLhr >= 22 And blnLhr = 12) Or (tglLhr <= 20 And blnLhr = 1) Then
        zodiak = "Capricorn"
    ElseIf (tglLhr >= 21 And blnLhr = 1) Or (tglLhr <= 19 And blnLhr = 2) Then
        zodiak = "Aquarius"
    ElseIf (tglLhr >= 20 And blnLhr = 2) Or (tglLhr <= 20 And blnLhr = 3) Then
        zodiak = "Pisces"
    ElseIf (tglLhr >= 21 And blnLhr = 3) Or (tglLhr <= 19 And blnLhr = 4) Then
        zodiak = "Aries"
    ElseIf (tglLhr >= 20 And blnLhr = 4) Or (tglLhr <= 20 And blnLhr = 5) Then
        zodiak = "Taurus"
    ElseIf (tglLhr >= 21 And blnLhr = 5) Or (tglLhr <= 21 And blnLhr = 6) Then
        zodiak = "Gemini"
    ElseIf (tglLhr >= 22 And blnLhr = 6) Or (tglLhr <= 22 And blnLhr = 7) Then
        zodiak = "Cancer"
    ElseIf (tglLhr >= 23 And blnLhr = 7) Or (tglLhr <= 23 And blnLhr = 8) Then
        zodiak = "Leo"
    ElseIf (tglLhr >= 24 And blnLhr = 8) Or (tglLhr <= 22 And blnLhr = 9) Then
        zodiak = "Virgo"
    ElseIf (tglLhr >= 23 And blnLhr = 9) Or (tglLhr <= 23 And blnLhr = 10) Then
        zodiak = "Libra"
    ElseIf (tglLhr >= 24 And blnLhr = 10) Or (tglLhr <= 22 And blnLhr = 11) Then
        zodiak = "Scorpio"
    ElseIf (tglLhr >= 23 And blnLhr = 11) Or (tglLhr <= 21 And blnLhr = 12) Then
        zodiak = "Sagitarius"
    End If
    Me.lblZodiak.Caption = zodiak
   
End Sub

Private Sub Cmdkeluar_Click()
MsgBox ("Yakin anda ingin keluar? Jika anda yakin, tekan OK")
MsgBox (" OK la kalo begitu...")
End
End Sub

13 komentar:

  1. Sipz bsa d'coba nanti/.... hee

    BalasHapus
  2. wah lumayan lengkap nih. cocok untuk saya yang masih belajar bahasa pemograman visual basic . thanks mbak

    BalasHapus
  3. pleas cek http://mempeljarivisualbasic.blogspot.co.id
    for more information of visual basic 6.0

    BalasHapus
  4. ka, itu kan ada beberapa kodingan untuk membuat suatu aplikasi. itu masukin kodingannya dimna yh? soalnya saya baru belajar masukan kodingan di form dn di button. saya masih newbee.

    BalasHapus
  5. Terimakasih, informasi dan referensi nya sangat bermanfaat. Semoga sukses selalu
    My blog

    BalasHapus
  6. sangat bermanfaat sekali semoga dapat saya pelajari
    My blog

    BalasHapus
  7. setuju


    http://blog.binadarma.ac.id/ilmanzuhriyadi/

    BalasHapus
  8. thx blog referensi yang baik
    kunjungi juga blog saya

    BalasHapus
  9. Wah lumayan lengkap nih kak, bisa untuk dijadikan referensi . Terimakasih ya.
    Kunjungi jga blog saya di
    www.ayuyusnita.blogspot.com
    Dan
    Www.atmaluhur.ac.id

    BalasHapus
  10. JTG-BK. CASINO - JeMHub
    JTG-BK. 김포 출장안마 CASINO. 청주 출장샵 44715 JTG-BK. (888) 385-5946. jTG-BK. 광양 출장마사지 (888) 401-6000. CASINO. 44715 JTG-BK. (888) 401-6000. CASINO. 경상북도 출장마사지 44715 JTG-BK. (888) 성남 출장안마 401-6000.

    BalasHapus