Membuat Kalkulator Cinta dengan VB 6

Nah pada postingan kali ini kita akan mencoba mebuat sebuah kalkulator Cinta dengan Visual Basic 6. Oh iya kalkulator ini fungsinya untuk menghitung kira-kira seberapa besarkah cinta si dia padamu lho!!!. He he he …jangan ditanggapi serius ya. Program ini hanya untuk iseng-iseng aja, tapi lumayan lah untuk sekedar main-main ….. Nah berikut ini tampilannya kalau sudah jadi :

Tampilan di atas adalah kalkulator cinta versi aku sendiri, anda bisa membuat tampilan yang lebih bagus dari yang aku buat lho….

Baik sekarang saatnya kita mulai membuat kalkulator ini:
1.    Buka program Visual Basic 6 dan pilih Standart.EXE
2.    Masukkan 2 buah Label, 2 buah TextBox dan 2 buah Command Button. Atur seperti gambar di bawah
       ini :

3.    Ubah Propertiesnya sebagai berikut :
        •    Ubah Caption Label1 menjadi Nama Cowok / Nama Pria
       •    Ubah Caption Label2 menjadi Nama Cewek/ Nama Wanita
       •    Kosongkan tulisan Text1 dan Text2
       •    Caption Command1 diubah menjadi Hitung
       •    Caption Command2 diubah menjadi Keluar

4.    Berikut ini tampilan Form yang sudah diubah Captionnya:

5.    Masukkan Listing/ Kode di bawah ini ke jendela kode:

'www.rudymaturbongs.blogspot.com
Private Sub Command1_Click()
Dim sBuffer As String
Dim sBuffer2 As String
Dim nCowokLen As Integer
Dim nCewekLen As Integer
Dim nCtr As Integer
Dim nCtr2 As Integer
Dim nTotalLen As Integer
Dim nJumlah As Integer
Dim c As String
Dim c1 As String
Dim BoolExit As Boolean
Dim nKomentar As String
    If Len(Text1) <= 0 Then MsgBox "Silahkan masukkan nama cowoknya", vbInformation: Text1.SetFocus: Exit Sub
    If Len(Text2) <= 0 Then MsgBox "Silahkan masukkan nama ceweknya", vbInformation: Text2.SetFocus: Exit Sub
  
  
    Text1 = Trim(Text1)
    Text2 = Trim(Text2)
    nCowokLen = Len(Text1)
    nCewekLen = Len(Text2)
  
 
    sBuffer = UCase(Text1) & "LOVES" & UCase(Text2)
    nTotalLen = Len(sBuffer)
  
           For nCtr = 1 To nTotalLen
            nJumlah = 1
            If nCtr = nTotalLen And Mid(sBuffer, nCtr, 1) = Chr(255) Then BoolExit = True
            For nCtr2 = nCtr + 1 To nTotalLen
                If Mid(sBuffer, nCtr, 1) = Chr(255) Then BoolExit = True: Exit For
                If Mid(sBuffer, nCtr, 1) = Mid(sBuffer, nCtr2, 1) Then
                    Mid(sBuffer, nCtr2, 1) = Chr(255)
                    nJumlah = nJumlah + 1
                End If
            Next nCtr2
            If nJumlah = 0 Then nJumlah = 1
            If BoolExit = True Then
                BoolExit = False
            Else
                sBuffer2 = sBuffer2 & nJumlah
                Mid(sBuffer, nCtr, 1) = Chr(255)
            End If
            DoEvents
        Next nCtr
  
        Do
            sBuffer = sBuffer2
            sBuffer2 = ""
            nTotalLen = Len(sBuffer)
            If nTotalLen <= 2 Then Exit Do
            Do
                c = CInt(Left(sBuffer, 1))
                c1 = CInt(Right(sBuffer, 1))
                sBuffer2 = sBuffer2 & CInt(c) + CInt(c1)
                sBuffer = Mid(sBuffer, 2, nTotalLen - 2)
                nTotalLen = Len(sBuffer)
            Loop While Not Len(sBuffer) <= 1
            If Len(sBuffer) = 1 Then sBuffer2 = sBuffer2 & sBuffer
        Loop While Not Len(sBuffer2) <= 1
            If CInt(sBuffer) < 25 Then
                nKomentar = "Coba cewek yang lain."
            End If
            If Diantara(CInt(sBuffer), 25, 50) Then
                nKomentar = "Cukup."
            End If
            If Diantara(CInt(sBuffer), 50, 75) Then
                nKomentar = "Ini baik."
            End If
            If Diantara(CInt(sBuffer), 75, 100) Then
                nKomentar = "Luar biasa!!."
            End If
      
        MsgBox Text1 & " mencintai " & Text2 & " sebesar " & sBuffer & " %", vbInformation, nKomentar
End Sub

Private Function Diantara(nNomor As Integer, nPertama As Integer, nKedua As Integer, Optional BoundIncluded As Boolean = False) As Boolean
If BoundIncluded = True Then
    If nNomor >= nPertama And nNomor <= nKedua Then
        Diantara = True
    Else
        Diantara = False
    End If
Else
    If nNomor > nPertama And nNomor < nKedua Then
        Diantara = True
    Else
        Diantara = False
    End If
End If
End Function

Private Sub Command2_Click()
End
End Sub

Private Sub Command3_Click()

Text1.Text = ""

Text2.Text = ""

End Sub

6.    Nah kalau kita perhatikan kode di atas ada kode untuk Command3 padahal di Form yang sudah kita buat Cuma ada 2 buah Command Button. Command3 dimaksudkan jika anda ingin menambahkan satu tombol lagi untuk tombol Hapus. Jika anda tidak ingin menambah tombol, maka hapus saja kodenya (yang warna biru).
7.    Selesai deh program kalkulator cintanya. Silahkan dicoba dengan menekan tombol F5. Sekali lagi aku ingatkan buat teman-teman ya kalau program ini hanya untuk iseng-iseng jadi jangan ditanggapi dengan serius hasilnya ya!!!  ^_^.

8.    Yang terkahir, jika anda ingin mempelajari lebih jauh lagi tentang program sederhana ini silahkan download source code lengkapnya di sini.