• Vui lòng đọc nội qui diễn đàn để tránh bị xóa bài viết
  • Tìm kiếm trước khi đặt câu hỏi

Đổ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
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)

Postby QuangHoa » Mon 12/05/2008 8:40 am

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

  1. Option Explicit
  2. Public Function RomanNumerals(n As Integer) As String
  3.     Dim arabic(12) As Integer, roman(12) As String
  4.     Dim i As Integer, out As String
  5.     arabic(0) = 1000
  6.     arabic(1) = 900
  7.     arabic(2) = 500
  8.     arabic(3) = 400
  9.     arabic(4) = 100
  10.     arabic(5) = 90
  11.     arabic(6) = 50
  12.     arabic(7) = 40
  13.     arabic(8) = 10
  14.     arabic(9) = 9
  15.     arabic(10) = 5
  16.     arabic(11) = 4
  17.     arabic(12) = 1
  18.     roman(0) = "M"
  19.     roman(1) = "CM"
  20.     roman(2) = "D"
  21.     roman(3) = "CD"
  22.     roman(4) = "C"
  23.     roman(5) = "XC"
  24.     roman(6) = "L"
  25.     roman(7) = "XL"
  26.     roman(8) = "X"
  27.     roman(9) = "IX"
  28.     roman(10) = "V"
  29.     roman(11) = "IV"
  30.     roman(12) = "I"
  31.     i = 0
  32.     While n
  33.         While n >= arabic(i)
  34.             n = n - arabic(i)
  35.             out = out + roman(i)
  36.         Wend
  37.         i = i + 1
  38.     Wend
  39.     RomanNumerals = out
  40. End Function
  41. Private Sub Text1_Change()
  42. Text2.Text = "Error"
  43. On Error Resume Next
  44. If CLng(Text1.Text) >= 4000 Then Exit Sub
  45. Text2.Text = RomanNumerals(CInt(Text1.Text))
  46. End Sub
  47.  


朋友
这些年一个人风也过雨也走,有过泪有过错还记得坚持什么。
真爱过才会懂会记没会回手,终有梦中有你在心中。
朋友一生一起走那些日子不再有,一句话一辈子一生情一杯九。
朋友不曾孤单过一声朋友你会懂,还有伤还有痛还要走还有我。

User avatar
truongphu
VIP
VIP
Posts: 4766
Joined: Sun 04/11/2007 10:57 am
Location: Cam Đức, Khánh hòa
Has thanked: 14 times
Been thanked: 520 times

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

Postby truongphu » Mon 12/05/2008 9:31 am

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

Code: Select all

  1. Public Function RomanNumerals(n As Integer) As String
  2.     Dim arabic() As String, roman() As String, i As Byte
  3.     arabic = Split("1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1", ",")
  4.     roman = Split("M,CM,D,CD,C,XC,L,XL,X,IX,V,IV,I", ",")
  5.     While n
  6.         While n >= Val(arabic(i))
  7.             n = n - Val(arabic(i))
  8.             RomanNumerals = RomanNumerals & roman(i)
  9.         Wend
  10.         i = i + 1
  11.     Wend
  12. End 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

Postby vo_minhdat2007 » Fri 10/07/2009 3:57 pm

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 645 times

User avatar
truongphu
VIP
VIP
Posts: 4766
Joined: Sun 04/11/2007 10:57 am
Location: Cam Đức, Khánh hòa
Has thanked: 14 times
Been thanked: 520 times

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

Postby truongphu » Sun 20/12/2009 8:02 pm

  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 396 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)

Postby chipmunk » Sun 17/04/2011 8:42 am

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


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

Who is online

Users browsing this forum: No registered users and 1 guest