自訂函數 (VB6)

出自 ProgWiki
前往: 導覽搜尋

Byte操作相關

ByteLen

Public Function ByteLen(strSrc As String) As Integer
Dim LenDest, i, c, LenSrc As Integer
    LenDest = 0
    LenSrc = Len(strSrc)
    For i = 1 To LenSrc
        c = AscW(Mid(strSrc, i, 1))
        If ((c > 128) Or (c < -128)) Then
            LenDest = LenDest + 2
        Else
            LenDest = LenDest + 1
        End If
    Next i
    ByteLen = LenDest
End Function

ByteMid

Public Function ByteMid(sreSrc As String, start As Integer, length As Integer) As String
Dim LenDest, i, c, LenSrc, PosEnd As Integer
Dim strDest As String
    LenDest = 0
    strDest = ""
    PosEnd = start + length - 1
    LenSrc = Len(strSrc)
    For i = 1 To LenSrc
        c = AscW(Mid(strSrc, i, 1))
        If ((c > 128) Or (c < -128)) Then
            LenDest = LenDest + 2 
        Else
            LenDest = LenDest + 1 
        End If
        If ((LenDest >= start) And (LenDest <= PosEnd)) Then
            strDest = strDest + Mid(strSrc, i, 1)
        Else
            If (LenDest > PosEnd) Then
                Exit For
            End If
        End If
    Next i
    ByteMid = strDest
End Function

Data或Time相關

GetSysDateStr

  • 取得系統日期, 以字串方式
Public Function GetSysDateStr(strFormat As String) As String
Dim NowDate As Date
 
    NowDate = Date
    GetSysDateStr = FormatDateStr(NowDate, strFormat)
End Function

FormatDateStr

  • 格式化日期, 以字串方式
Public Function FormatDateStr(myDate As Date, strFormat As String) As String
Dim NowDate As Date
Dim strRet As String
 
    NowDate = myDate
    strRet = strFormat
 
    '年(4碼=西元年, 3碼=民國年, 2碼=西元年後2碼)
    If (InStr(1, strFormat, "yyyy") >= 1) Then
        strRet = Replace(strRet, "yyyy", Format(Year(NowDate), "0000"))
    ElseIf (InStr(1, strFormat, "yyy") >= 1) Then
        strRet = Replace(strRet, "yyy", Format(Year(NowDate) - 1911, "000"))
    ElseIf (InStr(1, strFormat, "yy") >= 1) Then
        strRet = Replace(strRet, "yy", Mid(Format(Year(NowDate), "0000"), 3, 2))
    End If
 
    '月
    If (InStr(1, strFormat, "mm") >= 1) Then
        strRet = Replace(strRet, "mm", Format(Month(NowDate), "00"))
    End If
 
    '日
    If (InStr(1, strFormat, "dd") >= 1) Then
        strRet = Replace(strRet, "dd", Format(Day(NowDate), "00"))
    End If
 
    FormatDateStr = strRet
End Function

CheckDateStr

  • 撿查日期的字串是否合理
Public Function CheckDateStr(strDate As String, strFormat As String) As Boolean
Dim yy As Integer
Dim mm As Integer
Dim dd As Integer
Dim pos As Integer
 
    yy = 0
    mm = 0
    dd = 0
 
    '年(4碼=西元年,3碼=民國年,2碼=西元年後2碼)
    pos = InStr(1, strFormat, "yyyy")
    If (pos >= 1) Then
        yy = Val(Mid(strDate, pos, 4))
    Else
        pos = InStr(1, strFormat, "yyy")
        If (pos >= 1) Then
            yy = Val(Mid(strDate, pos, 3)) + 1911
        Else
            pos = InStr(1, strFormat, "yy")
            If (pos >= 1) Then
                yy = Val(Mid(strDate, pos, 2))
                If (yy <= 29) Then
                    yy = yy + 2000
                Else
                    yy = yy + 1900
                End If
            End If
        End If
    End If
 
    '月
    pos = InStr(1, strFormat, "mm")
    If (pos >= 1) Then
        mm = Val(Mid(strDate, pos, 2))
    End If
 
    '日
     pos = InStr(1, strFormat, "dd")
    If (pos >= 1) Then
        dd = Val(Mid(strDate, pos, 2))
    End If
 
    If (yy <= 1900 Or yy >= 2100 Or mm <= 0 Or mm > 12) Then
        CheckDateStr = False
    ElseIf (dd <= 0 Or dd > 31) Then
        CheckDateStr = False
    ElseIf (mm = 4 Or mm = 6 Or mm = 9 Or mm = 11) And (dd > 30) Then
        CheckDateStr = False
    ElseIf (mm = 2 And dd > 29) Then
        CheckDateStr = False
    ElseIf (mm = 2 And dd > 28) And (IsLeapYear(yy) = False) Then
        CheckDateStr = False
    Else
        CheckDateStr = True
    End If
 
End Function

IsLeapYear

Public Function IsLeapYear(yy As Integer) As Boolean
   '4年1閏, 100年不閏, 400年又潤
   If (yy Mod 4 = 0) And ((yy Mod 100 <> 0) Or (yy Mod 400 = 0)) Then
      IsLeapYear = True
   Else
      IsLeapYear = False
   End If
End Function

GetDaysPerYearMonth

  • 取得該月的總天數
Public Function GetDaysPerYearMonth(yy As Integer, mm As Integer) As Integer
    If (mm = 1 Or mm = 3 Or mm = 5 Or mm = 7 Or mm = 8 Or mm = 10 Or mm = 12) Then
        GetDaysPerYearMonth = 31
    ElseIf (mm = 4 Or mm = 6 Or mm = 9 Or mm = 11) Then
        GetDaysPerYearMonth = 30
    ElseIf (mm = 2) Then
        If (IsLeapYear(yy) = True) Then
            GetDaysPerYearMonth = 29
        Else
            GetDaysPerYearMonth = 28
        End If
    Else
        '異常, 月份不在1~12之間
        GetDaysPerYearMonth = 0
    End If
End Function

DateParse

  • 日期的字串, 反轉回Date
Public Function DateParse(strDate As String, strFormat As String) As Date
Dim yy As Integer
Dim mm As Integer
Dim dd As Integer
Dim pos As Integer
 
    yy = 2000
    mm = 1
    dd = 1
 
    '年(4碼=西元年,3碼=民國年,2碼=西元年後2碼)
    pos = InStr(1, strFormat, "yyyy")
    If (pos>=1) Then
        yy = Val(Mid(strDate, pos, 4))
    Else
        pos = InStr(1, strFormat, "yyy")
        If (pos>=1) Then
            yy = Val(Mid(strDate, pos, 3)) + 1911
        Else
            pos = InStr(1, strFormat, "yy")
            If (pos>=1) Then
                yy = Val(Mid(strDate, pos, 2)) 
                If (yy<=29) then
                    yy = yy + 2000
                Else
                    yy = yy + 1900
                End If
            End If
        End If
    End If
 
    '月
    pos = InStr(1, strFormat, "mm")
    If (pos>=1) Then
        mm = Val(Mid(strDate, pos, 2))
    End If
 
    '日
     pos = InStr(1, strFormat, "dd")
    If (pos>=1) Then
        dd = Val(Mid(strDate, pos, 2))
    End If
 
    'DateParse = CDate(Format(yy, "0000")+"/"+Format(mm, "00")+"/"+Format(dd, "00"))
    DateParse = DateSerial(yy, mm, dd)
 
End Function

Number相關

GetNumberStr

  • 傳回數字的字串(1.英文模式, 2.中文小寫(補○,), 3.中文大寫(補零), 4.中文小寫(口語), 5.中文大寫(口語))
Public Function GetNumberStr(number As Long, nType As Integer) As String
Dim strRet As String
Dim x As Long
Dim Lv As Integer
Dim mod10000 As Integer  '0~9999
Dim mod1000 As Integer   '0~999
Dim mod100 As Integer    '0~99
Dim mod10 As Integer     '0~9
Dim x4 As Integer        '千位
Dim x3 As Integer        '百位
Dim x2 As Integer        '十位
Dim strUnit() As String
Dim strTens() As String
Dim strNum() As String
Dim IsZero As Boolean
Dim IsZeroLv As Boolean
 
    If (nType = 1) Then
        strUnit() = Split("One,Hundred,Thousand,Million,Billion,Trillion", ",")
        strTens() = Split("One,Ten,Twenty,Thirty,Forty,Fifty,Sixty,Seventy,Eighty,Ninety", ",")
        strNum() = Split("Zero,One,Two,Three,Four,Five,Six,Seven,Eight,Nine,Ten,Eleven,Twelve,Thirteen,Fourteen,Fifteen,Sixteen,Seventeen,Eighteen,Nineteen", ",")
 
    ElseIf (nType = 2 Or nType = 3 Or nType = 4 Or nType = 5) Then
        strUnit() = Split("個,萬,億,兆,京", ",")
        If (nType = 2 Or nType = 4) Then
            strTens() = Split("個,十,百,千", ",")
            strNum() = Split("○,一,二,三,四,五,六,七,八,九", ",")
        Else
            strTens() = Split("個,拾,佰,仟", ",")
            strNum() = Split("零,壹,貳,參,肆,伍,陸,柒,捌,玖", ",")
        End If
    End If
 
    strRet = ""
    x = number
    Lv = 0
 
    Select Case nType
        Case 1
            If (x = 0) Then
                strRet = strNum(0)
            End If
 
            While (x > 0)
                mod1000 = (x Mod 1000)       '0~999
                mod100 = (mod1000 Mod 100)   '0~99
                mod10 = (mod1000 Mod 10)     '0~9
 
                x3 = (mod1000 / 100)         '百位
                x2 = (mod100 / 10)           '十位
 
                If (Lv > 0) Then
                    strRet = strUnit(Lv) + " " + strRet
                End If
 
                If (mod100 > 0) Then
                    If (mod100 <= 19) Then
                        strRet = strNum(mod100) + " " + strRet
                    Else
                        If (mod10 > 0) Then
                            strRet = strTens(x2) + " " + strNum(mod10) + " " + strRet
                        Else
                            strRet = strTens(x2) + " " + strRet
                        End If
                    End If
                End If
 
                If (x3 > 0) Then
                    strRet = strNum(x3) + " " + strUnit(1) + " " + strRet
                End If
 
                x = x / 1000
                Lv = Lv + 1
            Wend
 
        Case 2, 3
            If (x = 0) Then
                strRet = strNum(0)
            End If
            While (x > 0)
                mod10000 = (x Mod 10000)     '0~9999
                mod1000 = (x Mod 1000)       '0~999
                mod100 = (mod1000 Mod 100)   '0~99
                mod10 = (mod1000 Mod 10)     '0~9
 
                x4 = (mod10000 / 1000)       '千位
                x3 = (mod1000 / 100)         '百位
                x2 = (mod100 / 10)           '十位
 
                If (Lv > 0) Then
                    strRet = strUnit(Lv) + strRet
                End If
 
                x = x / 10000
                Lv = Lv + 1
 
                If (mod10 > 0) Then
                    strRet = strNum(mod10) + strRet
                ElseIf (mod10 = 0 And (x > 0 Or x2 > 0 Or x3 > 0 Or x4 > 0)) Then
                    strRet = strNum(0) + strRet
                End If
 
                If (x2 > 0) Then
                    strRet = strNum(x2) + strTens(1) + strRet
                ElseIf (x2 = 0 And (x > 0 Or x3 > 0 Or x4 > 0)) Then
                    strRet = strNum(0) + strTens(1) + strRet
                End If
 
                If (x3 > 0) Then
                    strRet = strNum(x3) + strTens(2) + strRet
                ElseIf (x2 = 0 And (x > 0 Or x4 > 0)) Then
                    strRet = strNum(0) + strTens(2) + strRet
                End If
 
                If (x4 > 0) Then
                    strRet = strNum(x4) + strTens(3) + strRet
                ElseIf (x2 = 0 And (x > 0 Or x4 > 0)) Then
                    strRet = strNum(0) + strTens(3) + strRet
                End If
            Wend
 
        Case 4, 5
            If (x = 0) Then
                strRet = strNum(0)
            End If
            While (x > 0)
                mod10000 = (x Mod 10000)     '0~9999
                mod1000 = (x Mod 1000)       '0~999
                mod100 = (mod1000 Mod 100)   '0~99
                mod10 = (mod1000 Mod 10)     '0~9
 
                x4 = (mod10000 / 1000)       '千位
                x3 = (mod1000 / 100)         '百位
                x2 = (mod100 / 10)           '十位
 
                If (Lv > 0) Then
                    If (mod10000 > 0) Then
                        If (IsZero = True) Then
                            strRet = strNum(0) + strRet
                            IsZeroLv = True
                        End If
                        strRet = strUnit(Lv) + strRet
                    Else
                        IsZero = True
                        IsZeroLv = False
                    End If
                Else
                    IsZeroLv = False
                End If
 
                x = x / 10000
                Lv = Lv + 1
 
                If (mod10 > 0) Then
                    strRet = strNum(mod10) + strRet
                    IsZero = False
                ElseIf (mod10 = 0 And (x > 0 Or x2 > 0 Or x3 > 0 Or x4 > 0)) Then
                    IsZero = True
                End If
 
                If (x2 > 0) Then
                    If (x2 = 1) And (x3 = 0 And x4 = 0) Then
                        strRet = strTens(1) + strRet
                    Else
                        strRet = strNum(x2) + strTens(1) + strRet
                    End If
                    IsZero = False
                ElseIf (x2 = 0 And (x > 0 Or x3 > 0 Or x4 > 0)) Then
                    IsZero = True
                End If
 
                If (x3 > 0) Then
                    If (IsZero = True) And (IsZeroLv = False) Then
                        strRet = strNum(0) + strRet
                    End If
                    strRet = strNum(x3) + strTens(2) + strRet
                    IsZero = False
                ElseIf (x3 = 0 And (x > 0 Or x4 > 0)) Then
                    IsZero = True
                End If
 
                If (x4 > 0) Then
                    If (IsZero = True) And (IsZeroLv = False) Then
                        strRet = strNum(0) + strRet
                    End If
                    strRet = strNum(x4) + strTens(3) + strRet
                    IsZero = False
                ElseIf (x2 = 0 And x > 0) Then
                    IsZero = True
                End If
            Wend
 
    End Select
 
    GetNumberStr = Trim(strRet)
End Function

Math相關

GetRound

  • 四捨五入到小數點第幾位數
Public Function GetRound(ByVal num As Currency, ByVal n As Long) As Currency
     If n > 0 Then
          GetRound = Val(Format(num, "0." & String(n, "0")))
     Else
          GetRound = Val(Format(num, "0"))
     End If
End Function