Attribute VB_Name = "modConvert"
Option Explicit
Public Function GenNowString() As String
Dim tmpResult As String
tmpResult = Format(Now, "yyyy/MM/dd hh:mm:ss")
GenNowString = tmpResult
End Function
Public Function FormatDbl(tmpDouble As Double) As String
Dim tmpResult As String
tmpResult = Format(tmpDouble, "#0.0000")
FormatDbl = tmpResult
End Function
Public Function cuHex(tmpNum As Long) As String
Dim tmpResult As String
tmpResult = cuStr(Hex(tmpNum))
If Len(tmpResult) Mod 2 <> 0 Then
tmpResult = "0" & tmpResult
End If
cuHex = tmpResult
End Function
Public Function cuWeekDayinChinese(tmpDate As Date) As String
Dim tmpResult As String
Select Case Weekday(tmpDate, vbMonday)
Case 1
tmpResult = "星期一"
Case 2
tmpResult = "星期二"
Case 3
tmpResult = "星期三"
Case 4
tmpResult = "星期四"
Case 5
tmpResult = "星期五"
Case 6
tmpResult = "星期六"
Case 7
tmpResult = "星期日"
End Select
cuWeekDayinChinese = tmpResult
End Function
' Handles numbers up to 28-digits long
' (using a String argument when necessary)
Public Function cuDecimaltoBinary(ByVal DecimalIn As Variant, Optional NumberOfBits As Variant) As String
cuDecimaltoBinary = ""
DecimalIn = Int(CDec(DecimalIn))
Do While DecimalIn <> 0
cuDecimaltoBinary = Trim$(Str$(DecimalIn - _
2 * Int(DecimalIn / 2))) & cuDecimaltoBinary
DecimalIn = Int(DecimalIn / 2)
Loop
If Not IsMissing(NumberOfBits) Then
If Len(cuDecimaltoBinary) > NumberOfBits Then
cuDecimaltoBinary = "Error - Number exceeds specified bit size"
Else
cuDecimaltoBinary = Right$(String$(NumberOfBits, _
"0") & cuDecimaltoBinary, NumberOfBits)
End If
End If
End Function
Public Function DecToBin(ByVal DecVal As Byte) As String
Dim i As Integer
Dim sResult As String
sResult = Space(8)
For i = 0 To 7
If DecVal And (2 ^ i) Then
Mid(sResult, 8 - i, 1) = "1"
Else
Mid(sResult, 8 - i, 1) = "0"
End If
Next
DecToBin = sResult
End Function
' Convert this Long value into a binary string.
Public Function cuLongToBinary(ByVal long_value As Long, Optional ByVal separate_bytes As Boolean = True) As String
Dim digit_num As Integer, digit_value As Integer, factor As Integer, Bit As Integer
Dim hex_string As String, nibble_string As String, result_string As String
' Convert into hex.
hex_string = Hex$(long_value)
' Zero-pad to a full 8 characters.
hex_string = Right$(String$(8, "0") & hex_string, 8)
' Read the hexadecimal digits
' one at a time from right to left.
For digit_num = 8 To 1 Step -1
' Convert this hexadecimal digit into a
' binary nibble.
digit_value = CLng("&H" & Mid$(hex_string, _
digit_num, 1))
' Convert the value into bits.
factor = 1
nibble_string = ""
For Bit = 3 To 0 Step -1
If digit_value And factor Then
nibble_string = "1" & nibble_string
Else
nibble_string = "0" & nibble_string
End If
factor = factor * 2
Next Bit
' Add the nibble's string to the left of the
' result string.
result_string = nibble_string & result_string
Next digit_num
' Add spaces between bytes if desired.
If separate_bytes Then
result_string = _
Mid$(result_string, 1, 8) & " " & _
Mid$(result_string, 9, 8) & " " & _
Mid$(result_string, 17, 8) & " " & _
Mid$(result_string, 25, 8)
End If
' Return the result.
cuLongToBinary = result_string
End Function
Public Function cuMintoHour(tmpTotalMin As Long, Optional tmpNoUnit As Boolean = True) As String
Dim tmpHour As Long
Dim tmpFinalMin As Double
Dim tmpResult As String
tmpHour = tmpTotalMin \ 60
tmpFinalMin = tmpTotalMin Mod 60
If tmpNoUnit = True Then
tmpResult = CStr(tmpHour + Round(tmpFinalMin / 60, 4))
Else
If tmpHour > 0 Then
tmpResult = tmpHour & "h"
End If
If tmpFinalMin > 0 Then
tmpResult = tmpResult & tmpFinalMin & "m"
End If
End If
If Len(tmpResult) < 1 Then
If tmpNoUnit = False Then
tmpResult = "0h"
Else
tmpResult = 0
End If
End If
cuMintoHour = tmpResult
End Function
Public Function cuMintoDay(tmpTotalMin As Long) As String
Dim tmpDay As Integer
Dim tmpHour As Integer
Dim tmpMin As Integer
Dim tmpFinalMin As Integer
Dim tmpResult As String
tmpDay = tmpTotalMin \ 1440
tmpFinalMin = tmpTotalMin Mod 1440
tmpHour = tmpFinalMin \ 60
tmpFinalMin = tmpTotalMin Mod 60
If tmpDay > 0 Then
tmpResult = tmpDay & "d "
End If
If tmpHour > 0 Then
tmpResult = tmpResult & tmpHour & "h "
End If
If tmpFinalMin > 0 Then
tmpResult = tmpResult & tmpFinalMin & "m"
End If
If Len(tmpResult) < 1 Then
tmpResult = "0m"
End If
cuMintoDay = tmpResult
End Function
Public Function cuAddSlash(tmpData1 As String, tmpData2 As String) As String
If Len(Trim(tmpData1)) > 0 And Len(Trim(tmpData2)) > 0 Then
cuAddSlash = tmpData1 & " / " & tmpData2
Else
If Len(Trim(tmpData1)) > 0 Then
cuAddSlash = tmpData1
ElseIf Len(Trim(tmpData2)) > 0 Then
cuAddSlash = tmpData2
End If
End If
End Function
Public Function cuTimetoStr(tmpData As Variant) As String
Dim tmpResult As String
If IsNull(tmpData) = True Then
tmpResult = Empty
Else
tmpResult = TimeValue(CDate(tmpData))
End If
cuTimetoStr = tmpResult
End Function
Public Function ChkDouble(tmpValue As String) As String
Dim tmpResult As String
Dim blnDecimal As Boolean
Dim intX As Integer
blnDecimal = False
tmpResult = Empty
tmpValue = Trim(tmpValue)
If Len(tmpValue) > 0 Then
For intX = 1 To Len(tmpValue)
If Mid(tmpValue, intX, 1) = "." Then
If blnDecimal = False Then
tmpResult = tmpResult & Mid(tmpValue, intX, 1)
blnDecimal = True
End If
Else
If Asc(Mid(tmpValue, intX, 1)) >= 48 Or Asc(Mid(tmpValue, intX, 1)) <= 57 Then
tmpResult = tmpResult & Mid(tmpValue, intX, 1)
End If
End If
Next intX
If blnDecimal = True And Mid(tmpResult, 1, 1) = "." Then tmpResult = "0" & tmpResult
Else
tmpResult = "0"
End If
ChkDouble = tmpResult
End Function
Public Function ConvDate(DateIn As String, Optional ShowToday As Boolean) As String
Dim stDate As String
Dim dDate As Date
stDate = Format(DateIn, "yyyy-MM-dd")
If IsDate(stDate) Then
dDate = DateAdd("d", 0, CDate(stDate))
ConvDate = Format(dDate, "yyyy-MM-dd")
Else
If ShowToday = True Then
ConvDate = Format(Date, "yyyy-MM-dd")
Else
ConvDate = ""
End If
End If
End Function
Public Function cuValueNull(tmpData As String) As String
If Len(tmpData) > 0 Then
cuValueNull = tmpData
Else
cuValueNull = "null"
End If
End Function
Public Function cuNulltoZero(tmpData As Variant) As String
If IsNull(tmpData) Then
cuNulltoZero = "0"
Else
cuNulltoZero = tmpData
End If
End Function
Public Function cuIsNumericNull(tmpData As Variant) As Variant
If IsNull(tmpData) Then
cuIsNumericNull = 0
Else
cuIsNumericNull = tmpData
End If
End Function
Public Function cuStr(InputStr As Variant) As String
If IsNull(InputStr) = True Then
cuStr = Empty
Else
cuStr = Trim(Replace(CStr(InputStr), vbTab, " "))
End If
End Function
Public Function cuLong(InputStr As Variant) As Long
On Error GoTo ErrCuLong
Dim tmpInputStr As String
Dim intX As Integer
If IsNull(InputStr) = True Then
cuLong = 0
Else
tmpInputStr = ""
For intX = 1 To Len(InputStr)
If Asc(Mid(InputStr, intX, 1)) > 47 And Asc(Mid(InputStr, intX, 1)) < 58 Then
tmpInputStr = tmpInputStr + Mid(InputStr, intX, 1)
End If
Next
If Len(InputStr) > 1 And Left(InputStr, 1) = "-" Then tmpInputStr = "-" & tmpInputStr
cuLong = CLng(tmpInputStr)
End If
Exit Function
ErrCuLong:
cuLong = 0
End Function
Public Function cuVal(InputStr As Variant) As Long '不接受小數點
On Error GoTo ErrCuVal
Dim tmpInputStr As String
Dim intX As Integer
If IsNull(InputStr) = True Then
cuVal = 0
Else
tmpInputStr = ""
For intX = 1 To Len(InputStr)
If Asc(Mid(InputStr, intX, 1)) > 47 And Asc(Mid(InputStr, intX, 1)) < 58 Then
tmpInputStr = tmpInputStr + Mid(InputStr, intX, 1)
End If
Next
If Len(InputStr) > 1 And Left(InputStr, 1) = "-" Then tmpInputStr = "-" & tmpInputStr
cuVal = Val(tmpInputStr)
End If
Exit Function
ErrCuVal:
cuVal = 0
End Function
Public Function cuNoFormat(InputStr As String) As String
Dim tmpStr As String
Dim intX As Integer
Dim tmpResult As Double
tmpStr = Empty
If Len(InputStr) > 0 Then
For intX = 1 To Len(InputStr)
If Mid(InputStr, intX, 1) <> "," Then
tmpStr = tmpStr & Mid(InputStr, intX, 1)
End If
Next
Else
tmpStr = "0"
End If
cuNoFormat = tmpStr
End Function
Public Function GetFinalDecimalPart(tmpDecimalPart As String, Optional ByVal iPrecision As Integer = 0, Optional ByVal CalMethod As Integer = 4) As String
Dim tmpCurrValue As Integer
Dim tmpAddValue As Integer
Dim tmpResult As String
Dim i As Integer
If Len(tmpDecimalPart) > 1 Then
tmpAddValue = 0
tmpResult = Empty
For i = Len(tmpDecimalPart) To iPrecision + 2 Step -1
If Val(Mid(tmpDecimalPart, i, 1)) + tmpAddValue > CalMethod Then
tmpCurrValue = 0
tmpAddValue = 1
Else
tmpCurrValue = Val(Mid(tmpDecimalPart, i, 1)) + tmpAddValue
tmpAddValue = 0
End If
tmpResult = Str(tmpCurrValue) & Trim(tmpResult)
Next
If iPrecision > 0 Then
For i = iPrecision + 1 To 1 Step -1 ' 新寫法, 可解決進數的問題
If Val(Mid$(tmpDecimalPart, i, 1)) + tmpAddValue = 10 Then
tmpResult = "0" & Trim(tmpResult)
tmpAddValue = 1
Else
If i = 1 Then
tmpResult = "1." & Trim(tmpResult)
Else
tmpResult = Left$(tmpDecimalPart, i - 1) & Trim(Str(Val(Mid$(tmpDecimalPart, i, 1)) + tmpAddValue)) & Trim(tmpResult)
End If
Exit For
End If
Next
Else
If tmpAddValue = 1 Then
tmpResult = "1." & Trim(tmpResult)
Else
tmpResult = "." & Trim(tmpResult)
End If
End If
End If
GetFinalDecimalPart = tmpResult
End Function
Public Function cuRound(ByVal dVal As Double, Optional ByVal iPrecision As Integer = 0, Optional ByVal CalMethod As Integer = 4, Optional ByVal DecimalMethod As Integer = 1) As Double
Dim roundStr As String
Dim WholeNumberPart As String
Dim DecimalPart As String
Dim tmpNegative As Boolean
Dim i As Integer
Dim RoundUpValue As Double
'roundStr = CStr(dVal
' If iPrecision > 12 Then
' roundStr = FormatNumber(dVal, 20)
' Else
' roundStr = Format(dVal, "0.0###########")
' End If
roundStr = CStr(CDec(dVal)) '科學記數法會出現問題 CDEC
If iPrecision < 0 Then iPrecision = 0
If InStr(1, roundStr, ".") = -1 Or InStr(1, roundStr, ".") = 0 Then
cuRound = dVal
Exit Function
End If
WholeNumberPart = Mid$(roundStr, 1, InStr(1, roundStr, ".") - 1)
DecimalPart = Mid$(roundStr, (InStr(1, roundStr, ".")))
If Len(DecimalPart) > iPrecision + 1 Then
If DecimalMethod = 1 Then DecimalPart = GetFinalDecimalPart(DecimalPart, iPrecision, CalMethod)
If Left$(DecimalPart, 1) = "1" Then
If Sgn(Val(WholeNumberPart)) = -1 Then
WholeNumberPart = CStr(Val(WholeNumberPart) - 1)
Else
WholeNumberPart = CStr(Val(WholeNumberPart) + 1)
End If
DecimalPart = ""
Else
Select Case Val(Mid$(DecimalPart, iPrecision + 2, 1))
'Case "0", "1", "2", "3", "4"
Case Is <= CalMethod
DecimalPart = Mid$(DecimalPart, 1, iPrecision + 1)
'Case "5", "6", "7", "8", "9"
Case Else
If iPrecision = 0 Then
RoundUpValue = 1
Else
RoundUpValue = 0.1
For i = 1 To iPrecision - 1
RoundUpValue = RoundUpValue * 0.1
Next
End If
DecimalPart = CStr(Val(Mid$(DecimalPart, 1, iPrecision + 1)) + RoundUpValue)
If Mid$(DecimalPart, 1, 1) <> "1" Then
DecimalPart = Mid$(DecimalPart, 2)
Else
If Sgn(Val(WholeNumberPart)) = -1 Then
WholeNumberPart = CStr(Val(WholeNumberPart) - 1)
Else
WholeNumberPart = CStr(Val(WholeNumberPart) + 1)
End If
DecimalPart = ""
End If
End Select
End If
End If
cuRound = Val(WholeNumberPart & DecimalPart)
End Function
Public Function cuDatetoDbl(InputStr As String) As Double
Dim tmpResult As Double
On Error GoTo ErrcuDatetoDbl
If Len(InputStr) < 1 Then
cuDatetoDbl = CDbl(Date)
Else
cuDatetoDbl = CDbl(CDate(InputStr))
End If
Exit Function
ErrcuDatetoDbl:
cuDatetoDbl = CDbl(Date)
End Function
Public Function SetFormatStr(tmpLength) As String
Dim intX As Integer
Dim tmpResult As String
tmpResult = "#,###."
If tmpLength > 0 Then
For intX = 1 To tmpLength
tmpResult = tmpResult + "0"
Next
Else
tmpResult = tmpResult + "#"
End If
SetFormatStr = tmpResult
End Function
Public Function cuDbl(InputStr As Variant) As Double
On Error GoTo ErrcuDbl
Dim tmpResult As Double
If Len(InputStr) < 1 Then
cuDbl = 0
Else
cuDbl = CDbl(InputStr)
End If
Exit Function
ErrcuDbl:
cuDbl = 0
End Function
Public Function cuCurrency(InputStr As String) As Currency
On Error GoTo ErrcuCurrency
Dim tmpResult As Double
If Len(InputStr) < 1 Then
cuCurrency = 0
Else
cuCurrency = CCur(InputStr)
End If
Exit Function
ErrcuCurrency:
cuCurrency = 0
End Function
Public Function cuBoolToInt(Inputvalue As Boolean) As Integer
On Error GoTo ErrHandler
If Inputvalue = True Then
cuBoolToInt = 1
Else
cuBoolToInt = 0
End If
Exit Function
ErrHandler:
cuBoolToInt = 0
End Function
Public Function cuBool(InputStr As String) As Boolean
On Error GoTo ErrHandler
If IsNull(InputStr) = True Or CBool(InputStr) = False Then
cuBool = False
Else
If CBool(InputStr) = True Then
cuBool = True
Else
cuBool = False
End If
End If
Exit Function
ErrHandler:
cuBool = False
End Function
Public Function cuDatetoStr(tmpDate As Date) As String
Dim tmpStr As String
tmpStr = CStr(Year(tmpDate))
If Month(tmpDate) < 10 Then tmpStr = tmpStr & "0" & CStr(Month(tmpDate)) Else tmpStr = tmpStr & CStr(Month(tmpDate))
If Day(tmpDate) < 10 Then tmpStr = tmpStr & "0" & CStr(Day(tmpDate)) Else tmpStr = tmpStr & CStr(Day(tmpDate))
If Len(tmpStr) = 8 Then cuDatetoStr = tmpStr Else cuDatetoStr = "0"
End Function
Public Function cuNulltoFalse(tmpStr As String) As Integer
If IsNull(tmpStr) = True Then
cuNulltoFalse = 0
Else
cuNulltoFalse = Val(tmpStr)
End If
End Function
Public Function cuDbltoDateTime(tmpDouble As Variant) As String
On Error GoTo ErrCuDbltoDateTime
If IsNull(tmpDouble) = True Or tmpDouble = 0 Then
cuDbltoDateTime = ""
Else
If Len(gstrDateTimeFormat) > 0 Then
cuDbltoDateTime = CStr(Format(CDate(tmpDouble), gstrDateTimeFormat))
Else
cuDbltoDateTime = CStr(CDate(tmpDouble))
End If
End If
Exit Function
ErrCuDbltoDateTime:
cuDbltoDateTime = Empty
End Function
Public Function cuDbltoDate(tmpDouble As Variant) As String
On Error GoTo ErrCuDbltoDate
If IsNull(tmpDouble) = True Or tmpDouble = 0 Then
cuDbltoDate = ""
Else
If Len(gstrDateFormat) > 0 Then
cuDbltoDate = CStr(Format(CDate(tmpDouble), gstrDateFormat))
Else
cuDbltoDate = CStr(CDate(tmpDouble))
End If
End If
Exit Function
ErrCuDbltoDate:
cuDbltoDate = Empty
End Function
Public Function cuDblDifftoShowDateDiff(tmpDouble As Double) As String
On Error GoTo ErrcuDblDifftoShowDateDiff
Dim tmpDay As Date
Dim tmpTime As String
tmpTime = Format(tmpDouble, "hh:mm:ss")
If Int(tmpDouble) > 0 Then
cuDblDifftoShowDateDiff = Int(tmpDouble) & "day " & Hour(tmpTime) & "h " & Minute(tmpTime) & "m " & Second(tmpTime) & "s"
Else
cuDblDifftoShowDateDiff = Hour(tmpTime) & "h " & Minute(tmpTime) & "m " & Second(tmpTime) & "s"
End If
Exit Function
ErrcuDblDifftoShowDateDiff:
cuDblDifftoShowDateDiff = Empty
End Function
Public Function cuTime(tmpDouble As Variant) As Date
On Error GoTo ErrCuTime
If IsNull(tmpDouble) = True Then
cuTime = ""
Else
cuTime = TimeValue(CDate(tmpDouble))
End If
Exit Function
ErrCuTime:
cuTime = Empty
End Function
Public Function cuDbltoTime(tmpDouble As Variant) As String
On Error GoTo ErrCuDbltoTime
If IsNull(tmpDouble) = True Then
cuDbltoTime = ""
Else
cuDbltoTime = CStr(Format(TimeValue(CDate(tmpDouble)), "AMPM HH:mm"))
End If
Exit Function
ErrCuDbltoTime:
cuDbltoTime = Empty
End Function
Public Function cuYearBegin(tmpDate As Date) As Double
Dim tmpResult As Double
Dim tmpString As String
tmpString = Year(tmpDate) & "/1/1"
tmpResult = CDbl(CDate(tmpString))
cuYearBegin = tmpResult
End Function
Public Function cuYearEnd(tmpDate As Date) As Double
Dim tmpResult As Double
Dim tmpString As String
tmpString = Year(tmpDate) & "/12/31"
tmpResult = CDbl(CDate(tmpString))
cuYearEnd = tmpResult
End Function
Public Function cuMonthBegin(tmpDate As Date) As Double
Dim tmpResult As Double
Dim tmpString As String
tmpString = Year(tmpDate) & "/" & Month(tmpDate) & "/" & "1"
tmpResult = CDbl(CDate(tmpString))
cuMonthBegin = tmpResult
End Function
Public Function cuMonthEnd(tmpDate As Date) As Double
Dim tmpResult As Double
Dim tmpString As String
Dim tmpDay As String
Select Case Month(tmpDate)
Case 1, 3, 5, 7, 8, 10, 12
tmpDay = "31"
Case 4, 6, 9, 11
tmpDay = "30"
Case 2
If Year(tmpDate) Mod 3200 = 0 Then
tmpDay = "28"
Else
If Year(tmpDate) Mod 100 = 0 And Year(tmpDate) Mod 400 <> 0 Then
tmpDay = "28"
Else
If Year(tmpDate) Mod 4 = 0 Then
tmpDay = "29"
Else
tmpDay = "28"
End If
End If
End If
End Select
tmpString = Year(tmpDate) & "/" & Month(tmpDate) & "/" & tmpDay
tmpResult = CDbl(CDate(tmpString))
cuMonthEnd = tmpResult
End Function
Public Function cuIsDate(tmpStr As String) As Boolean
On Error GoTo ErrCuIsDate
'If IsDate(CDate(tmpStr)) = True Then
If IsDate(tmpStr) = True Then
cuIsDate = True
Else
cuIsDate = False
End If
Exit Function
ErrCuIsDate:
cuIsDate = False
End Function
Public Function cuFixStrToDate(tmpStr As String) As Date
On Error GoTo ErrHandler
Dim tmpResult As Date
tmpResult = CDate(Left(tmpStr, Len(tmpStr) - 2))
cuFixStrToDate = tmpResult
Exit Function
ErrHandler:
cuFixStrToDate = 0
End Function
Public Function cuStrtoDate(tmpStr As String) As Date
On Error GoTo ErrCuStrToDate
Dim tmpDate As Date
tmpDate = CDate(tmpStr)
cuStrtoDate = tmpDate
Exit Function
ErrCuStrToDate:
cuStrtoDate = 0
End Function
Public Function cuStrtoDateDbl(tmpStr As String) As Double
Dim tmpDate As Date
Dim tmpResult As Double
On Error GoTo ErrCuStrToDateDbl
tmpDate = CDate(tmpStr)
tmpResult = CDbl(tmpDate)
cuStrtoDateDbl = tmpResult
Exit Function
ErrCuStrToDateDbl:
cuStrtoDateDbl = 0
End Function
