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