ชุมชนคนรักภาษาเบสิค - Visual Basic Community

 ลืมรหัสผ่าน
 ลงทะเบียน
ค้นหา
ดู: 2315|ตอบกลับ: 0

[VB6/VBA/VB.Net] การแปลงจำนวนเงินเป็นข้อความภาษาไทย

[คัดลอกลิงก์]

252

กระทู้

370

โพสต์

3094

เครดิต

ผู้ดูแลระบบ

Rank: 9Rank: 9Rank: 9

เครดิต
3094




ยกมาทั้งตระกูล Visual Basic กันเลยทีเดียว แต่ทว่าโค้ดที่แอดมินจะแจกนี้ เขียนเป็น ฟังค์ชั่นในการแปลงเอาไว้ให้อยู่ใน VB6 ที่เหลือก็ตัดแปะนำไปใช้งานกันเอาตามสบายครับ ซึ่งสามารถรองรับจำนวนตัวเลขระดับล้านล้านได้ เว่อร์วังอลังการมาก คำอธิบายจะอยู่ในโค้ด ซึ่งแอดมินพยายามแจกแจงอธิบายรายละเอียดยิบกันเลยทีเดียว ...

มาดูโค้ดกันเถอะ ...
  1. ' / --------------------------------------------------------------------------------------
  2. ' / Developer : Mr.Surapon Yodsanga (Thongkorn Tubtimkrob)
  3. ' / eMail : [email protected]
  4. ' / URL: http://www.g2gnet.com (Khon Kaen - Thailand)
  5. ' / Facebook: https://www.facebook.com/g2gnet (For Thailand)
  6. ' / Facebook: https://www.facebook.com/commonindy (Worldwide)
  7. ' / Purpose : Convert numerical to Thai word.
  8. ' / Microsoft Visual Basic 6.0 (SP6)
  9. ' /
  10. ' / This is open source code under @CopyLeft by Thongkorn Tubtimkrob.
  11. ' / You can modify and/or distribute without to inform the developer.
  12. ' / --------------------------------------------------------------------------------------
  13. Option Explicit

  14. ' / --------------------------------------------------------------------------------------
  15. Private Sub cmdConvert_Click()
  16.     txtThaiWord.Text = "" ' เคลียร์ค่าผลลัพธ์
  17.     txtThaiWord.Text = NumberToThaiWord(txtNumber.Text)
  18. End Sub

  19. ' / --------------------------------------------------------------------------------------
  20. Private Sub Form_Load()
  21.     txtNumber.Text = "9999999999101" '"365001.23"
  22.     txtThaiWord.Text = ""
  23. End Sub

  24. ' / --------------------------------------------------------------------------------------
  25. ' / ฟังค์ชั่นในการแปลงตัวเลขให้เป็นจำนวนภาษาไทย
  26. ' / การเรียกใช้งาน :ให้ส่งค่ามาแบบ String
  27. ' / NumberToThaiWord("1234.55")
  28. ' / NumberToThaiWord(ตัวแปร)
  29. Function NumberToThaiWord(strNumber As String) As String
  30. ' / --------------------------------------------------------------------------------------
  31.     Dim strThaiBaht  As String
  32.     Dim strThaiStang As String
  33.     '// คำประจำหลัก
  34.     Dim arrUnit(6) As String
  35.     arrUnit(0) = ""
  36.     arrUnit(1) = "สิบ"
  37.     arrUnit(2) = "ร้อย"
  38.     arrUnit(3) = "พัน"
  39.     arrUnit(4) = "หมื่น"
  40.     arrUnit(5) = "แสน"
  41.     arrUnit(6) = "ล้าน"
  42.     '// แยกเงินบาทกับสตางค์ออกจากกันด้วยเครื่องหมายทศนิยม
  43.     Dim strBaht As String, strStang As String
  44.     Dim arrNum As Variant
  45.     '// เช็คว่ามีจุดทศนิยมด้วยหรือไม่
  46.     If InStr(strNumber, ".") <> 0 Then
  47.         arrNum = Split(strNumber, ".")
  48.         '// บาท
  49.         strBaht = CDbl(arrNum(0))
  50.         '// สตางค์
  51.         strStang = arrNum(1)
  52.     Else
  53.         strBaht = CDbl(strNumber)
  54.         strStang = 0
  55.     End If
  56.    
  57.     Dim i As Byte
  58.     '// หาหลักล้าน
  59.     Dim Million As Byte
  60.     If (Len(strBaht) >= 7) Then
  61.         Million = Len(strBaht) - 6
  62.         '/ หาหลักที่เกินล้าน
  63.         For i = 1 To Million
  64.             If Mid$(strBaht, i, 1) <> 0 Then strThaiBaht = strThaiBaht + ThaiDigit(Mid$(strBaht, i, 1)) + arrUnit(Million - i)
  65.         Next
  66.         strThaiBaht = strThaiBaht + "ล้าน"
  67.     End If
  68.    
  69.     '// หาเงินส่วนที่ไม่เกินล้าน
  70.     'strBaht = Trim(Right(arrNum(0), 6))
  71.     strBaht = Trim(Right(strBaht, 6))
  72.     '// คิดจำนวนเต็มก่อน
  73.     For i = 1 To Len(strBaht)
  74.         '// ดักค่าก่อนว่าหลักนั้นๆต้องมีค่าไม่ใช่ 0 เพื่อไม่ให้มีคำประจำหลักติดมา เช่น ...
  75.         '// 301 จะต้องข้ามหลักสิบไป
  76.         If Mid$(strBaht, i, 1) <> 0 Then
  77.             '// วิธีการคิด ...
  78.             '// ThaiDigit(Mid$(strBaht, i, 1)) คือ การรับค่าตัวเลขทีละหลักจากซ้ายไปขวา แล้วส่งไปเทียบค่าภาษาไทย
  79.             '// เช่น 321
  80.             '// รอบที่ 1 เมื่อ i = 1 ก็เลือกเอาเฉพาะหลักซ้ายมือสุด Mid("321", 1, 1) = 1 ตรงกับ "สาม"
  81.             '// รอบที่ 2 เมื่อ i = 2 ก็เลือกเอาเฉพาะหลักที่สอง Mid("321", 2, 1) = 2 ตรงกับ "สอง"
  82.             '// รอบที่ 3 เมื่อ i = 3 ก็เลือกเอาเฉพาะหลักที่สาม Mid("321", 3, 1) = 1 ตรงกับ "หนึ่ง"
  83.             
  84.             '// arrUnit(Len(strBaht) - i) คือ คำประจำหลัก
  85.             '// เช่น 321 มีความยาว หรือ Len(strBaht) = 3
  86.             '// รอบที่ 1 เมื่อ i = 1 ก็เอา Len(strBaht)= 3 ลบออกจากค่า i = 1 ตรงกับ arrUnit(2) = "ร้อย"
  87.             '// รอบที่ 2 เมื่อ i = 2 ก็เอา Len(strBaht)= 3 ลบออกจากค่า i = 2 ตรงกับ arrUnit(1) = "สิบ"
  88.             '// รอบที่ 3 เมื่อ i = 3 ก็เอา Len(strBaht)= 3 ลบออกจากค่า i = 3 ตรงกับ arrUnit(0) = "" (หลักหน่วยปล่อยว่าง)
  89.             strThaiBaht = strThaiBaht & ThaiDigit(Mid$(strBaht, i, 1)) & arrUnit(Len(strBaht) - i)
  90.             '// strThaiBaht = "สามร้อยสองสิบหนึ่ง"
  91.         End If
  92.     Next
  93.     '// คำสุดท้ายคือคำลงท้ายด้วย "หนึ่ง" สำหรับการอ่านตัวเลขมากกว่า 2 หลักขึ้นไป
  94.     '// เช่น 1001, 5001, 65001
  95.     If Len(strBaht) > 1 And Right$(strThaiBaht, 5) = "หนึ่ง" Then
  96.         '// ตัดคำว่า "หนึ่ง" (มีความยาว 5 อักขระ) แล้วต่อท้ายด้วยคำว่า "เอ็ด"
  97.         strThaiBaht = Mid$(strThaiBaht, 1, Len(strThaiBaht) - 5) & "เอ็ด"
  98.     End If
  99.    
  100.     ' / --------------------------------------------------------------------------------------
  101.     '// หาค่าสตางค์ แต่ต้องเช็คก่อนว่ามีหน่วยสตางค์ด้วยหรือไม่
  102.     If strStang <> 0 Then
  103.         '// หาความยาวของสตางค์
  104.         'LenNum = Len(strStang)
  105.         '// กรณีสตางค์มีหลักเดียว ก็ใส่สิบตามหลังทันที
  106.         If Len(strStang) = 1 Then
  107.             strThaiStang = strThaiStang + ThaiDigit(Mid$(strStang, 1, 1)) + "สิบ"
  108.         Else
  109.             For i = 1 To Len(strStang)
  110.                 If Mid$(strStang, i, 1) <> 0 Then
  111.                     strThaiStang = strThaiStang + ThaiDigit(Mid(strStang, i, 1)) + arrUnit(Len(strStang) - i)
  112.                 End If
  113.             Next
  114.         End If
  115.     End If
  116.    
  117.     '// รวมบาทและสตางค์เข้าด้วยกัน
  118.     If strStang <> 0 Then
  119.         strThaiBaht = strThaiBaht + "บาท" + strThaiStang + "สตางค์"
  120.     Else
  121.         '// ไม่มีเศษสตางค์
  122.         strThaiBaht = strThaiBaht + "บาทถ้วน"
  123.     End If
  124.    
  125.     '// ต้องเปลี่ยนคำบางคำเพื่อให้ตรงกับภาษาไทยก่อน
  126.     '// เมื่อค่าอินพุท คือ 321 ทำให้ได้ ...
  127.     '// strThaiBaht = "สามร้อยสองสิบหนึ่ง"
  128.     '// "สองสิบ" จะเป็น "ยี่สิบ" ทำให้ได้คำใหม่ คือ "สามร้อยยี่สิบหนึ่ง"
  129.     '// "สิบหนึ่ง" จะเป็น "สิบเอ็ด" ทำให้ได้คำใหม่ คือ "สามร้อยยี่สิบเอ็ด"
  130.     '// หรือจะคิดที่คำว่า "สิบหนึ่ง" ก่อนก็จะได้คำตอบเหมือนเดิม
  131.     strThaiBaht = Replace(strThaiBaht, "หนึ่งสิบ", "สิบ")
  132.     strThaiBaht = Replace(strThaiBaht, "สิบหนึ่ง", "สิบเอ็ด")
  133.     strThaiBaht = Replace(strThaiBaht, "สองสิบ", "ยี่สิบ")
  134.     strThaiBaht = Replace(strThaiBaht, "ร้อยหนึ่ง", "ร้อยเอ็ด")
  135.     '// คืนค่ากลับ
  136.     '// คำตอบสุดท้าย คือ "สามร้อยยี่สิบเอ็ด"
  137.     '//MsgBox "ตัวเลข : " & strBaht & vbCrLf & strThaiBaht
  138.     NumberToThaiWord = strThaiBaht
  139. End Function

  140. ' / --------------------------------------------------------------------------------------
  141. '// ฟังค์ชั่นรับค่าตัวเลขแต่ละหลักเข้ามา และคืนค่ากลับเป็นภาษาไทย
  142. Function ThaiDigit(Num As Byte) As String
  143.     Select Case Num
  144.         Case 0: ThaiDigit = "ศูนย์"
  145.         Case 1: ThaiDigit = "หนึ่ง"
  146.         Case 2: ThaiDigit = "สอง"
  147.         Case 3: ThaiDigit = "สาม"
  148.         Case 4: ThaiDigit = "สี่"
  149.         Case 5: ThaiDigit = "ห้า"
  150.         Case 6: ThaiDigit = "หก"
  151.         Case 7: ThaiDigit = "เจ็ด"
  152.         Case 8: ThaiDigit = "แปด"
  153.         Case 9: ThaiDigit = "เก้า"
  154.     End Select
  155. End Function

  156. ' / --------------------------------------------------------------------------------------
  157. ' / ส่วนของเหตุการณ์ (Event) ในการดักการกดคีย์
  158. Private Sub txtNumber_KeyPress(KeyAscii As Integer)
  159. ' / --------------------------------------------------------------------------------------
  160.     '/ ส่งค่าคีย์ที่กดไปตรวจสอบที่ฟังค์ชั่น และต้อง Return ค่ากลับมาด้วย
  161.     '/ ฟังค์ชั่นที่กดตัวเลข 0 - 9 และ . ทศนิยมสามารถมีได้เพียงจุดเดียวเท่านั้น
  162.     KeyAscii = CheckCurrency(KeyAscii, txtNumber)
  163. End Sub

  164. ' / --------------------------------------------------------------------------------------
  165. ' / ฟังค์ชั่นที่ใช้ล็อคค่าการกดคีย์ และตรวจสอบเรื่องจุดทศนิยม
  166. ' / แต่เป็นการรับค่าแบบ Control หรือ Object แทน หรือ Pass By Reference
  167. ' / ซึ่งวิธีการนี้เราสามารถนำไปดัดแปลงใช้งานได้หลากหลาย ทำให้โปรแกรมของเรามีความยืดหยุ่น
  168. Function CheckCurrency(Index As Integer, Ctrl As TextBox) As Integer
  169. ' / --------------------------------------------------------------------------------------
  170.     Select Case Index
  171.         Case 48 To 57
  172.             ' 0 - 9 and Return index = KeyAscii
  173.         Case 8
  174.             ' Back Space and Return index = KeyAscii
  175.         Case 13
  176.             ' Enter and Return index = KeyAscii
  177.         Case 46 ' รหัส Ascii Code  ของเครื่องหมายจุดครับพี่น้อง
  178.             If InStr(Ctrl, ".") Then Index = 0 ' ใช้ฟังค์ชั่น InStr (In String) เพื่อหาเครื่องหมายจุดใน TextBox
  179.         Case Else
  180.             Index = 0
  181.     End Select
  182.     CheckCurrency = Index ' Return ค่ากลับตามที่ได้ตรวจสอบ
  183. End Function

  184. ' / --------------------------------------------------------------------------------------
  185. '/  แก้ปัญหาฟังค์ชั่น SendKeys ใน Windows 8 64 บิต
  186. Public Sub Sendkeys(Text As String, Optional Wait As Boolean = False)
  187.     Dim WshShell As Object
  188.     Set WshShell = CreateObject("Wscript.shell")
  189.     WshShell.Sendkeys Text, Wait
  190.     Set WshShell = Nothing
  191. End Sub
คัดลอกไปที่คลิปบอร์ด


ดาวน์โหลดโค้ด VB6 ฉบับเต็มได้ที่นี่ ...




ขออภัย! โพสต์นี้มีไฟล์แนบหรือรูปภาพที่ไม่ได้รับอนุญาตให้คุณเข้าถึง

คุณจำเป็นต้อง ลงชื่อเข้าใช้ เพื่อดาวน์โหลดหรือดูไฟล์แนบนี้ คุณยังไม่มีบัญชีใช่ไหม? ลงทะเบียน

x
สิ่งที่ดีกว่าการให้ คือการให้แบบไม่มีที่สิ้นสุด

0

กระทู้

52

โพสต์

233

เครดิต

Full Member

Rank: 3Rank: 3

เครดิต
233
โพสต์ 2018-11-10 11:53:52 | ดูโพสต์ทั้งหมด

ขอบพระคุณมากครับผม

0

กระทู้

14

โพสต์

42

เครดิต

Newbie

Rank: 1

เครดิต
42
โพสต์ 2020-4-20 16:28:42 | ดูโพสต์ทั้งหมด

ขอบคุณครับ
ขออภัย! คุณไม่ได้รับสิทธิ์ในการดำเนินการในส่วนนี้ กรุณาเลือกอย่างใดอย่างหนึ่ง ลงชื่อเข้าใช้ | ลงทะเบียน

รายละเอียดเครดิต

ข้อความล้วน|อุปกรณ์พกพา|ประวัติการแบน|G2GNet.com  

GMT+7, 2020-10-1 11:06 , Processed in 0.355773 second(s), 4 queries , File On.

Powered by Discuz! X3.3 R20170401, Rev.54

© 2001-2017 Comsenz Inc.

ตอบกระทู้ ขึ้นไปด้านบน ไปที่หน้ารายการกระทู้