Kamis, 09 Mei 2013

Latihan 12 Visual Basic - Demo Event Keyboard

Latihan 12 Visual Basic - Demo Event Keyboard


'Deklarasi variabel global
Dim xpos As Single, ypos As Single

Private Sub Form_Load()
    'Pindahkan posisi roket ke tengah form
    xpos = (Me.ScaleWidth - picRoket.Width) / 2
    ypos = (Me.ScaleHeight - picRoket.Height) / 2
    picRoket.Move xpos, ypos
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    'MsgBox "Kode tombol yang ditekan : " & KeyCode
   
    'Cek tombol keyboard yang ditekan
    Select Case KeyCode
    Case vbKeyLeft  'Tombol panah kiri
        If Shift = vbCtrlMask Then
            Call RoketKeSisiKiri
        Else
            Call RoketKeKiri
        End If
    Case vbKeyRight 'Tombol panah kanan
        If Shift = vbCtrlMask Then
            Call RoketKeSisiKanan
        Else
            Call RoketKeKanan
        End If
    End Select
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    'MsgBox "Kode tombol yang dilepas : " & KeyCode
   
    'Cek tombol keyboard yang dilepas
    Select Case KeyCode
    Case vbKeyUp    'Tombol panah atas
        Call RoketKeAtas
    Case vbKeyDown  'Tombol panah bawah
        Call RoketKeBawah
    End Select
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    'MsgBox "Kode ASCII tombol yang ditekan : " & KeyAscii
   
    'Cek tombol keyboard yang ditekan
    If KeyAscii = vbKeyEscape Then  'Tombol Escape
        If MsgBox("Tutup program ?", vbQuestion + vbYesNo, _
                  Me.Caption) = vbYes Then Unload Me
    End If
End Sub

Private Sub RoketKeKiri()
    xpos = xpos - 10    'Geser ke kiri 10 pixel
    If xpos < 0 Then
        xpos = 0        'Cek bila melewati batas kiri
    End If
    picRoket.Move xpos  'Pindahkan posisi roket
End Sub

Private Sub RoketKeKanan()
    xpos = xpos + 10                                'Geser ke kanan 10 pixel
    If xpos > Me.ScaleWidth - picRoket.Width Then   'Cek bila melewati batas kanan
        xpos = Me.ScaleWidth - picRoket.Width
    End If
    picRoket.Move xpos                              'Pindahkan posisi roket
End Sub

Private Sub RoketKeAtas()
    ypos = ypos - 10            'Geser ke atas 10 pixel
    If ypos < 0 Then            'Cek bila melewati batas atas
        ypos = 0
    End If
    picRoket.Move xpos, ypos    'Pindahkan posisi roket
End Sub

Private Sub RoketKeBawah()
    ypos = ypos + 10                                 'Geser ke bawah 10 pixel
    If ypos > Me.ScaleHeight - picRoket.Height Then  'Cek bila melewati batas bawah
        ypos = Me.ScaleHeight - picRoket.Height
    End If
    picRoket.Move xpos, ypos                         'Pindahkan posisi roket
End Sub

Private Sub RoketKeSisiKiri()
    xpos = 0                    'Geser ke sisi kiri
    picRoket.Move xpos, ypos    'Pindahkan posisi roket
End Sub

Private Sub RoketKeSisiKanan()
    xpos = Me.ScaleWidth - picRoket.Width   'Geser ke sisi kanan
    picRoket.Move xpos, ypos                'Pindahkan posisi roket
End Sub

Latihan 11 Visual Basic - Procedure Test

Latihan 11 Visual Basic - Procedure Test


 Dim Harga As Currency, Total As Currency

Private Sub TulisTeks(teks As String, Optional warna As ColorConstants = vbMagenta)
    With Label1
        .Caption = teks
        .ForeColor = warna
    End With
End Sub

Private Function JumlahAngka() As String
    Dim angka1 As String, angka2 As String
    Dim hasil As Single
   
    angka1 = InputBox("Tulis angka 1 :", "Hitung Angka")
    angka2 = InputBox("Tulis angka 2 :", "Hitung Angka")
   
    If angka1 <> "" And angka2 <> "" Then
        hasil = CSng(angka1) + CSng(angka2)
        JumlahAngka = CStr(hasil)
    End If
End Function

Private Sub HitungDiskon(ByVal HargaAwal As Currency, Diskon As Single)
    HargaAwal = HargaAwal * (1 - Diskon)
    Total = CCur(HargaAwal)
End Sub


Private Sub Label1_DblClick()
    Call TulisTeks("Hai", vbBlue)
End Sub

Private Sub Command1_Click()
    'Call TulisTeks("Hallo", vbRed)
    Call TulisTeks("Hallo")
End Sub

Private Sub Command2_Click()
    Label1.Caption = "Jumlah = " & JumlahAngka()
End Sub

Private Sub Command3_Click()
    Harga = 10000
    Total = 0
    Call HitungDiskon(Harga, 0.1)
    MsgBox "Harga " & Harga & " setelah diskon 10% menjadi " & Total
End Sub



Latihan 10 Visual Basic - Error Handle

Latihan 10 Visual Basic - Error Handle


Private Sub Command1_Click()

    Dim FileName As String
    Dim ErrMsg As String
    Dim Ask As VbMsgBoxResult
 
    On Error GoTo AdaError

Awal:
    Image1.Picture = Nothing
    FileName = InputBox("Ketikkan path dan nama file gambar :", "Open Picture File", FileName)
    If FileName <> "" Then
        Image1.Picture = LoadPicture(FileName)
    End If
    Exit Sub
 
AdaError:
    Select Case Err.Number
    Case 53
        ErrMsg = "File [" & FileName & "] tidak ada !"
    Case 71
        ErrMsg = "Disket belum dimasukkan !"
    Case Else
        ErrMsg = Err.Description
    End Select
 
    Ask = MsgBox(ErrMsg, vbCritical + vbRetryCancel, Me.Caption)
 
    Select Case Ask
    Case vbRetry
        If Err.Number = 53 Then Resume Awal Else Resume
    Case vbCancel
        Resume Next
    End Select
End Sub

Latihan 9 Visual Basic - Aplikasi Kalkulator

Latihan 9 Visual Basic  - Aplikasi Kalkulator


Dim angka(1 To 2) As Single

Dim operator As String

Private Sub cmdAngka_Click(Index As Integer)
    Text1.Text = Text1.Text & cmdAngka(Index).Caption
End Sub

Private Sub cmdHapus_Click()
    Text1.Text = ""
End Sub

Private Sub cmdOperator_Click(Index As Integer)
    If Text1.Text = "" Then Exit Sub
 
    angka(1) = CSng(Text1.Text)
    operator = cmdOperator(Index).Caption
    Text1.Text = ""
End Sub

Private Sub cmdHitung_Click()
    Dim hasil As Single
     
    If Text1.Text = "" Then Exit Sub
 
    angka(2) = CSng(Text1.Text)
 
    Select Case operator
    Case "+"
        hasil = angka(1) + angka(2)
    Case "-"
        hasil = angka(1) - angka(2)
    Case "*"
        hasil = angka(1) * angka(2)
    Case "/"
        hasil = angka(1) / angka(2)
    End Select
 
    Text1.Text = hasil
End Sub


Latihan 8 Visual Basic - Array Test

Latihan 8 Visual Basic - Array Test


 Dim NamaSiswa() As String

Private Sub Form_Load()
    Dim i As Integer
    ReDim NamaSiswa(1 To 5)

    For i = 1 To 5
        Combo1.AddItem i
    Next i
    Combo1.ListIndex = 0
End Sub

Private Sub Command1_Click()
    Dim no As Integer, i As Integer
 
    no = CInt(Combo1.Text)
    NamaSiswa(no) = InputBox("Tuliskan nama siswa no : " & no, "Input Nama Siswa")
    If NamaSiswa(no) <> "" Then
        List1.Clear
        For i = 1 To UBound(NamaSiswa)
            List1.AddItem "NamaSiswa(" & i & ")=" & NamaSiswa(i)
        Next i
    End If
End Sub

Private Sub Command2_Click()
    Dim num As Integer, i As Integer
 
    If Not IsNumeric(Text1.Text) Then Exit Sub
 
    num = CInt(Text1.Text)
 
    'ReDim NamaSiswa(1 To num)
    ReDim Preserve NamaSiswa(1 To num)
 
    Combo1.Clear
    List1.Clear
    For i = 1 To UBound(NamaSiswa)
        Combo1.AddItem i
        List1.AddItem "NamaSiswa(" & i & ")=" & NamaSiswa(i)
    Next i
    Combo1.ListIndex = 0
End Sub

Latihan 7 Visual Basic - Struktur Looping

Latihan 7 Visual Basic - Struktur Looping



Dim i As Integer

Private Sub Command1_Click()
    List1.Clear
    For i = 1 To 100
        List1.AddItem "Angka " & i
        'If i = 50 Then Exit For
    Next i
End Sub

Private Sub Command2_Click()
    List1.Clear
    For i = 100 To 1 Step -2
        List1.AddItem "Angka " & i
    Next i
End Sub

Private Sub Command3_Click()
    List1.Clear
    i = Asc("A")
    Do Until i > Asc("Z")
        List1.AddItem "Huruf " & Chr(i)
        'If Chr(i) = "M" Then Exit Do
        i = i + 1
    Loop
End Sub

Private Sub Command4_Click()
    List1.Clear
    i = Asc("Z")
    Do While i >= Asc("A")
        List1.AddItem "Huruf " & Chr(i)
        i = i - 1
    Loop
End Sub



Latihan 6 Visual Basic - Struktur SELECT CASE

Latihan 6 Visual Basic - Struktur SELECT CASE


 Private Sub Form_Load()
    List1.AddItem "Disket"
    List1.AddItem "Buku"
    List1.AddItem "Kertas"
    List1.AddItem "Pulpen"
End Sub

Private Sub Command1_Click()
    Dim Harga As Currency, Total As Currency
    Dim jumlah As Integer
    Dim Diskon As Single
    Dim satuan As String
   
    If List1.Text = "" Then
        MsgBox "Anda belum memilih barang !!"
        List1.ListIndex = 0
        Exit Sub
    End If
   
    If Text1.Text = "" Then
        MsgBox "Anda belum mengisi jumlah barang !!"
        Text1.SetFocus
        Exit Sub
    End If
     
    If Not IsNumeric(Text1.Text) Then
        MsgBox "Isi jumlah barang harus angka !!"
        Text1.SetFocus
        Exit Sub
    End If
   
    Select Case List1.Text
    Case "Disket"
        Harga = 35000
        satuan = "Box"
    Case "Buku"
        Harga = 20000
        satuan = "Lusin"
    Case "Kertas"
        Harga = 25000
        satuan = "Rim"
    Case "Pulpen"
        Harga = 10000
        satuan = "Pak"
    End Select
   
    lblBarang.Caption = "Barang : " & List1.Text
    lblHarga.Caption = "Harga : " & Format(Harga, "Currency") & "/" & satuan
    lblJumlah.Caption = "Jumlah : " & Text1.Text & " " & satuan

    jumlah = Text1.Text
   
    Select Case jumlah
    Case Is < 10
        Diskon = 0
    Case 10 To 20
        Diskon = 0.15
    Case Else
        Diskon = 0.2
    End Select
   
    Total = jumlah * (Harga * (1 - Diskon))
   
    lblDiskon.Caption = "Diskon : " & Format(Diskon, "0 %")
    lblTotal.Caption = "Total Bayar : " & Format(Total, "Currency")
End Sub

Latihan 5 Visual Basic - Struktur IF

Latihan 5 Visual Basic -Struktur IF



Dim kesempatan As Integer

Private Sub Command1_Click()
    kesempatan = kesempatan + 1
    If (LCase(Text1.Text) = "nusantara") And (kesempatan <= 3) Then
        Image1.Visible = True
        Text1.Enabled = False
        Command1.Enabled = False
    Else
        MsgBox "Passwordnya Salah !"
        If kesempatan < 3 Then
            Text1.Text = ""
            Text1.SetFocus
        Else
            End
        End If
    End If
End Sub

Latihan 4 Visual Basic - Operator Test

Latihan 4 Visual Basic - Operator Test



Dim var1 As Single, var2 As Single
Dim hasil As Single

Private Sub Form_Load()
    Text1.Text = ""
    Text2.Text = ""
    Label3.Caption = ""
End Sub

Private Sub Option1_Click()
    var1 = Text1.Text
    var2 = Text2.Text
    hasil = var1 + var2
    Label3.Caption = hasil
End Sub

Private Sub Option2_Click()
    var1 = Text1.Text
    var2 = Text2.Text
    hasil = var1 - var2
    Label3.Caption = hasil
End Sub

Private Sub Option3_Click()
    var1 = Text1.Text
    var2 = Text2.Text
    hasil = var1 * var2
    Label3.Caption = hasil
End Sub

Private Sub Option4_Click()
    var1 = Text1.Text
    var2 = Text2.Text
    hasil = var1 / var2
    Label3.Caption = hasil
End Sub

Private Sub Option5_Click()
    var1 = Text1.Text
    var2 = Text2.Text
    hasil = var1 & var2
    Label3.Caption = hasil
End Sub

Private Sub Option6_Click()
    var1 = Text1.Text
    var2 = Text2.Text
    hasil = (var1 > var2)
    Label3.Caption = Format(hasil, "True/False")
End Sub

Private Sub Option7_Click()
    var1 = Text1.Text
    var2 = Text2.Text
    hasil = (var1 < var2)
    Label3.Caption = Format(hasil, "True/False")
End Sub

Private Sub Option8_Click()
    var1 = Text1.Text
    var2 = Text2.Text
    hasil = (var1 = var2)
    Label3.Caption = Format(hasil, "True/False")
End Sub

Private Sub Option9_Click()
    var1 = Text1.Text
    var2 = Text2.Text
    hasil = (var1 <> var2)
    Label3.Caption = Format(hasil, "True/False")
End Sub

Private Sub Option10_Click()
    var1 = Text1.Text
    var2 = Text2.Text
    hasil = (var1 >= var2)
    Label3.Caption = Format(hasil, "True/False")
End Sub

Private Sub Option11_Click()
    var1 = Text1.Text
    var2 = Text2.Text
    hasil = (var1 <= var2)
    Label3.Caption = Format(hasil, "True/False")
End Sub

Private Sub Option12_Click()
    var1 = IIf(Text1.Text = "True", -1, 0)
    hasil = Not (var1)
    Label3.Caption = Format(hasil, "True/False")
End Sub

Private Sub Option13_Click()
    var1 = IIf(Text1.Text = "True", -1, 0)
    var2 = IIf(Text2.Text = "True", -1, 0)
    hasil = (var1 Or var2)
    Label3.Caption = Format(hasil, "True/False")
End Sub

Private Sub Option14_Click()
    var1 = IIf(Text1.Text = "True", -1, 0)
    var2 = IIf(Text2.Text = "True", -1, 0)
    hasil = (var1 And var2)
    Label3.Caption = Format(hasil, "True/False")
End Sub



Latihan 3 Visual Basic - Variabel Test

Latihan 3 Visual Basic - Variabel Test



Option Explicit

Dim test2 As Integer

Private Sub Command1_Click()
    Dim test1 As String
 
    test1 = "nusantara"
 
    Label1.Caption = test1
    Label2.Caption = test2
    Label3.Caption = test3
End Sub

Private Sub Command2_Click()
    test2 = 10
 
    Label1.Caption = test1
    Label2.Caption = test2
    Label3.Caption = test3
End Sub

Private Sub Command3_Click()
    Const test3 As Single = 90.55
 
    
    Label1.Caption = test1
    Label2.Caption = test2
    Label3.Caption = test3
End Sub

Latihan 2 Visual Basic - Method Test

Latihan 2 Visual Basic - Method Test


Private Sub Form_Load()
    Combo1.AddItem "Umar"
    Combo1.AddItem "Salman"
    Combo1.AddItem "Halimah"
    Combo1.AddItem "Shafira"
    Combo1.ListIndex = 0
End Sub

Private Sub Command1_Click()
    List1.AddItem Combo1.Text
    Combo1.SetFocus
End Sub

Private Sub Command2_Click()
    List1.RemoveItem List1.ListIndex
End Sub

Private Sub Command3_Click()
    List1.Clear
    Combo1.SetFocus
End Sub

Latihan 1 Visual Basic - Property

Latihan 1 Visual Basic - Property



Private Sub Command1_Click()
    Label2.Caption = Text1.Text
End Sub

Private Sub Command2_Click()
    End
End Sub

Private Sub Option1_Click()
    Label2.ForeColor = vbBlue
End Sub

Private Sub Option2_Click()
    Label2.ForeColor = vbRed
End Sub

Private Sub Check1_Click()
    Label2.FontBold = Check1.Value
End Sub

Private Sub Check2_Click()
    Label2.FontItalic = Check2.Value
End Sub

 
Design by Wordpress Theme Template Blog Free | Bloggerized by Free Blogger Templates | coupon codes