Jumat, 05 September 2008

Modul VB 1



Source Code :

Dim posisi As String
Dim warna As String

Private Sub Form_Load()
OptAwal.Value = True
optMErah.Value = True
posisi = "Default /Awal"
warna = "Merah"
Call TampilCaption
End Sub


Private Sub cmdClose_Click()
Unload Me
End Sub

Private Sub cmdReset_Click()
txttampil.Text = "Manipulasi Text Belum DiaktIfkan Silahkan Coba"
OptAwal.Value = True
End Sub


Sub TampilCaption()
lblketerangan.Caption = "Anda memilih " & _
posisi & " Dengan warna Font " & warna
End Sub

Private Sub optMerah_Click()
warna = "Merah"
Call TampilCaption
txttampil.ForeColor = &HFF&
End Sub

Private Sub optbiru_Click()
warna = "Biru"
Call TampilCaption
txttampil.ForeColor = &HFF0000
End Sub

Private Sub Awal()
txttampil.SelStart = 0
txttampil.SetFocus
posisi = "Setting Default"
Call TampilCaption
End Sub

Private Sub Akhir()
txttampil.SelStart = Len(txttampil.Text)
txttampil.SetFocus
posisi = "Kursor Diakhir"
Call TampilCaption
End Sub

Private Sub posisi5()
txttampil.SelStart = 5
txttampil.SetFocus
posisi = "Menyisipkan"
Call TampilCaption
End Sub


Private Sub seleksi()
txttampil.SelStart = 0
txttampil.SelLength = Len(txttampil.Text)
txttampil.SetFocus
posisi = " Memblok Seluruh isi Text"
Call TampilCaption
End Sub

Private Sub Tambahtext()
txttampil.SelText = "Tambah Text"
txttampil.SetFocus
posisi = "Menambah Text"
Call TampilCaption
End Sub

Private Sub Combo1_DropDown()
Combo1.AddItem "Awal"
Combo1.AddItem "Akhir"
Combo1.AddItem "posisi5"
Combo1.AddItem "Block"
Combo1.AddItem "TambahText"
End Sub


Private Sub Combo1_Click()
If Combo1.Text = "Awal" Then
Call Awal
End If
If Combo1.Text = "akhir" Then
Call Akhir
End If

If Combo1.Text = "posisi5" Then
Call posisi5
End If

If Combo1.Text = "Block" Then
Call seleksi
End If

If Combo1.Text = "TambahText" Then
Call Tambahtext
End If
End Sub

Private Sub OptAwal_Click()
Call Awal
End Sub

Private Sub optAkhir_Click()
Call Akhir
End Sub

Private Sub optseleksi_Click()
Call seleksi
End Sub

Private Sub optSisip5_Click()
Call posisi5
End Sub

Private Sub opttambahtext_Click()
Call Tambahtext
End Sub

Program Hitung Umur



Private Sub cmdproses_Click()
Dim TanggalA, tanggalB As Date
Dim hr, bl As Double
Dim UsiaTH, usiabl, usiahr, pesan
TanggalA = DTPicker1.Value
tanggalB = DTPicker2.Value
If (tanggalB <= TanggalA) Then
pesan = MsgBox("batas perhitungan tanggal harus lebih besar dari tanggal lahir", vbCritical, "PERINGATAN")
Else
UsiaTH = DateDiff("yyyy", TanggalA, tanggalB)
Textth.Text = UsiaTH
usiabl = DateDiff("m", TanggalA, tanggalB)
bl = usiabl Mod 12
Textbl.Text = bl
usiahr = DateDiff("d", TanggalA, tanggalB)
hr = usiahr Mod 31
Texthr.Text = hr
End If
End Sub

Private Sub cmdtutup_Click()
Unload Me
End Sub

Private Sub DTPicker1_Change()
Dim Tanggal As Date
Dim Angkahari
Dim hari
nhari = Array("", "MINGGU", "SENIN", "SELASA", "RABU", "KAMIS", "JUMAT", "SABTU")
Tanggal = DTPicker1.Value
Angkahari = DatePart("w", Tanggal, vbSunday)
hari = nhari(Angkahari)
lbllahir.Caption = hari
End Sub