Đổi số 123 ra số La mã (IV)

Các thủ thuật liên quan đến xử lý chuỗi và thời gian
Post Reply
QuangHoa
Guru
Guru
Posts: 542
Joined: Thu 27/03/2008 9:02 am
Location: Quê hương Đại tướng Võ Nguyên Giáp
Been thanked: 5 times
Contact:

Đổi số 123 ra số La mã (IV)

Post by QuangHoa »

Thủ thuật: Đổi số 123 ra số La mã (IV)
Tác giả: Võ Quang Hòa
Mô tả: Đổi số 123 ra số La mã (IV)
Bạn cho 2 Textbox vào Form nhé. :)

Code: Select all

Option ExplicitPublic Function RomanNumerals(n As Integer) As String    Dim arabic(12) As Integer, roman(12) As String    Dim i As Integer, out As String    arabic(0) = 1000    arabic(1) = 900    arabic(2) = 500    arabic(3) = 400    arabic(4) = 100    arabic(5) = 90    arabic(6) = 50    arabic(7) = 40    arabic(8) = 10    arabic(9) = 9    arabic(10) = 5    arabic(11) = 4    arabic(12) = 1    roman(0) = "M"    roman(1) = "CM"    roman(2) = "D"    roman(3) = "CD"    roman(4) = "C"    roman(5) = "XC"    roman(6) = "L"    roman(7) = "XL"    roman(8) = "X"    roman(9) = "IX"    roman(10) = "V"    roman(11) = "IV"    roman(12) = "I"    i = 0    While n        While n >= arabic(i)            n = n - arabic(i)            out = out + roman(i)        Wend        i = i + 1    Wend    RomanNumerals = outEnd FunctionPrivate Sub Text1_Change()Text2.Text = "Error"On Error Resume NextIf CLng(Text1.Text) >= 4000 Then Exit SubText2.Text = RomanNumerals(CInt(Text1.Text))End Sub 
朋友
这些年一个人风也过雨也走,有过泪有过错还记得坚持什么。
真爱过才会懂会记没会回手,终有梦中有你在心中。
朋友一生一起走那些日子不再有,一句话一辈子一生情一杯九。
朋友不曾孤单过一声朋友你会懂,还有伤还有痛还要走还有我。
User avatar
truongphu
VIP
VIP
Posts: 4781
Joined: Sun 04/11/2007 10:57 am
Location: Cam Đức, Khánh hòa
Has thanked: 14 times
Been thanked: 525 times

Re: Đổi số 123 ra số La mã (IV)

Post by truongphu »

Xu hướng chung là nên viết gọn nếu có thể

Code: Select all

Public Function RomanNumerals(n As Integer) As String    Dim arabic() As String, roman() As String, i As Byte    arabic = Split("1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1", ",")    roman = Split("M,CM,D,CD,C,XC,L,XL,X,IX,V,IV,I", ",")    While n        While n >= Val(arabic(i))            n = n - Val(arabic(i))            RomanNumerals = RomanNumerals & roman(i)        Wend        i = i + 1    WendEnd Function
o0o--truongphu--o0o

.........
Ghé thăm:
Chuyện Linh Tinh
User avatar
vo_minhdat2007
Quản trị
Quản trị
Posts: 2227
Joined: Sun 17/07/2005 1:40 am
Has thanked: 13 times
Been thanked: 87 times
Contact:

Chuyển số thập phân sang la mã và ngược lại

Post by vo_minhdat2007 »

Tên chương trình: Chuyển số thập phân sang la mã và ngược lại
Ngôn ngữ lập trình: VB6
Tác giả: Sưu tầm
Chức năng: Cái tên nói lên tất cả :P
Attachments
RomanNumeralsApp.rar
(42.17 KiB) Downloaded 668 times
User avatar
truongphu
VIP
VIP
Posts: 4781
Joined: Sun 04/11/2007 10:57 am
Location: Cam Đức, Khánh hòa
Has thanked: 14 times
Been thanked: 525 times

Chuyển số La mã ra số Ả rập

Post by truongphu »

  1. Public Function Roman2Arabic(m As String) As Integer ' <4000
  2. m = UCase(m)
  3. Dim arabic() As String, roman As String, u As Integer, W As Integer
  4. arabic = Split("1000,500,100,50,10,5,1", ",")
  5. roman = "MDCLXVI"
  6.  
  7. For u = Len(m) To 1 Step -1
  8.     If u < Len(m) Then
  9.         If CInt(arabic(InStr(roman, Mid(m, u + 1, 1)) - 1)) <= CInt(arabic(InStr(roman, Mid(m, u, 1)) - 1)) Then
  10.             W = W + CInt(arabic(InStr(roman, Mid(m, u, 1)) - 1))
  11.         Else
  12.             W = W - CInt(arabic(InStr(roman, Mid(m, u, 1)) - 1))
  13.         End If
  14.     Else
  15.         W = W + CInt(arabic(InStr(roman, Mid(m, u, 1)) - 1))
  16.     End If
  17. Next
  18. Roman2Arabic = W
  19. End Function
Attachments
Roman 2 Arab.rar
(1.35 KiB) Downloaded 424 times
o0o--truongphu--o0o

.........
Ghé thăm:
Chuyện Linh Tinh
chipmunk
Thành viên tích cực
Thành viên tích cực
Posts: 125
Joined: Mon 28/03/2011 9:19 am
Has thanked: 2 times
Been thanked: 5 times

Re: Đổi số 123 ra số La mã (IV)

Post by chipmunk »

Cái này của bác truongphu sử dụng được đấy!
Post Reply

Return to “[VB] Chuỗi và Thời gian”