chmoney.bas

煤炭销售管理系统.完成煤炭销售的日常管理工作,和重车计量系统空车计量系统配合使用.

Attribute VB_Name = "ChMoney1"
' 本模块生成汉字大写的金额
' 由   Ken Jin   制作
'      VB 加油站 提供
Option Explicit '      vbtt.yeah.netPublic LoginSucceeded As Boolean
Public Const NOTSRCCOPY = &H330008
Public Const NOTSRCERASE = &H1100A6
Public Const SRCAND = &H8800C6
Public Const SRCCOPY = &HCC0020
Public Const SRCERASE = &H440328
Public Const SRCINVERT = &H660046
Public Const SRCPAINT = &HEE0086
'Public Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
'Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public LoginSucceeded As Boolean

Public Declare Function mciExecute Lib "winmm.dll" (ByVal lpstrCommand As String) As Long

Public Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long



' 名称： CCh
'        得到一位数字 N1 的汉字大写
'        0 返回 ""
Private Function CCh(n1) As String
Select Case n1
  Case 0
    CCh = "零"
  Case 1
    CCh = "壹"
  Case 2
    CCh = "贰"
  Case 3
    CCh = "叁"
  Case 4
    CCh = "肆"
  Case 5
    CCh = "伍"
  Case 6
    CCh = "陆"
  Case 7
    CCh = "柒"
  Case 8
    CCh = "捌"
  Case 9
    CCh = "玖"
End Select
End Function


'名称： ChMoney
'       得到数字 N1 的汉字大写
'       最大为 千万位
'       O 返回 ""
Public Function ChMoney2(n1) As String
Dim tMoney As String
Dim lMoney As String
Dim tn '小数位置
Dim s1 As String '临时STRING 小数部分
Dim s2 As String '1000 以内
Dim s3 As String '10000

Dim st1, t1 As String

If n1 = 0 Then
  ChMoney2 = " "
  Exit Function
End If
If n1 < 0 Then
  ChMoney2 = "负" + ChMoney2(Abs(n1))
  Exit Function
End If
tMoney = Trim(Str(n1))
tn = InStr(tMoney, ".")  '小数位置
s1 = ""

If tn <> 0 Then
  st1 = Right(tMoney, Len(tMoney) - tn)
  If st1 <> "" Then
    t1 = Left(st1, 1)
    st1 = Right(st1, Len(st1) - 1)
    If t1 <> "0" Then
      s1 = s1 + CCh(Val(t1)) + "角"
    End If
    If st1 <> "" Then
     t1 = Left(st1, 1)
     s1 = s1 + CCh(Val(t1)) + "分"
    End If
  End If
  '取整数
  st1 = Left(tMoney, tn - 1)
Else
  st1 = tMoney
End If


s2 = ""
If st1 <> "" Then
  t1 = Right(st1, 1)
  st1 = Left(st1, Len(st1) - 1)
  s2 = CCh(Val(t1)) + s2
End If

If st1 <> "" Then
  t1 = Right(st1, 1)
  st1 = Left(st1, Len(st1) - 1)
  If t1 <> "0" Then
    s2 = CCh(Val(t1)) + "拾" + s2
  Else
    If Left(s2, 1) <> "零" Then s2 = "零" + s2
  End If
End If

If st1 <> "" Then
  t1 = Right(st1, 1)
  st1 = Left(st1, Len(st1) - 1)
  If t1 <> "0" Then
    s2 = CCh(Val(t1)) + "佰" + s2
  Else
    If Left(s2, 1) <> "零" Then s2 = "零" + s2
  End If
End If

If st1 <> "" Then
  t1 = Right(st1, 1)
  st1 = Left(st1, Len(st1) - 1)
  If t1 <> "0" Then
  s2 = CCh(Val(t1)) + "仟" + s2
  Else
    If Left(s2, 1) <> "零" Then s2 = "零" + s2
  End If
End If

s3 = ""
If st1 <> "" Then
  t1 = Right(st1, 1)
  st1 = Left(st1, Len(st1) - 1)
  s3 = CCh(Val(t1)) + s3
End If


If st1 <> "" Then
  t1 = Right(st1, 1)
  st1 = Left(st1, Len(st1) - 1)
  If t1 <> "0" Then
  s3 = CCh(Val(t1)) + "拾" + s3
  Else
    If Left(s3, 1) <> "零" Then s3 = "零" + s3
  End If
End If

If st1 <> "" Then
  t1 = Right(st1, 1)
  st1 = Left(st1, Len(st1) - 1)
  If t1 <> "0" Then
  s3 = CCh(Val(t1)) + "佰" + s3
  Else
   If Left(s3, 1) <> "零" Then s3 = "零" + s3
  End If
End If

If st1 <> "" Then
  t1 = Right(st1, 1)
  st1 = Left(st1, Len(st1) - 1)
  If t1 <> "0" Then
  s3 = CCh(Val(t1)) + "仟" + s3
  End If
End If
If Right(s2, 1) = "零" Then s2 = Left(s2, Len(s2) - 1)
If Len(s3) > 0 Then
  If Right(s3, 1) = "零" Then s3 = Left(s3, Len(s3) - 1)
  s3 = s3 & "万"
End If
If st1 <> "" Then
  t1 = Right(st1, 1)
  st1 = Left(st1, Len(st1) - 1)
  If t1 <> "0" Then
  s3 = CCh(Val(t1)) + "亿" + s3
  End If
End If
If st1 <> "" Then
  t1 = Right(st1, 1)
  st1 = Left(st1, Len(st1) - 1)
  If t1 <> "0" Then
    s3 = CCh(Val(t1)) + "拾" + s3
  Else
    If Left(s3, 1) <> "零" Then s3 = "零" + s2
  End If
End If

ChMoney2 = IIf(s3 & s2 = "", s1, s3 & s2 & "公斤" & s1)

End Function


Public Function ChMoney(n1) As String
Dim tMoney As String
Dim lMoney As String
Dim tn '小数位置
Dim s1 As String '临时STRING 小数部分
Dim s2 As String '1000 以内
Dim s3 As String '10000

Dim st1, t1 As String

If n1 = 0 Then
  ChMoney = " "
  Exit Function
End If
If n1 < 0 Then
  ChMoney = "负" + ChMoney(Abs(n1))
  Exit Function
End If
tMoney = Trim(Str(n1))
tn = InStr(tMoney, ".")  '小数位置
If tn = 0 Then
tMoney = tMoney + ".00"
tn = InStr(tMoney, ".")  '小数位置
End If

s1 = ""

If tn <> 0 Then
  st1 = Right(tMoney, Len(tMoney) - tn)
  If st1 <> "" Then
    t1 = Left(st1, 1)
    st1 = Right(st1, Len(st1) - 1)
    'If t1 <> "0" Then
      s1 = s1 + CCh(Val(t1)) + "角"
    'End If
    'If st1 <> "" Then
     t1 = Left(st1, 1)
     s1 = s1 + CCh(Val(t1)) + "分"
    'End If
  End If
  '取整数
  st1 = Left(tMoney, tn - 1)
Else
  st1 = tMoney
End If


s2 = ""
If st1 <> "" Then
  t1 = Right(st1, 1)
  st1 = Left(st1, Len(st1) - 1)
  s2 = CCh(Val(t1)) + s2
End If

If st1 <> "" Then
  t1 = Right(st1, 1)
  st1 = Left(st1, Len(st1) - 1)
  If t1 <> "0" Then
    s2 = CCh(Val(t1)) + "拾" + s2
  Else
    If Left(s2, 1) <> "零" Then s2 = "零" + s2
  End If
End If

If st1 <> "" Then
  t1 = Right(st1, 1)
  st1 = Left(st1, Len(st1) - 1)
  If t1 <> "0" Then
    s2 = CCh(Val(t1)) + "佰" + s2
  Else
    If Left(s2, 1) <> "零" Then s2 = "零" + s2
  End If
End If

If st1 <> "" Then
  t1 = Right(st1, 1)
  st1 = Left(st1, Len(st1) - 1)
  If t1 <> "0" Then
  s2 = CCh(Val(t1)) + "仟" + s2
  Else
    If Left(s2, 1) <> "零" Then s2 = "零" + s2
  End If
End If

s3 = ""
If st1 <> "" Then
  t1 = Right(st1, 1)
  st1 = Left(st1, Len(st1) - 1)
  s3 = CCh(Val(t1)) + s3
End If


If st1 <> "" Then
  t1 = Right(st1, 1)
  st1 = Left(st1, Len(st1) - 1)
  If t1 <> "0" Then
  s3 = CCh(Val(t1)) + "拾" + s3
  Else
    If Left(s3, 1) <> "零" Then s3 = "零" + s3
  End If
End If

If st1 <> "" Then
  t1 = Right(st1, 1)
  st1 = Left(st1, Len(st1) - 1)
  If t1 <> "0" Then
  s3 = CCh(Val(t1)) + "佰" + s3
  Else
   If Left(s3, 1) <> "零" Then s3 = "零" + s3
  End If
End If

If st1 <> "" Then
  t1 = Right(st1, 1)
  st1 = Left(st1, Len(st1) - 1)
  If t1 <> "0" Then
  s3 = CCh(Val(t1)) + "仟" + s3
  End If
End If
If Right(s2, 1) = "零" Then s2 = Left(s2, Len(s2) - 1)
If Len(s3) > 0 Then
  If Right(s3, 1) = "零" Then s3 = Left(s3, Len(s3) - 1)
  s3 = s3 & "万"
End If
If st1 <> "" Then
  t1 = Right(st1, 1)
  st1 = Left(st1, Len(st1) - 1)
  If t1 <> "0" Then
  s3 = CCh(Val(t1)) + "亿" + s3
  End If
End If
If st1 <> "" Then
  t1 = Right(st1, 1)
  st1 = Left(st1, Len(st1) - 1)
  If t1 <> "0" Then
    s3 = CCh(Val(t1)) + "拾" + s3
  Else
    If Left(s3, 1) <> "零" Then s3 = "零" + s2
  End If
End If

ChMoney = IIf(s3 & s2 = "", s1, s3 & s2 & "元" & s1)

End Function

Public Sub OnlyOne()
    If App.PrevInstance = True Then
        MsgBox "该应用程序已经有一个实例在运行，按“确定”退出！", _
        vbOKOnly Or vbCritical, "运行错误"
        End
    End If
End Sub