• 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
Bài viết: 542
Ngày tham gia: T.Năm 27/03/2008 9:02 am
Đến từ: Quê hương Đại tướng Võ Nguyên Giáp
Been thanked: 5 time
Liên hệ:

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

Gửi bàigửi bởi QuangHoa » T.Hai 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é. :)

Mã: Chọn hết

  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.  


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

Hình đại diện của người dùng
truongphu
VIP
VIP
Bài viết: 4756
Ngày tham gia: CN 04/11/2007 10:57 am
Đến từ: Cam Đức, Khánh hòa
Has thanked: 14 time
Been thanked: 509 time

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

Gửi bàigửi bởi truongphu » T.Hai 12/05/2008 9:31 am

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

Mã: Chọn hết

  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

Hình đại diện của người dùng
vo_minhdat2007
Quản trị
Quản trị
Bài viết: 2227
Ngày tham gia: CN 17/07/2005 1:40 am
Has thanked: 13 time
Been thanked: 87 time
Liên hệ:

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

Gửi bàigửi bởi vo_minhdat2007 » T.Sáu 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

Tập tin đính kèm
RomanNumeralsApp.rar
(42.17 KiB) Đã tải 577 lần

Hình đại diện của người dùng
truongphu
VIP
VIP
Bài viết: 4756
Ngày tham gia: CN 04/11/2007 10:57 am
Đến từ: Cam Đức, Khánh hòa
Has thanked: 14 time
Been thanked: 509 time

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

Gửi bàigửi bởi truongphu » CN 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
Tập tin đính kèm
Roman 2 Arab.rar
(1.35 KiB) Đã tải 341 lần
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
Bài viết: 125
Ngày tham gia: T.Hai 28/03/2011 9:19 am
Has thanked: 2 time
Been thanked: 5 time

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

Gửi bàigửi bởi chipmunk » CN 17/04/2011 8:42 am

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


Quay về “[VB] Chuỗi và Thời gian”

Đang trực tuyến

Đang xem chuyên mục này: Không có thành viên nào trực tuyến.1 khách