modpub.bas

这是一个航空公司用来计算货物运价的系统。

Attribute VB_Name = "modPub"
Option Explicit

'－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
' 输入参数： 运价数据cur1～cur9，附加百分比【fjbf】，初步计费重量【cw】
' 返回值:字符串（string）
' 说明:针对VB对返回值个数的限制，在本函数中将返回的四个值采用特殊字符【#】隔离开，在取得运算结果后，再在外部进行数据切割
' 函数用途：计算相应的运价信息并返回计费重量、销售运价和实际收入""
' 作者：BLUE
' 时间： 2000-12-20
' 版本号：Ver 1.0
'－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Public Function jsyj(ByVal cur1, cur2, cur3, cur4, cur5, cur6, cur7, cur8, cur9 As Variant, ByVal fflag As String, ByVal fjbf, CW As Variant) As String
Dim ax, ay, bx, by, wg, wl, k, sum As Variant
Dim jflag As String
'----------------------------------------
'对初步计费重量进行必要的处理部分
'----------------------------------------
'说明：根据游岸韬的要求，当小数点后的数据小于0.5时，按0.5Kg计算，否则按1.0Kg计算
Dim cwei As Integer
Dim cwei0 As Variant
cwei = Int(CW)
cwei0 = CW - cwei
If cwei0 > 0 Then
    If cwei0 <= 0.5 Then
        CW = cwei + 0.5
    Else
        CW = cwei + 1
    End If
End If
'----------------------------------------
'函数中间数据计算部分
'----------------------------------------
'对运价进行计算部分
'@@@@@@@@@@@@@@@@@@@@@@@
'【1】45～1000Kg之间
'@@@@@@@@@@@@@@@@@@@@@@@
If CW >= 45 And CW < 1000 Then
    If CW >= 45 And CW < 100 Then
    ax = 45
    ay = 100
    bx = cur3
    by = cur4
    ElseIf CW >= 100 And CW < 300 Then
    ax = 100
    ay = 300
    bx = cur4
    by = cur5
    ElseIf CW >= 300 And CW < 500 Then
    ax = 300
    ay = 500
    bx = cur5
    by = cur6
    Else
    ax = 500
    ay = 1000
    bx = cur6
    by = cur7
    End If
    wl = ay * by / bx
    If CW < wl Then
    wg = CW
    k = bx
    Else
    k = by
    wg = ay
    End If
    sum = wg * k
    jflag = "b"
'@@@@@@@@@@@@@@@@@@@@@@@
'【2】CW<45Kg
'@@@@@@@@@@@@@@@@@@@@@@@
ElseIf CW < 45 Then
    'M,N运价都为空
    If IsNull(cur1) And IsNull(cur2) Then
        wg = 45
        k = cur3
        sum = 45 * cur3
        jflag = "b"
    'M非空，N为空
    ElseIf cur1 > 0 And IsNull(cur2) Then
        wl = cur1 / cur3
        If CW < wl Then
        wg = CW
        k = cur1
        sum = cur1
        jflag = "a"
    Else
        wg = 45
        k = cur3
        sum = 45 * cur3
        jflag = "b"
    End If
    'M为空，N非空
    ElseIf IsNull(cur1) And cur2 > 0 Then
        wl = 45 * cur3 / cur2
        If CW > wl Then
            wg = 45
            k = cur3
            sum = 45 * cur3
            jflag = "b"
        Else
            wg = CW
            k = cur2
            sum = CW * cur2
            jflag = "b"
        End If
    'M,N均非空
    Else
        wl = cur1 / cur2
        If CW > wl Then
            wl = 45 * cur3 / cur2
            If CW > wl Then
                wg = 45
                k = cur3
                sum = 45 * cur3
                jflag = "b"
            Else
                wg = CW
                k = cur2
                sum = CW * cur2
                jflag = "b"
            End If
        Else
            sum = cur1
            wg = CW
            k = cur1
            jflag = "a"
        End If
    End If
'@@@@@@@@@@@@@@@@@@@@@@@
'【3】CW>1000Kg
'@@@@@@@@@@@@@@@@@@@@@@@
Else
'2000,3000Kg级别的运价信息都为空
    If IsNull(cur8) And IsNull(cur9) Then
        wg = CW
        k = cur7
        sum = wg * k
        jflag = "b"
    Else
        '2000,3000Kg级别的运价信息均非空
    If CW >= 1000 And CW < 3000 Then
        If CW >= 1000 And CW < 2000 Then
            ax = cur7
            ay = cur8
            bx = 1000
            by = 2000
        Else
            ax = cur8
            ay = cur9
            bx = 2000
            by = 3000
        End If
        wl = ay * by / ax
    If CW < wl Then
        wg = CW
        k = ax
    Else
        k = ay
        wg = by
    End If
        sum = wg * k
        jflag = "b"
    Else
        k = cur9
        wg = CW
        sum = k * wg
        jflag = "b"
    End If
    End If
End If
'如果存在等级运价信息，则还要与等级运价信息相乘
If fjbf > 0 And Trim(fflag) = "1" Then
sum = sum * fjbf
End If
'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
'格式化输出结果，数据输出格式
'格式为【sum#wg#k】
'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
sum = Format(sum, "###0.00")
k = Format(k, "###0.00")
wg = Format(wg, "###0.00")
jsyj = Str(sum) & "#" & Str(wg) & "#" & Str(k) & "#" & Trim(jflag)
End Function

'----------------------------------------------------------------------
'FillLvw 将指定的记录集RecordSet中的数据插入ListView中
'
'参考参数：
'         Rst: 将指定的记录集
'         Lvw: 装入数据的ListView
'
'返回值  :成功：True,  失败：False
'----------------------------------------------------------------------
Public Function ADOFillLvw(ByVal Rst As ADODB.Recordset, _
                        ByVal Lvw As MSComctlLib.ListView, _
                        Optional ClearLvw As Boolean = False) As Boolean

Dim I As Long
Dim J As Long
Dim RstCol  As Long
Dim LvwCol As Long
Dim Item As MSComctlLib.ListItem
Dim TempValue As String
        
        
      TempValue = ""
      If Rst Is Nothing Then
            ADOFillLvw = False
            Exit Function
      End If
      If IsRstEmpty(Rst) Then
            ADOFillLvw = False
            Exit Function
      End If
      
      If ClearLvw Then Lvw.ListItems.Clear
      
      
      RstCol = Rst.Fields.Count
      LvwCol = Lvw.ColumnHeaders.Count
      
      For I = 1 To RstCol - LvwCol
            Lvw.ColumnHeaders.Add
      Next I
      
      Rst.MoveFirst
      While Not Rst.EOF
            
            Set Item = Lvw.ListItems.Add(, , Rst.Fields(0))
            
            For I = 1 To RstCol - 1
                If IsNull(Rst.Fields(I).Value) Then
                    TempValue = ""
                Else
                    TempValue = (Rst.Fields(I).Value)
                End If
                  Item.SubItems(I) = TempValue
            Next I
            Rst.MoveNext
      Wend
      ADOFillLvw = True

      
End Function

'判断一个ADO记录集中是否有记录
Public Function IsRstEmpty(eRst As ADODB.Recordset) As Boolean
        
On Error GoTo FunError
    
    IsRstEmpty = True
    If Not eRst.EOF Or Not eRst.BOF Then IsRstEmpty = False
    
FunExit:
    On Error GoTo 0
    Exit Function
FunError:
    IsRstEmpty = True
    Resume FunExit
End Function