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, )))
intStart = InStr(, strNum, ".")
If intStart > Then
'取出數據中的整數部分
strInt = Mid(strNum, , intStart - )
'取出數據中的小數部分
strDec = Mid(strNum, intStart + )
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), ), 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
changeNumber = "ZERO"
Case
changeNumber = "ONE"
Case
changeNumber = "TWO"
Case
changeNumber = "THREE"
Case
changeNumber = "FOUR"
Case
changeNumber = "FIVE"
Case
changeNumber = "SIX"
Case
changeNumber = "SEVEN"
Case
changeNumber = "EIGHT"
Case
changeNumber = "NINE"
Case
changeNumber = "TEN"
Case
changeNumber = "ELEVEN"
Case
changeNumber = "TWELVE"
Case
changeNumber = "THIRTEEN"
Case
changeNumber = "FOURTEEN"
Case
changeNumber = "FIFTEEN"
Case
changeNumber = "SIXTEEN"
Case
changeNumber = "SEVENTEEN"
Case
changeNumber = "EIGHTEEN"
Case
changeNumber = "NINETEEN"
Case
changeNumber = "TWENTY"
Case
changeNumber = "THIRTY"
Case
changeNumber = "FORTY"
Case
changeNumber = "FIFTY"
Case
changeNumber = "SIXTY"
Case
changeNumber = "SEVENTY"
Case
changeNumber = "EIGHTY"
Case
changeNumber = "NINETY"
Case
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 = Then Exit Function
For i = To intlen
'從右至左分別將每個數字轉為英文
intN = Mid(intInt, intlen + - i, )
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) = Then
Exit Function
ElseIf Len(intInt) = Then
intInt = intInt & ""
End If
Dim intN As String
intlen = Len(intInt)
For i = To intlen
'從右至左分別將每個數字轉為英文
intN = Mid(intInt, intlen + - i, )
Select Case i
Case '個位數
If intN > Then
strNum = changeNumber(intN)
Else
strNum = ""
End If
intG = intN
Case '十位數
If intN > Then
If intN < Then
strNum = changeNumber(intN & intG)
Else
If strNum <> "" Then
strNum = changeNumber(intN & "") & "-" & strNum
Else
strNum = changeNumber(intN & "")
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 = To intlen
intN = Mid(intInt, intlen + - i, )
Select Case i
Case '個位數
If intN > Then
strNum = changeNumber(intN)
Else
strNum = ""
End If
intG = intN
Case '十位數
If intN > Then
If intN < Then '因為英文數字1到19無規則
strNum = changeNumber(intN & intG)
Else
If strNum <> "" Then
strNum = changeNumber(intN & "") & "-" & strNum
Else
strNum = changeNumber(intN & "")
End If
End If
End If
Case '百位數
If intN > 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 = To intlen
intN = Mid(intInt, intlen + - i, )
Select Case i
Case '個位數
If intN > Then
strNum = changeNumber(intN)
Else
strNum = ""
End If
intG = intN
Case '十位數
If intN > Then
If intN < Then
strNum = changeNumber(intN & intG)
Else
If strNum <> "" Then
strNum = changeNumber(intN & "") & "-" & strNum
Else
strNum = changeNumber(intN & "")
End If
End If
End If
Case '百位數
If intN > 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 = To intlen
intN = Mid(intInt, intlen + - i, )
Select Case i
Case '個位數
'表示個位數在不為0時
If intN > Then
strNum = changeNumber(intN)
Else
strNum = ""
End If
intG = intN
Case '十位數
If intN > Then
If intN < Then '表十位數為1-19間
strNum = changeNumber(intN & intG)
Else
If strNum <> "" Then
strNum = changeNumber(intN & "") & "-" & strNum
Else
strNum = changeNumber(intN & "")
End If
End If
End If
Case '百位數
If intN > 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 > Then
Return ((strSRC & "********").Substring(, i) & "******").Substring(, ) & "~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
Dim var3 As Double = -
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(), "", "frunm,tounm,mltdiv", DataViewRowState.CurrentRows)
'dv.Sort = "frunm,tounm,mltdiv"
Dim var() As Object Try
var() = var1
var() = var2
var() =
m = dv.Find(var)
If m > Then
var3 = dv(m).Item("unmcvt")
Else
var() =
m = dv.Find(var)
If m > Then
var3 = / dv(m).Item("unmcvt")
Else
var() = var2
var() = var1
var() =
m = dv.Find(var)
If m > Then
var3 = / dv(m).Item("unmcvt")
Else
var() =
m = dv.Find(var)
If m > 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 -
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 Dim v1, v2, v3, v4 As Double
v1 =
v2 =
v3 =
v4 = Dim rst As ADODB.Recordset
Dim m As Integer If var1 <> "M" Then
v1 = uomconv(var1, "M")
If v1 < Then Return -
End If If var2 <> "LB" Or var2 <> "KG" Then
v2 = uomconv(var2, "KG")
If v2 < Then
v2 = uomconv(var2, "LB")
If v2 < Then
Return -
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 < Then Return - v3 = uomconv(var3, "M")
If v3 < Then Return - v4 = uomconv(var4, "GSM")
If v4 < Then Return -
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 = ) 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, ) Dim UOM1 As String = gData.selectValue("select WIDUNM from PHFRMTP where sug='" & Trim(Rmcode) & "' and ovy='" & Trim(Type) & "'", adoConn, ) Dim STDWID As Double = gData.selectValue("select STDWID from PHFRMTP where sug='" & Trim(Rmcode) & "' and ovy='" & Trim(Type) & "'", adoConn, ) If Trim(UOM) = "LB" Then
If UOM1 = "CM" Then
PurQty1 = * Val(PurQty1) / (Val(weight) * Val(STDWID))
Else
If UOM1 = "MM" Then
PurQty1 = * Val(PurQty1) / (Val(weight) * Val(STDWID))
Else
PurQty1 =
End If
End If
Else
If UOM1 = "CM" Then
PurQty1 = * Val(PurQty1) / (Val(weight) * Val(STDWID))
Else
If UOM1 = "MM" Then
PurQty1 = * Val(PurQty1) / (Val(weight) * Val(STDWID))
Else
PurQty1 =
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, )
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, ""))
Dim UOM1 As String = gData.SelectValue("select WIDUNM from PHFRMTP where sug='" & Trim(Sug) & "' and ovy='" & Trim(OVY) & "'", netConn, "")
Dim STDWID As Double = CDbl(gData.SelectValue("select STDWID from PHFRMTP where sug='" & Trim(Sug) & "' and ovy='" & Trim(OVY) & "'", netConn, "")) If Trim(PurUnit) = "LB" Then
If UOM1 = "CM" Then
PurQty1 = (Val(PurQty1) * (Val(weight) * Val(STDWID))) /
Else
If UOM1 = "MM" Then
PurQty1 = (Val(PurQty1) * (Val(weight) * Val(STDWID))) /
Else
PurQty1 =
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 =
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 = Then
Dim rUnit As DataRow = dt.Rows()
If CStr(rUnit("MLTDIV")) = "" Then
PurQty1 = PurQty1 * rUnit("UNMCVT")
Else
If rUnit("UNMCVT") <> Then
PurQty1 = PurQty1 / rUnit("UNMCVT")
Else
PurQty1 =
End If
End If
Else
PurQty1 =
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
StrM = "JAN"
Case
StrM = "FEB"
Case
StrM = "MAR"
Case
StrM = "APR"
Case
StrM = "MAY"
Case
StrM = "JUN"
Case
StrM = "JUL"
Case
StrM = "AUG"
Case
StrM = "SEP"
Case
StrM = "OCT"
Case
StrM = "NOV"
Case
StrM = "DEC"
Case Else
StrM = "ERROR"
End Select
Return StrM
End Function
#End Region End Module

Bogart gFunction.vb的更多相关文章

  1. Bogart BogartPublic.vb

    Imports System.Data.SqlClient Imports System.Data #Region "IBogartToolbar,請勿隨便更改" Interfac ...

  2. Bogart SysPwd.vb

    Module syspwd Public Const STR_MASK = "MyFunction" '加密用字串 '預定義密碼長度 Public GintCheckPwd As ...

  3. Bogart gSub.vb

    '--------------Job No 0900408 -------------- '--DIM PART ONE ONLINE Update Order Qty '''主要新加過程名 Refr ...

  4. Bogart gData.vb

    Imports System Imports System.Data Imports System.Data.OleDb Imports Microsoft.VisualBasic Imports S ...

  5. Bogart BogartAutoCode.vb

    Imports System.Data.SqlClient Imports System.Data Public Class BogartAutoCodeDataBase Private Conn A ...

  6. Bogart gGrid.vb

    Namespace BogartMis.Cls Public Class gGrid '設定表格控的列標題的別名 '說明:strItem字符串的格式為"01,02,03,04,05" ...

  7. [转载]C#中MessageBox.Show用法以及VB.NET中MsgBox用法

    一.C#中MessageBox.Show用法 MessageBox.Show (String) 显示具有指定文本的消息框. 由 .NET Compact Framework 支持. MessageBo ...

  8. VB.NET设置控件和窗体的显示级别

    前言:在用VB.NET开发射频检测系统ADS时,当激活已存在的目标MDI子窗体时,被其他子窗体遮住了,导致目标MDI子窗体不能显示. 这个问题怎么解决呢?网上看到一篇帖子VB.NET设置控件和窗体的显 ...

  9. 用VB脚本批到导入字段到PowerDesigner

    在PowerDesigner使用脚本批量导入excel中记录的表结构信息,由于需要通过powerdesigner逆向工程创建一些sybase IQ的表,由于是接口数据,只有excel表,手动导入太耗时 ...

随机推荐

  1. OK335xS Ubuntu 12.04.1 版本 Android 开发环境搭建

    /******************************************************************************************** * OK33 ...

  2. 使用Nginx实现灰度发

     灰度发布是指在黑与白之间,能够平滑过渡的一种发布方式.AB test就是一种灰度发布方式,让一部分用户继续用A,一部分用户开始用B,如果用户对B没有什么反对意见,那么逐步扩大范围,把所有用户都迁移到 ...

  3. (3)socket的基础使用(基于UDP协议)

    服务端代码 import socket server =socket.socket(socket.AF_INET,socket.SOCK_DGRAM) #SOCK_DGRAM就是数据报,UDP就是数据 ...

  4. hdu 5285 二分图黑白染色

    题意:给出 n 个人,以及 m 对互不认识的关系,剩余的人都互相认识,要将所有人分成两组,组内不能有互不认识的人,要求每组至少有一人,并且第一组人数尽量多,问两组人数或不可能时单独输出 BC 48 场 ...

  5. Select2 用法

    http://www.cnblogs.com/wuhuacong/p/4761637.html 2.这个做详细参考 http://www.jianshu.com/p/c5ab74b91b2e 3.ht ...

  6. lseek成功但未生效?

    如果open打开文件时,指定了O_APPEND,即“追加”模式,那么lseek的向前移动指针的操作无法凑效,包括lseek(fd, 负数, SEEK_CUR)和lseek(fd, 小于当前偏移的位置, ...

  7. EXCEL函数LookUp, VLOOKUP,HLOOKUP应用详解(含中文参数解释)

    关于VLOOKUP函数的用法 “Lookup”的汉语意思是“查找”,在Excel中与“Lookup”相关的函数有三个:VLOOKUP.HLOOKUO和LOOKUP.下面介绍VLOOKUP函数的用法. ...

  8. Spring Cloud Netflix项目进入维护模式

    任何项目都有其生命周期,Spring Could Netflix也不例外,官宣已进入维护模式,如果在新项目开始考虑技术选型时要考虑到这点风险,并考虑绕道的可能性. 原创: itmuch  IT牧场 这 ...

  9. centos 下nginx源码编译安装

    1.下载nginx 进入nginx官网下载nginx的稳定版本,我下载的是1.10.3. 下载:wget http://nginx.org/download/nginx-1.10.3.tar.gz 解 ...

  10. POJ3468——树状数组支持两个区间操作

    题目:http://poj.org/problem?id=3468 推断过程可自己查,得式子:fixsum(x) = (x+1) * ∑(i=1,x)fi - ∑(i=1,x)i*fi; 其中 f 是 ...