Membuat kalkulator Cinta Dengan Vb 6.0

Hai sahabat Blogger..
pada kesempatan ini saya akan Share Cara membuat kalkulator cinta dengan Vb 6.0, oke langsung saja :

1. Pertama Buka Visual Basic 6.0.
2. Pada New Projeck pilih Standard EXE lalu klik Open.
3. Masukkan 2 buah Label, 2 buah TextBox dan 3 buah Command Button. Atur seperti gambar di bawah
ini :

4.  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

•    Caption Command3 diubah menjadi Hapus

5. Berikut ini tampilan Form yang sudah diubah Captionnya:

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

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 & " Cinta Dan Sayang  " & 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

7. sekarang Klik tombol Start atau tekan Tombol F5
yeyeyeyeii Berhasil.... selamat Mencoba
8. Untuk Mendownload Source nya Disini