kaLEndeR,,,

Option ExplicitDim days As Long '<-Stores the number of days elapsed from 1/1/1900 to current month and yearDim i As IntegerPrivate Sub cmdGenerate_Click()On Error GoTo Error_handle 'On error, goto to end of functiondays = 0For i = 0 To 34 Label1(i).Caption = "" 'Clear all the labelsNext iFor i = 1900 To txtYear.Text - 1 If i Mod 4 = 0 Then 'If leap year then count 366 days days = days + 366 Else 'else 365 days days = days + 365 End IfNext iFor i = 1 To txtMonth.Text - 1 If i = 1 Or i = 3 Or i = 5 Or i = 7 Or i = 8 Or i = 10 Or i = 12 Then 'For January,March,May....,December count 31 days days = days + 31 ElseIf (i = 4 Or i = 6 Or i = 9 Or i = 11) Then 'For April,June,September,November count 30 days days = days + 30 ElseIf (i = 2 And txtYear.Text Mod 4 = 0) Then 'If month is February and year is leap year count 29 days days = days + 29 Else 'If month is February and year is not a leap year, count 28 days days = days + 28 End If Next iIf (i = 1 Or i = 3 Or i = 5 Or i = 7 Or i = 8 Or i = 10 Or i = 12) Then show_calender 31 'Show calender with 31 days ElseIf (i = 4 Or i = 6 Or i = 9 Or i = 11) Then show_calender 30 'Show calender with 30 days ElseIf (i = 2 And txtYear.Text Mod 4 = 0) Then show_calender 29 'Show calender with 29 days Else show_calender 28 'Show calender with 28 days End IfError_handle:End SubPrivate Function show_calender(n As Integer) '//<- n stores the number of days to displayDim i, k As Integerk = days Mod 7 'Divide days with 7, the remainder give the current dayFor i = 1 To n Label1(k).Caption = i 'Display the number in calender format k = k + 1 If k = 35 Then k = 0Next iEnd Function

chapter3

Option Explicit

Private Hasil As Double

Private Const opNol = 0

Private Const opTambah = 1

Private Const opKurang = 2

Private Const opKali = 3

Private Const opBagi = 4

Private Operator As Integer

Private NilaiBaru As Boolean

' untuk menghapus karakter terakhir

Private Sub Hapus()

Dim txt As String

Dim min_len As Integer

txt = txtDisplay.Text

If Left$(txt, 1) = "-" Then

min_len =

2

Else

min_len =

1

End If

If Len(txt) > min_len Then

txtDisplay.Text = Left$(txt, Len(txt) - 1)

Else

txtDisplay.Text = "0"

End If

End Sub

' hapus angka, hasil terakhir dan operator

Private Sub cmdClear_Click()

cmdClearEntry_Click

Hasil = 0

Operator = opNol

End Sub

' hapus angkaPrivate Sub cmdClearEntry_Click()

txtDisplay.Text = ""

End Sub

' menambahkan koma (desimal)

Private Sub cmdKoma_Click()

If InStr(txtDisplay.Text, ".") Then

Beep

Else

If NilaiBaru Then

txtDisplay.Text = "."

"

NilaiBaru = False

Else

txtDisplay.Text = txtDisplay.Text & "."

End If

End If

End Sub

' Menghitung

Private Sub cmdSamaDengan_Click()

Dim HasilBaru As Double

If txtDisplay.Text = "" Then

HasilBaru = 0

Else

HasilBaru = CDbl(txtDisplay.Text)

End If

Select Case OperatorCase opNol

Hasil = HasilBaru

Case opTambah

Hasil = Hasil + HasilBaru

Case opKurang

Hasil = Hasil - HasilBaru

Case opKali

Hasil = Hasil * HasilBaru

Case opBagi'

Tidak bisa dibagi nolIf HasilBaru = 0 Then

MsgBox "Tidak bisa dibagi 0", vbOKOnly + vbCritical, "Kalku ERROR"

Call cmdClear_Click

Else

Hasil = Hasil / HasilBaru

End If

End Select

Operator = opNol

NilaiBaru = True

txtDisplay.Text = Format$(Hasil)

End Sub

' menuliskan angka

Private Sub cmdAngka_Click(Index As Integer)

If NilaiBaru Then

txtDisplay.Text = Format$(Index)

NilaiBaru = False

Else

txtDisplay.Text = _

txtDisplay.Text & Format$(Index)

End If

End Sub

' tombol tambah/kurang/bagi/kali

Private Sub cmdOperator_Click(Index As Integer)

cmdSamaDengan_Click

Operator = Index

NilaiBaru = True

End Sub

' merubah tanda +/-

Private Sub cmdPlusMinus_Click()

If NilaiBaru Then

txtDisplay.Text = "-"Else

If Left$(txtDisplay.Text, 1) = "-" Then

txtDisplay.Text = Right$(txtDisplay.Text, 2)

Else

Artikel Populer IlmuKomputer.Com

Copyright © 2005 IlmuKomputer.Comt

xtDisplay.Text = "-" & txtDisplay.Text

End If

End Sub

' filter untuk angka saja yg dapat diketikkan

Private Sub Form_KeyPress(KeyAscii As Integer)

txtDisplay_KeyPress KeyAscii

End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)

txtDisplay_KeyUp KeyCode, Shift

End Sub'

supaya kursor tetap di kanan

Private Sub txtDisplay_Change()

txtDisplay.SelStart = Len(txtDisplay.Text)E

nd Sub

Private Sub txtDisplay_GotFocus()

txtDisplay_Change

End Sub

' untuk mengetikkan angka di keyboard

Private Sub txtDisplay_KeyPress(KeyAscii As Integer)

Dim ch As Stringch

= Chr$(KeyAscii)

Select Case ch

Case "0"

cmdAngka_Click

0

Case "1"

cmdAngka_Click

1

Case "2"

cmdAngka_Click

2

Case "3"

cmdAngka_Click

3

Case "4"

cmdAngka_Click

4

Case "5"

cmdAngka_Click

5

Case "6"

cmdAngka_Click

6

Case "7"

cmdAngka_Click

7

Case "8"

cmdAngka_Click

8

Case "9"

cmdAngka_Click

9

Case "*", "x", "X"

cmdOperator_Click opKali

Case "+"

"cmdOperator_Click opTambah

Case vbCrLf, vbCr, "="

"

cmdSamaDengan_ClickCase "-"

"

cmdOperator_Click opKurangCase "."

"

cmdKoma_ClickCase "/"

"

cmdOperator_Click opBagi

Case "C", "c"

cmdClearEntry_Click

End Select

KeyAscii = 0

End Sub

' untuk ketikan angka di numpad

Private Sub txtDisplay_KeyUp(KeyCode As Integer, Shift As Integer)

Select Case KeyCode

Case vbKeyNumpad0

cmdAngka_Click 0

Case vbKeyNumpad1

cmdAngka_Click 1

Case vbKeyNumpad2

cmdAngka_Click 2

Case vbKeyNumpad3

cmdAngka_Click 3

Case vbKeyNumpad4

cmdAngka_Click 4

Case vbKeyNumpad5c

mdAngka_Click 5

Case vbKeyNumpad6

cmdAngka_Click 6

Case vbKeyNumpad7

cmdAngka_Click 7

Case vbKeyNumpad8

cmdAngka_Click 8

Case vbKeyNumpad9

cmdAngka_Click 9

Case vbKeyMultiply

cmdOperator_Click opKali

Case vbKeyAdd

cmdOperator_Click opTambah

Case vbKeySeparator

cmdSamaDengan_Click

Case vbKeySubtract

cmdOperator_Click opKurang

Case vbKeyDivide

cmdOperator_Click opBagi

Case vbKeyDecimal

cmdKoma_Click

Case vbKeyBack, vbKeyDelete

Hapus

End Select

KeyCode = 0

End Sub

Private Sub Text1_Change()

End Sub