Bogart gFunction.vb

Module gFunction

    '其它不是常用的方法及函數



#Region " 將指定的數據格式轉換為英文格式"



    Public Function EnglishFormat(ByVal intNum As Double, ByVal blnMoney As Boolean) As String

        On Error GoTo err

        Dim strNum As String

        Dim intStart As Integer

        Dim strInt As String       '整數位

        Dim strDec As String       '小數位



        strNum = Trim(Str(System.Math.Round(intNum, 2)))

        intStart = InStr(1, strNum, ".")

        If intStart > 0 Then

            '取出數據中的整數部分

            strInt = Mid(strNum, 1, intStart - 1)

            '取出數據中的小數部分

            strDec = Mid(strNum, intStart + 1)

        Else

            '表如沒有小數位數

            strInt = strNum

            strDec = ""

        End If

        If blnMoney = True Then

            EnglishFormat = JoinNum(strInt) & readDec1(strDec)

        Else

            EnglishFormat = JoinNum(strInt) & IIf(JoinNum(strInt) = "", Mid(readDec2(strDec), 6), readDec2(strDec)) & " ONLY"

        End If

        Exit Function

err:

        EnglishFormat = "ZERO"

    End Function



    '數字轉為英文字符

    Private Function changeNumber(ByVal intI As String) As String

        Select Case Int(intI)

            Case 0

                changeNumber = "ZERO"

            Case 1

                changeNumber = "ONE"

            Case 2

                changeNumber = "TWO"

            Case 3

                changeNumber = "THREE"

            Case 4

                changeNumber = "FOUR"

            Case 5

                changeNumber = "FIVE"

            Case 6

                changeNumber = "SIX"

            Case 7

                changeNumber = "SEVEN"

            Case 8

                changeNumber = "EIGHT"

            Case 9

                changeNumber = "NINE"

            Case 10

                changeNumber = "TEN"

            Case 11

                changeNumber = "ELEVEN"

            Case 12

                changeNumber = "TWELVE"

            Case 13

                changeNumber = "THIRTEEN"

            Case 14

                changeNumber = "FOURTEEN"

            Case 15

                changeNumber = "FIFTEEN"

            Case 16

                changeNumber = "SIXTEEN"

            Case 17

                changeNumber = "SEVENTEEN"

            Case 18

                changeNumber = "EIGHTEEN"

            Case 19

                changeNumber = "NINETEEN"

            Case 20

                changeNumber = "TWENTY"

            Case 30

                changeNumber = "THIRTY"

            Case 40

                changeNumber = "FORTY"

            Case 50

                changeNumber = "FIFTY"

            Case 60

                changeNumber = "SIXTY"

            Case 70

                changeNumber = "SEVENTY"

            Case 80

                changeNumber = "EIGHTY"

            Case 90

                changeNumber = "NINETY"

            Case 100

                changeNumber = "HUNDRED"

        End Select

    End Function



    'N1 讀取小數部分(普通數據格式)

    Private Function readDec1(ByVal intInt As String) As String

        On Error Resume Next

        Dim intlen As Integer

        Dim strNum As String

        Dim intN As String

        intlen = Len(intInt)

        Dim i As Integer

        If intlen = 0 Then Exit Function

        For i = 1 To intlen

            '從右至左分別將每個數字轉為英文

            intN = Mid(intInt, intlen + 1 - i, 1)

            strNum = changeNumber(intN) & " " & strNum

        Next i

        '如小數部分存在則在前加上'point'

        If strNum = "" Then

            Return strNum

        Else

            Return " POINT " & strNum

        End If

    End Function



    'N2讀取小數部分(貨幣格式)

    Private Function readDec2(ByVal intInt As String) As String

        On Error Resume Next



        Dim intlen As Integer

        Dim strNum As String

        Dim intG As String

        Dim i As Integer

        If Len(intInt) = 0 Then

            Exit Function

        ElseIf Len(intInt) = 1 Then

            intInt = intInt & "0"

        End If

        Dim intN As String

        intlen = Len(intInt)

        For i = 1 To intlen

            '從右至左分別將每個數字轉為英文

            intN = Mid(intInt, intlen + 1 - i, 1)

            Select Case i

                Case 1      '個位數

                    If intN > 0 Then

                        strNum = changeNumber(intN)

                    Else

                        strNum = ""

                    End If

                    intG = intN

                Case 2      '十位數

                    If intN > 0 Then

                        If intN < 2 Then

                            strNum = changeNumber(intN & intG)

                        Else

                            If strNum <> "" Then

                                strNum = changeNumber(intN & "0") & "-" & strNum

                            Else

                                strNum = changeNumber(intN & "0")

                            End If

                        End If

                    End If

            End Select

        Next i

        If strNum = "" Then

            Return strNum

        Else

            Return " AND " & strNum & " CENTS"

        End If



    End Function





    '取給定數據的個位,十和百位

    '返回的值為 n thousand

    Private Function read123(ByVal intInt As String) As String

        Dim intlen As Integer

        Dim strNum As String

        intlen = Len(intInt)

        Dim i As Integer

        Dim intN As String

        Dim intG As String

        For i = 1 To intlen

            intN = Mid(intInt, intlen + 1 - i, 1)

            Select Case i

                Case 1      '個位數

                    If intN > 0 Then

                        strNum = changeNumber(intN)

                    Else

                        strNum = ""

                    End If

                    intG = intN

                Case 2      '十位數

                    If intN > 0 Then

                        If intN < 2 Then        '因為英文數字1到19無規則

                            strNum = changeNumber(intN & intG)

                        Else

                            If strNum <> "" Then

                                strNum = changeNumber(intN & "0") & "-" & strNum

                            Else

                                strNum = changeNumber(intN & "0")

                            End If

                        End If

                    End If

                Case 3      '百位數

                    If intN > 0 Then

                        strNum = changeNumber(intN) & " HUNDRED " & strNum

                    End If

            End Select

        Next i

        read123 = strNum

    End Function



    '取給定數據的千位,十千和百千位

    '返回的值為 n thousand



    Private Function read456(ByVal intInt As String) As String

        Dim intlen As Integer

        Dim strNum As String

        intlen = Len(intInt)

        Dim i As Integer

        Dim intN As String

        Dim intG As String

        For i = 1 To intlen

            intN = Mid(intInt, intlen + 1 - i, 1)

            Select Case i

                Case 4      '個位數

                    If intN > 0 Then

                        strNum = changeNumber(intN)

                    Else

                        strNum = ""

                    End If

                    intG = intN

                Case 5      '十位數

                    If intN > 0 Then

                        If intN < 2 Then

                            strNum = changeNumber(intN & intG)

                        Else

                            If strNum <> "" Then

                                strNum = changeNumber(intN & "0") & "-" & strNum

                            Else

                                strNum = changeNumber(intN & "0")

                            End If

                        End If

                    End If

                Case 6      '百位數

                    If intN > 0 Then

                        strNum = changeNumber(intN) & " HUNDRED " & strNum

                    End If

            End Select

        Next i

        If strNum = "" Then

            read456 = ""

        Else

            read456 = strNum & " THOUSAND "

        End If

    End Function



    '取給定數據中的一個百萬位,十個百萬位和千個百萬位

    '返回的值為 n million

    Private Function read789(ByVal intInt As String) As String

        Dim intlen As Integer

        Dim strNum As String

        intlen = Len(intInt)

        Dim i As Integer

        Dim intN As String

        Dim intG As String          '存儲臨時的數據

        For i = 1 To intlen

            intN = Mid(intInt, intlen + 1 - i, 1)

            Select Case i

                Case 7     '個位數

                    '表示個位數在不為0時

                    If intN > 0 Then

                        strNum = changeNumber(intN)

                    Else

                        strNum = ""

                    End If

                    intG = intN

                Case 8      '十位數

                    If intN > 0 Then

                        If intN < 2 Then   '表十位數為1-19間

                            strNum = changeNumber(intN & intG)

                        Else

                            If strNum <> "" Then

                                strNum = changeNumber(intN & "0") & "-" & strNum

                            Else

                                strNum = changeNumber(intN & "0")

                            End If

                        End If

                    End If

                Case 9      '百位數

                    If intN > 0 Then

                        strNum = changeNumber(intN) & " HUNDRED " & strNum

                    End If

            End Select

        Next i

        If strNum = "" Then

            read789 = ""

        Else

            read789 = strNum & "MILLION "

        End If

    End Function



    '合閾整數部分

    Private Function JoinNum(ByVal strNum As String) As String

        Dim str123 As String

        Dim str456 As String

        Dim str789 As String

        str123 = read123(strNum)

        str456 = read456(strNum)

        str789 = read789(strNum)



        If str123 <> "" And str456 <> "" Then

            str456 = read456(strNum) & "AND "

        End If

        If str456 <> "" And str789 <> "" Then

            str789 = read789(strNum) & "AND "

        End If

        Return (str789 & str456 & str123).Trim



    End Function



    Private Function getValidChars(ByVal strSRC As String) As String

        Dim i As Integer = strSRC.IndexOf(" ")

        If i > 0 Then

            Return ((strSRC & "********").Substring(0, i) & "******").Substring(0, 6) & "~1"

        Else

            Return strSRC

        End If

    End Function

#End Region



#Region " 單位轉換函數"

    '單位轉換函數,返回值為轉換系數,如無法轉換則返回-1

    ' Example: uomconv('CM','M') = 0.01  

    ' Usage:   uomconv(fm_uom,to_uom)



    Public Overloads Function uomconv(ByVal var1 As String, ByVal var2 As String) As Double

        If var1 = var2 Then Return 1

        Dim var3 As Double = -1

        Dim rst As ADODB.Recordset

        Dim m As Integer

        Dim ds As New DataSet



        Dim da As New OleDb.OleDbDataAdapter("select frunm,tounm,mltdiv,unmcvt from pcfunmb", netConn)

        da.Fill(ds)

        Dim dv As New DataView(ds.Tables(0), "", "frunm,tounm,mltdiv", DataViewRowState.CurrentRows)

        'dv.Sort = "frunm,tounm,mltdiv"

        Dim var(2) As Object



        Try

            var(0) = var1

            var(1) = var2

            var(2) = 1

            m = dv.Find(var)

            If m > 0 Then

                var3 = dv(m).Item("unmcvt")

            Else

                var(2) = 2

                m = dv.Find(var)

                If m > 0 Then

                    var3 = 1 / dv(m).Item("unmcvt")

                Else

                    var(0) = var2

                    var(1) = var1

                    var(2) = 1

                    m = dv.Find(var)

                    If m > 0 Then

                        var3 = 1 / dv(m).Item("unmcvt")

                    Else

                        var(2) = 2

                        m = dv.Find(var)

                        If m > 0 Then

                            var3 = dv(m).Item("unmcvt")

                        End If

                    End If

                End If

            End If

            dv = Nothing

            ds = Nothing

            Return var3



        Catch ex As Exception

            Return -1

        End Try



        'Try

        '    rst = New ADODB.Recordset

        '    rst.Open("select unmcvt from pcfunmb where frunm='" + var1 + "' and tounm='" + var2 + "' and mltdiv=1 order by unmcvt", adoConn)

        '    If rst.RecordCount > 0 Then

        '        For m = 0 To rst.RecordCount - 1

        '            var3 = rst.Fields("unmcvt").Value

        '            rst.MoveNext()

        '        Next

        '    Else

        '        rst = Nothing

        '        rst = New ADODB.Recordset

        '        rst.Open("select 1/unmcvt as unmcvt from pcfunmb where frunm='" + var1 + "' and tounm='" + var2 + "' and mltdiv = 2 order by unmcvt", adoConn)

        '        If rst.RecordCount > 0 Then

        '            For m = 0 To rst.RecordCount - 1

        '                var3 = rst.Fields("unmcvt").Value

        '                rst.MoveNext()

        '            Next

        '        Else

        '            rst = Nothing

        '            rst = New ADODB.Recordset

        '            rst.Open("select 1/unmcvt as unmcvt from pcfunmb where frunm='" + var2 + "' and tounm='" + var1 + "' and mltdiv = 1 order by unmcvt", adoConn)

        '            If rst.RecordCount > 0 Then

        '                For m = 0 To rst.RecordCount - 1

        '                    var3 = rst.Fields("unmcvt").Value

        '                    rst.MoveNext()

        '                Next

        '            Else

        '                rst = Nothing

        '                rst = New ADODB.Recordset

        '                rst.Open("select unmcvt as unmcvt from pcfunmb where frunm='" + var2 + "' and tounm='" + var1 + "' and mltdiv = 2 order by unmcvt", adoConn)

        '                If rst.RecordCount > 0 Then

        '                    For m = 0 To rst.RecordCount - 1

        '                        var3 = rst.Fields("unmcvt").Value

        '                        rst.MoveNext()

        '                    Next

        '                End If

        '            End If

        '        End If

        '    End If

        '    rst = Nothing

        '    Return var3

        'Catch ex As Exception

        '    rst = Nothing

        '    Return -1

        'End Try



    End Function



    '單位轉換函數,返回值為轉換系數,如無法轉換則返回-1

    ' Example2: uomconv('M','LB','CM','GSM') = 0.01    

    ' Usage:    uomconv(fm_uom,to_uom,std width,weight)

    '                    M,    LB/KG, CM,       GSM





    Public Overloads Function uomconv(ByVal var1 As String, ByVal var2 As String, ByVal var3 As String, ByVal var4 As String) As Double

        If var1 = var2 Then Return 1



        Dim v1, v2, v3, v4 As Double

        v1 = 1

        v2 = 1

        v3 = 1

        v4 = 1



        Dim rst As ADODB.Recordset

        Dim m As Integer



        If var1 <> "M" Then

            v1 = uomconv(var1, "M")

            If v1 < 0 Then Return -1

        End If



        If var2 <> "LB" Or var2 <> "KG" Then

            v2 = uomconv(var2, "KG")

            If v2 < 0 Then

                v2 = uomconv(var2, "LB")

                If v2 < 0 Then

                    Return -1

                Else

                    v2 = v2 * uomconv("LB", "KG") * uomconv("KG", "GM")

                End If

            Else

                v2 = v2 * uomconv("KG", "GM")

            End If

        Else

            If var2 = "LB" Then

                v2 = uomconv("LB", "KG") * uomconv("KG", "GM")

            ElseIf var2 = "KG" Then

                v2 = uomconv("KG", "GM")

            End If

        End If

        If v2 < 0 Then Return -1



        v3 = uomconv(var3, "M")

        If v3 < 0 Then Return -1



        v4 = uomconv(var4, "GSM")

        If v4 < 0 Then Return -1

        Return (v1 * v3 * v4 / v2)

    End Function



    Public Function GetInvQty(ByVal RMCode As String, ByVal Type As String, ByVal UOM As String, ByVal PurQty As Double, Optional ByVal DefaultValue As Double = 0) As Double

        Try

            Dim InvUom As String = gData.selectValue(" select a.unm from phfrmt a where a.sug='" & Trim(Rmcode) & "'", adoConn)

            Dim PurQty1 As Double = Val(PurQty)

            If (Trim(UOM) = "LB" Or Trim(UOM) = "KG") And (InvUom <> "LB" And InvUom <> "KG") Then

                Dim weight As Double = gData.selectValue("select WEIGHT from PHFRMTP  where sug='" & Trim(Rmcode) & "' and ovy='" & Trim(Type) & "'", adoConn, 0)



                Dim UOM1 As String = gData.selectValue("select WIDUNM from PHFRMTP where sug='" & Trim(Rmcode) & "' and ovy='" & Trim(Type) & "'", adoConn, 0)



                Dim STDWID As Double = gData.selectValue("select  STDWID from PHFRMTP where sug='" & Trim(Rmcode) & "' and ovy='" & Trim(Type) & "'", adoConn, 0)



                If Trim(UOM) = "LB" Then

                    If UOM1 = "CM" Then

                        PurQty1 = 45360 * Val(PurQty1) / (Val(weight) * Val(STDWID))

                    Else

                        If UOM1 = "MM" Then

                            PurQty1 = 453600 * Val(PurQty1) / (Val(weight) * Val(STDWID))

                        Else

                            PurQty1 = 0

                        End If

                    End If

                Else

                    If UOM1 = "CM" Then

                        PurQty1 = 100000 * Val(PurQty1) / (Val(weight) * Val(STDWID))

                    Else

                        If UOM1 = "MM" Then

                            PurQty1 = 1000000 * Val(PurQty1) / (Val(weight) * Val(STDWID))

                        Else

                            PurQty1 = 0

                        End If

                    End If

                End If

            Else

                Dim unmRate As Double = gData.selectValue("select unmcvt from pcfunmb where frunm='" & Trim(UOM) & "' and tounm='" & Trim(InvUom) & "'", adoConn, 0)

                PurQty1 = PurQty1 * Val(unmRate)

            End If



            Return Format(PurQty1, "0.0000")

        Catch ex As Exception

            Return DefaultValue

            Exit Function

        End Try

    End Function



    Public Function GetPurQty(ByVal Sug As String, ByVal OVY As String, ByVal PurUnit As String, ByVal InvUnit As String, ByVal InvQty As Double) As Double

        Dim PurQty1 As Double = Val(InvQty)

        If PurUnit.Trim.ToUpper() = InvUnit.Trim.ToUpper() Then

            Return Format(PurQty1, "0.000")

            Exit Function

        End If



        If (Trim(PurUnit) = "LB" Or Trim(PurUnit) = "KG") And (Trim(InvUnit) <> "LB" And Trim(InvUnit) <> "KG") Then

            Dim weight As Double = CDbl(gData.SelectValue("select WEIGHT from PHFRMTP where sug='" & Trim(Sug) & "' and ovy='" & Trim(OVY) & "'", netConn, "0"))

            Dim UOM1 As String = gData.SelectValue("select WIDUNM from PHFRMTP where sug='" & Trim(Sug) & "' and ovy='" & Trim(OVY) & "'", netConn, "0")

            Dim STDWID As Double = CDbl(gData.SelectValue("select STDWID from PHFRMTP where sug='" & Trim(Sug) & "' and ovy='" & Trim(OVY) & "'", netConn, "0"))



            If Trim(PurUnit) = "LB" Then

                If UOM1 = "CM" Then

                    PurQty1 = (Val(PurQty1) * (Val(weight) * Val(STDWID))) / 45360

                Else

                    If UOM1 = "MM" Then

                        PurQty1 = (Val(PurQty1) * (Val(weight) * Val(STDWID))) / 453600

                    Else

                        PurQty1 = 0

                    End If

                End If

            Else

                If UOM1 = "CM" Then

                    PurQty1 = Val(PurQty1) * (Val(weight) * Val(STDWID)) * 0.00001

                Else

                    If UOM1 = "MM" Then

                        PurQty1 = 0.000001 * Val(PurQty1) * (Val(weight) * Val(STDWID))

                    Else

                        PurQty1 = 0

                    End If

                End If

            End If

        Else

            Dim dt As DataTable = gData.GetDataTable("select FRUNM, TOUNM, UNMCVT, MLTDIV from  PCFUNMB where FRUNM='" & InvUnit.Trim() & "' and TOUNM='" & PurUnit.Trim() & "'", netConn)

            If dt.Rows.Count = 1 Then 

                Dim rUnit As DataRow = dt.Rows(0)

                If CStr(rUnit("MLTDIV")) = "1" Then

                    PurQty1 = PurQty1 * rUnit("UNMCVT")

                Else

                    If rUnit("UNMCVT") <> 0 Then

                        PurQty1 = PurQty1 / rUnit("UNMCVT")

                    Else

                        PurQty1 = 0

                    End If

                End If

            Else

                PurQty1 = 0

            End If

        End If

        Return Format(PurQty1, "0.000")

    End Function



#End Region



#Region "月份轉換,英文簡寫式"

    Public Function MonthEnglishFormat(ByVal M As Int16) As String

        Dim StrM As String

        Select Case M

            Case 1

                StrM = "JAN"

            Case 2

                StrM = "FEB"

            Case 3

                StrM = "MAR"

            Case 4

                StrM = "APR"

            Case 5

                StrM = "MAY"

            Case 6

                StrM = "JUN"

            Case 7

                StrM = "JUL"

            Case 8

                StrM = "AUG"

            Case 9

                StrM = "SEP"

            Case 10

                StrM = "OCT"

            Case 11

                StrM = "NOV"

            Case 12

                StrM = "DEC"

            Case Else

                StrM = "ERROR"

        End Select

        Return StrM

    End Function

#End Region



End Module

 

你可能感兴趣的:(function)