Cara Membuat Stopwatch Dengan Visual Basic 6.0 – Hai Sobat Naga Kali ini Saya akan share mengenai Cara Membuat Stopwatch Dengan Visual Basic 6.0 Berikut caranya: Buka Aplikasi Visual Basic 6.0 Buatlah. Setelah database sudah terkoneksi dengan form, sekarang kita akan membuat perintah simpan, edit, hapus pada command button. Sekarang Anda bisa mencari Aplikasi Visual Basic 6.0 di situs ini: www.panduanSkripsi.net. Koleksi program lengkap di sana, proyek PHP dan MySQL, juga jQuery dan Framework. Bukunya juga ada.
Cara Membuat Aplikasi Converter Angka Number ke Angka Romawi dengan VB6 - Pada zaman dahulu kala orang romawi kuno menggunakan penomoran tersendiri yang sangat berbeda dengan sistem penomeran pada jaman seperti sekarang.Penomeran romawi hanya terdiri dari 7 nomor dengan simbol huruf tertentu di mana setiap huruf melambangkan / memiliki arti angka tertentu. Diantara 7 nomor itu adalah I V X L C D M.
Pada pertemuan kali ini Saya ingin berbagi trik bagaimana cara membuat program aplikasi converter angka dari angka Number menjadi angka Romawi atau sebaliknya dari angka Romawai ke angka Number.
Bagi Anda yang penasaran bagaimana cara membuatnya ikuti langkah-langkah berikut dibawah ini :
Cara Membuat Program Aplikasi Converter Angka Number ke Angka Romawi
2. Pada Form1 ubah Name Propertiesnya menjadi : frmRoman dan Caption-nya: 'Decimal to
3. Tambahkan 1 Frame didalam Form, ubah Captionnya menjadi 'Select Conversion Type'
4. Tanamkan 2 optionButton kedalam Frame uban Name-nya masing-masing menjadi :
5. Tanamkan 1 Label dengan tulisan 'Enter a number between 1 and 3999:', ubah Name-nya
6. Tanamkan 1 TextBox ubah Name-nya menjadi : txtInput, Text-nya kosongkan
7. Tanamkan 1 Label dengan Tulisan: Roman Numeral Equivalent:, ubah Name-nya menjadi :
8. Tanamkan 1 Label lagi dengan Caption :' '(dibiarkan kosong), ubah BorderStyle :Fixed Single,
9. Tanamkan 2 Commanbutton : Commanbutton1 ubah Name-nya menjadi : cmdConvert,
Caption-nya :'Convert' kemudian Commandbutto2 ubah Name-nya menjadi :cmdExit dan ganti Caption-nya menjadi : 'Exit'
10. Desainlah form seperti Gambar dibawah ini:
Desain Converter Numeric to Roman |
11. Setelah selesai desain form Sekarang buka jendela kode dan ketik kode dibawah ini :
End Sub
Private Sub optDecimalToRoman_Click()
lblPrompt.Caption = 'Enter a number between 1 and 3999:'
lblOutputDesc.Caption = 'Roman Numeral Equivalent:'
txtInput.MaxLength = 4
End Sub
lblPrompt.Caption = 'Enter a Roman Numerals number between I and MMMCMXCIX:'
txtInput.Text = '
lblOutput.Caption = '
Private Sub txtInput_GotFocus()
With txtInput
.SelLength = Len(.Text)
End Sub
Private Sub txtInput_KeyPress(KeyAscii As Integer)
If KeyAscii < 32 Then Exit Sub
If optDecimalToRoman.Value = True Then
KeyAscii = 0
Else
If Chr$(KeyAscii) >= 'a' And Chr$(KeyAscii) <= 'z' Then
End If
KeyAscii = 0
End If
End Sub
Private Sub txtInput_Change()
lblOutput.Caption = '
End Sub
Dim strRomanNumeralString As String
If Val(txtInput.Text) < 1 _
MsgBox 'Number out of range. Please enter a number between 1 and 3999.', _
'Number Out of Range'
Exit Sub
lblOutput.Caption = ConvertToRoman(txtInput.Text)
strRomanNumeralString = txtInput.Text
If Not ValidRomanInput(strRomanNumeralString, strInvalidRomanInputMsg) Then
vbExclamation, _
txtInput.SetFocus
End If
lblOutput.Caption = ConvertToDecimal(txtInput.Text)
Private Sub cmdExit_Click()
End Sub
Private Function ConvertToRoman(pstrDecimalNumber As String) As String
Const strPOS_VAL As String = 'IXCM'
Dim strCurrRomanPos As String
Dim strLetter2 As String
Dim intDigit As Integer
strRoman = '
For intDigitPos = Len(pstrDecimalNumber) To 1 Step -1
intDigit = Val(Mid$(pstrDecimalNumber, intDigitPos, 1))
strCurrRomanPos = Mid$(strPOS_VAL, intCurrPos, 1)
Case 9
strLetter2 = Mid$(strPOS_VAL, intCurrPos + 1, 1)
strLetter1 = Mid$(strFIVE_VAL, intCurrPos, 1)
strLetter2 = String$(intDigit - 5, strCurrRomanPos)
strLetter1 = strCurrRomanPos
Case Else
strLetter2 = '
strRoman = strLetter1 & strLetter2 & strRoman
Next
ConvertToRoman = strRoman
End Function
Private Function ConvertToDecimal(pstrRomanNumeral As String) As String
Dim aintRomanValues() As Integer
Dim intX As Integer
ConvertToDecimal = 0
End If
ReDim aintRomanValues(1 To intInputLen)
For intX = 1 To intInputLen
Case 'M': aintRomanValues(intX) = 1000
Case 'C': aintRomanValues(intX) = 100
Case 'X': aintRomanValues(intX) = 10
Case 'I': aintRomanValues(intX) = 1
Next
For intX = 1 To intInputLen
intSum = intSum + aintRomanValues(intX)
If aintRomanValues(intX) >= aintRomanValues(intX + 1) Then
Else
End If
Next
Private Function ValidRomanInput(ByVal pstrRN As String, ByRef pstrMsg As String) As Boolean
ValidRomanInput = False ' Guilty until proven innocent!
' a 'D', 'L', or 'V' may only appear at most once in the string
If GetSubstringCount(pstrRN, 'D') > 1 _
Or GetSubstringCount(pstrRN, 'V') > 1 Then
pstrMsg = 'D', 'L', or 'V' may only appear at most once.'
End If
' no more than 3 consecutive Ms, Cs, Xs or Is:
If InStr(pstrRN, 'MMMM') > 0 _
Or InStr(pstrRN, 'XXXX') > 0 _
pstrMsg = 'M', 'C', 'X', or 'I' may appear no more than three times in a row.'
End If
' Outright illegal sequences:
If InStr(pstrRN, 'IL') > 0 _
Or InStr(pstrRN, 'ID') > 0 _
Or InStr(pstrRN, 'XD') > 0 _
Or InStr(pstrRN, 'VX') > 0 _
Or InStr(pstrRN, 'VC') > 0 _
Or InStr(pstrRN, 'VM') > 0 _
Or InStr(pstrRN, 'LD') > 0 _
Or InStr(pstrRN, 'DM') > 0 _
pstrMsg = 'The Roman Numeral string contains an illegal sequence of characters.'
End If
' Other illegal sequences:
' Once a letter has been subtracted from, neither it nor its '5 counterpart' may appear
' again in the string - so neither X nor V can follow IX, neither C nor L may follow XC,
If AFollowsBInC('X', 'IX', pstrRN) Then pstrMsg = 'X' cannot follow 'IX'.': Exit Function
If AFollowsBInC('V', 'IX', pstrRN) Then pstrMsg = 'V' cannot follow 'IX'.': Exit Function
If AFollowsBInC('C', 'XC', pstrRN) Then pstrMsg = 'C' cannot follow 'XC'.': Exit Function
If AFollowsBInC('L', 'XC', pstrRN) Then pstrMsg = 'L' cannot follow 'XC'.': Exit Function
If AFollowsBInC('M', 'CM', pstrRN) Then pstrMsg = 'M' cannot follow 'CM'.': Exit Function
If AFollowsBInC('D', 'CM', pstrRN) Then pstrMsg = 'D' cannot follow 'CM'.': Exit Function
' Once a letter has been used as a subtraction modifier, it cannot appear again in the
' string - so C cannot follow CD or CM, X cannot follow XL or XC, and I cannot follow
If AFollowsBInC('C', 'CD', pstrRN) Then pstrMsg = 'C' cannot follow 'CD'.': Exit Function
If AFollowsBInC('C', 'CM', pstrRN) Then pstrMsg = 'C' cannot follow 'CD'.': Exit Function
If AFollowsBInC('X', 'XL', pstrRN) Then pstrMsg = 'X' cannot follow 'XL'.': Exit Function
If AFollowsBInC('X', 'XC', pstrRN) Then pstrMsg = 'X' cannot follow 'XL'.': Exit Function
If AFollowsBInC('I', 'IV', pstrRN) Then pstrMsg = 'I' cannot follow 'IV'.': Exit Function
If AFollowsBInC('I', 'IX', pstrRN) Then pstrMsg = 'I' cannot follow 'IV'.': Exit Function
' Once I, X, or C (or their '5-counterparts' V, L, and D) appears in a string, the I, X, or
' C cannot subsequently be used as subtraction modifiers - so IV or IX cannot follow I or V,
' XL or XC cannot follow X or L, and CD or CM cannot follow C or D.
If AFollowsBInC('IV', 'I', pstrRN) Then pstrMsg = 'IV' cannot follow 'I'.': Exit Function
If AFollowsBInC('IX', 'I', pstrRN) Then pstrMsg = 'IX' cannot follow 'I'.': Exit Function
If AFollowsBInC('IX', 'V', pstrRN) Then pstrMsg = 'IX' cannot follow 'V'.': Exit Function
If AFollowsBInC('XL', 'X', pstrRN) Then pstrMsg = 'XL' cannot follow 'X'.': Exit Function
If AFollowsBInC('XC', 'X', pstrRN) Then pstrMsg = 'XC' cannot follow 'X'.': Exit Function
If AFollowsBInC('XC', 'L', pstrRN) Then pstrMsg = 'XC' cannot follow 'L'.': Exit Function
If AFollowsBInC('CD', 'C', pstrRN) Then pstrMsg = 'CD' cannot follow 'C'.': Exit Function
If AFollowsBInC('CM', 'C', pstrRN) Then pstrMsg = 'CM' cannot follow 'C'.': Exit Function
If AFollowsBInC('CM', 'D', pstrRN) Then pstrMsg = 'CM' cannot follow 'D'.': Exit Function
ValidRomanInput = True
End Function
Private Function GetSubstringCount(ByVal pstrMainString As String, ByVal pstrSubstring As String) As Long
Dim lngX As Long
GetSubstringCount = 0
lngX = InStr(1, pstrMainString, pstrSubstring, vbBinaryCompare)
GetSubstringCount = 0
lngX = 0
If Mid$(pstrMainString, lngY, Len(pstrSubstring)) = pstrSubstring Then
End If
GetSubstringCount = lngX
End If
End Function
Private Function AFollowsBInC(pstrA As String, pstrB As String, pstrC As String) As Boolean
Dim lngTestPos As Long
If lngTestPos > 0 Then
If InStr(lngTestPos + Len(pstrB), pstrC, pstrA, vbTextCompare) Then
Else
End If
AFollowsBInC = False
11. Simpan hasil pekerjaan Anda dan jalankan program.
Demikian tip Cara Membuat Aplikasi Converter Angka Number ke Angka Romawi dengan VB6. Selamat mencoba semoga berhasil