Sabtu, 20 Agustus 2011

Program untuk mencari weton hari berdasarkan tanggal.



 copykan listing program di bawah ini:Dim a, b As Date
Dim c, d, e, f, g As Integer
Dim tk, pt, tt, kt, s As Integer
Dim tek, t As String

Private Sub kosong()
Text4.Text = "31-12-2099"
Text5.Text = ""
Text7.Text = ""
Text6.Text = ""
a = Format(Date, "DD-MM-YYYY")
b = Format(Date, "DD-MM-YYYY")
Text5.SetFocus
Text7.Enabled = False
Text6.Enabled = False
End Sub


Private Sub Command1_Click()
Dim hari As Variant

e = Right(Text2.Text, 1)
If e > 5 Then
e = e - 5
If e = 0 Then
Text6.Text = "Kliwon"
ElseIf e = 3 Then
Text6.Text = "Pahing"
ElseIf e = 2 Then
Text6.Text = "Pon"
ElseIf e = 1 Then
Text6.Text = "Wage"
ElseIf e = 5 Then
Text6.Text = "Kliwon"
ElseIf e = 4 Then
Text6.Text = "Manis"
End If

Else
If e = 0 Then
Text6.Text = "Kliwon"
ElseIf e = 3 Then
Text6.Text = "Pahing"
ElseIf e = 2 Then
Text6.Text = "Pon"
ElseIf e = 1 Then
Text6.Text = "Wage"
ElseIf e = 5 Then
Text6.Text = "Kliwon"
ElseIf e = 4 Then
Text6.Text = "Manis"
End If
End If

hari = Text5.Text
Text7.Text = Format(hari, "dddd")
Text3.Text = e

End Sub

Private Sub Command1_GotFocus()
On Error Resume Next
Dim a As Date
a = Text4.Text
b = Text5.Text
c = a - b
Text2.Text = c

If Text5.Text = "" Then
x = MsgBox("Maaf Tanggal Lahir Tidak Boleh Kosong...!", vbOKOnly + vbExclamation, "Warning")
Text5.SetFocus
Else
Command1.Enabled = True
Command1.SetFocus
End If

End Sub

Private Sub Command2_Click()
End
End Sub

Private Sub Form_Activate()
kosong
End Sub

Private Sub Form_Load()
t = "Copyright By : Mahfudh S"
tt = Len(t)
kt = 0

End Sub

Private Sub Text4_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Text5.SetFocus
End If

End Sub

Private Sub Text4_LostFocus()
'Dim b As Date
a = Text4.Text
'b = Text5.Text
'Text6.Text = b - a

End Sub

Private Sub Text5_GotFocus()
kosong
End Sub

Private Sub Text5_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Command1.SetFocus
End If
End Sub

Private Sub Timer2_Timer()
kt = kt + 1
If kt = tt + 5 Then
kt = 0
End If
Form1.Caption = Left(t, kt)

End Sub


 


 Buatlah form seperti gambar di bawah ini (nama textbox harus seperti di gambar, command1 untuk tombol Ok, command2 untuk tombol Cancel)


Tidak ada komentar:

Posting Komentar