stringmodule.bas

适合乡镇供电所使用电费处理系统v3 软件

     s3 = cch(Val(t1)) + "拾" + s3
  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
   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 s3 = "" And s2 = "" Then
   ChMoneyY = s1
Else
   ChMoneyY = s3 & s2 & "元" & s1
End If
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 '
Dim ST1 As String
Dim t1 As String
Dim s3 As String

On Error GoTo Wjs
If N1 = 0 Then
  ChMoney = " "
  Exit Function
End If
If N1 < 0 Then
  ChMoney = "负" + ChMoney(Abs(N1))
  Exit Function
End If
tMoney = Trim(Format(Str(N1), "0.00")) & " "
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))
    Else
      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


's1 = "元" + s1
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(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
  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 Len(s3) > 0 Then
  If Right(s3, 1) = "零" Then s3 = Left(s3, Len(s3) - 1)
  s3 = s3
End If
ChMoney = s3 & s2 & IIf(s1 = "", "零零", s1)

Exit Function

Wjs:
   MsgBox "电费有误，未计算！"
   Resume Next
End Function


Public Function ChM(N1) As String
Dim tMoney As String
Dim lMoney As String
Dim tn
Dim s1 As String '临时STRING 小数部分
Dim s2 As String '
Dim ST1 As String
Dim t1 As String
Dim s3 As String

On Error GoTo Wjs
If N1 = 0 Then
  ChM = " "
  Exit Function
End If
If N1 < 0 Then
  ChM = "负" + ChM(Abs(N1))
  Exit Function
End If
tMoney = Trim(Format(Str(N1), "0.00")) & " "
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 + CH(Val(t1))
    Else
      s1 = s1 + CH(Val(t1))
    End If
    If ST1 <> "" Then
     t1 = Left(ST1, 1)
     s1 = s1 + CH(Val(t1))
    End If
  End If
  ST1 = Left(tMoney, tn - 1)
Else
  ST1 = tMoney
End If


's1 = "元" + s1
s2 = ""
If ST1 <> "" Then
  t1 = Right(ST1, 1)
  ST1 = Left(ST1, Len(ST1) - 1)
  s2 = CH(Val(t1)) + s2
End If

If ST1 <> "" Then
  t1 = Right(ST1, 1)
  ST1 = Left(ST1, Len(ST1) - 1)
  If t1 <> "0" Then
    s2 = CH(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 = CH(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 = CH(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 = CH(Val(t1)) + s3
End If


If ST1 <> "" Then
  t1 = Right(ST1, 1)
  ST1 = Left(ST1, Len(ST1) - 1)
  If t1 <> "0" Then
  s3 = CH(Val(t1)) + s3
  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
  s3 = CH(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 = CH(Val(t1)) + s3
  End If
End If
If Len(s3) > 0 Then
  If Right(s3, 1) = "零" Then s3 = Left(s3, Len(s3) - 1)
  s3 = s3
End If
ChM = s3 & s2 & IIf(s1 = "", "零零", s1)

Exit Function

Wjs:
   MsgBox "电费有误，未计算！"
   Resume Next
End Function

'本期余额函数
Function BSYE(HjFee As Currency) As Currency
       Dim NextFee As Currency
       If Val(Right(Format(HjFee, "0.00"), 1)) > 4 Then '±
          NextFee = Format(Format(Format(HjFee, "0.00"), "0.0") - Format(HjFee, "0.00"), " -0.00") 'Right(Format(HjFee, "0.00"), 1)
       Else
          If Val(Right(Format(HjFee, "0.00"), 1)) <> 0 Then
             NextFee = Format(HjFee - Val(Format(HjFee, "0.0")), "0.00")
          End If
       End If
       BSYE = NextFee
End Function

'Function BSYE1(HjFee As Currency, JinDu As Integer) As Currency
'    Dim NextFee As Currency, Zs As Currency
'    Zs = Round(HjFee, JinDu)
'    NextFee = HjFee - Zs
'    BSYE1 = Format(NextFee, "0.00")
'End Function


'检测所含字符中的汉字数
Public Function convert_str(mystring As String) As Integer
Dim I As Integer
Dim temp As String
Dim s As String
Dim count_hz As Integer
    temp = ""
    count_hz = 0
    For I = 0 To Len(mystring) - 1
       If Asc(Mid(mystring, I + 1, 1)) < 0 Then
             count_hz = count_hz + 1
             s = s & Mid(mystring, I + 1, 1)
       End If
    Next
    convert_str = count_hz
End Function

'检测所含字符中的汉字,允许英文字母????
Public Function convert_string(mystring As String) As String
Dim I As Integer
Dim temp_string As String
    temp_string = ""
    For I = 0 To Len(mystring) - 1
       If Asc(Mid(mystring, I + 1, 1)) < 0 Or Asc(Mid(mystring, I + 1, 1)) > 64 Then
             '小写英文字母ascii在97-122之间,即a-z,大写英文字母ascii在65-90之间,即A-Z,数字在48-57之间
             If Asc(Mid(mystring, I + 1, 1)) < 97 Or Asc(Mid(mystring, I + 1, 1)) > 122 Then
             temp_string = temp_string & Mid(mystring, I + 1, 1)
             End If
       End If
    Next
    convert_string = temp_string
End Function

Public Function conv_str(mystring As String) As String
Dim I As Integer
Dim temp_string As String
    temp_string = ""
    For I = 0 To Len(mystring) - 1
       If Asc(Mid(mystring, I + 1, 1)) < 0 Or Asc(Mid(mystring, I + 1, 1)) > 64 Or Asc(Mid(mystring, I + 1, 1)) = 48 Or Asc(Mid(mystring, I + 1, 1)) = 49 Or Asc(Mid(mystring, I + 1, 1)) = 50 Or Asc(Mid(mystring, I + 1, 1)) = 51 Or Asc(Mid(mystring, I + 1, 1)) = 52 Or Asc(Mid(mystring, I + 1, 1)) = 53 Or Asc(Mid(mystring, I + 1, 1)) = 54 Or Asc(Mid(mystring, I + 1, 1)) = 55 Or Asc(Mid(mystring, I + 1, 1)) = 56 Or Asc(Mid(mystring, I + 1, 1)) = 57 Then
             temp_string = temp_string & Mid(mystring, I + 1, 1)
       End If
    Next
    conv_str = temp_string
End Function


'检测所含字符中的数字
Public Function convert_Num(mystring As String) As String
Dim I As Integer
Dim temp As String
Dim count_hz As String
    temp = ""
    count_hz = ""
    For I = 0 To Len(mystring) - 1
          Select Case Asc(Mid(mystring, I + 1, 1))
             Case 48
               count_hz = count_hz + "0"
             Case 49
               count_hz = count_hz + "1"
             Case 50
               count_hz = count_hz + "2"
             Case 51
               count_hz = count_hz + "3"
             Case 52
               count_hz = count_hz + "4"
             Case 53
               count_hz = count_hz + "5"
             Case 54
               count_hz = count_hz + "6"
             Case 55
               count_hz = count_hz + "7"
             Case 56
               count_hz = count_hz + "8"
             Case 57
               count_hz = count_hz + "9"
          End Select
    Next
    convert_Num = count_hz
End Function

'检测包含空格字符串中的汉字
Public Function Loca_Space(mystring As String) As Integer
Dim I As Integer
Dim temp As String
Dim count_hz As Integer
    temp = ""
    count_hz = 0
    For I = 0 To Len(mystring) - 1
          If Asc(Mid(mystring, I + 1, 1)) = 32 Then
             count_hz = I
          End If
    Next
    Loca_Space = count_hz + 1
End Function


'将Null结尾字符串转换到VB字符串
Public Function LPSTRToVBString$(ByVal s$)
    Dim nullpos&
    nullpos& = InStr(s$, Chr$(0))
    If nullpos > 0 Then
       LPSTRToVBString = Left$(s$, nullpos - 1)
    Else
       LPSTRToVBString = ""
    End If
End Function

Public Function RemoveBackslash(sFlName As String) As String
    Dim I As Integer
    I = Len(sFlName)
    If I <> 0 Then
       If Right$(sFlName, 1) = "\" Then
          RemoveBackslash = Left$(sFlName, I - 1)
       Else
          RemoveBackslash = sFlName
       End If
    Else
       RemoveBackslash = ""
    End If
End Function