modxpreport.bas

排队分诊管理系统源代码！该代码使用VB6开发环境

Attribute VB_Name = "modXPReport"
Option Explicit

''''''''''''''''''''''''''''''''''''''''''
' 报表字段类型
Public Type TYPE_REPORT_FIELD
    FieldIndex          As Integer          ' 字段序号
    FieldTag            As String           ' 数据库字段名
    FieldName           As String           ' 字段显示名
    FieldType           As DataTypeEnum     ' 字段类型
    FieldLength         As Integer          ' 字段长度（字符长度）
    FieldWidth          As Integer          ' 字段显示宽度
    fShow               As Boolean          ' 字段是否显示
    ' 以下用于记录过滤
    Available_Value     As String           ' 该字段可选值
    Available_Integer   As String           ' 字段可选值对应的数值（整数型或字符型）
    FieldWhereTag       As String           ' 在 Where 中对应的字段名
End Type

Public Enum FLEXGRID_ALIGN_TYPE
    flexAlignLeftTop = 0            ' 顶部左对齐。
    flexAlignLeftCenter = 1         ' 中间左对齐。
    flexAlignLeftBottom = 2         ' 底部左对齐。
    flexAlignCenterTop = 3          ' 顶部居中。
    flexAlignCenterCenter = 4       ' 中间居中。
    flexAlignCenterBottom = 5       ' 底部居中。
    flexAlignRightTop = 6           ' 顶部右对齐。
    flexAlignRightCenter = 7        ' 中间右对齐。
    flexAlignRightBottom = 8        ' 底部右对齐。
End Enum

Public m_TempFieldsSet() As TYPE_REPORT_FIELD

Dim m_tagErrInfo As TYPE_ERRORINFO

Public Type TYPE_PZOrder
    product_name_type As String
    unit As String
    volumn As Long
    price As Currency
    money_whole As Currency
End Type
Public g_typePZOrder() As TYPE_PZOrder

Public Type TYPE_PZGathing
    code As String * 18
    whole As Currency
    this As Currency
    past As Currency
    last As Currency
    currency_name As String
End Type
Public g_typePZGathing() As TYPE_PZGathing

Public g_typePZPaying() As TYPE_PZGathing

Public Type TYPE_ListBusiness
    code As String
    date_dill As Date
    cust_name As String
    emp_name As String
    product As String
    price As Single
    volumn_unit As String
    whole_money As Currency
    cur_name As String
    status_name As String
End Type

Public Type TYPE_CUST_COMPARE
    cust_name As String
    order_whole_money As Currency
    order_out_money As Currency
    delivery_whole_money As Currency
    cash_sale_money As Currency
    cust_sale_ratio As String
    should_money As Currency
    rolled_money As Currency
    rolled_ratio As String
    withdraw_money As Currency
    expendituer_money As Currency
End Type

Public Type TYPE_CUST_SALE_ANALYZE
    prod_code As String
    prod_name As String
    prod_type As String
    order_volumn As String
    delivery_no_order_volumn As String
    cash_sale_volumn As String
    withdraw_volumn As String
    avg_price As Single
    whole_money As Currency
    sale_ratio As String
End Type

Public Type TYPE_PROD_SALE_ANALYZE
    prod_code As String
    prod_name As String
    prod_type As String
    prod_style As String
    prod_sub_style As String
    prod_unit As String
    cust_name As String
    volumn_out As String
    delivery_money As Currency
    delivery_ratio As String
    money_ratio As String
End Type

Public Type TYPE_PROD_PURC_ANALYZE
    prod_code As String
    prod_name As String
    prod_type As String
    prod_style As String
    prod_sub_style As String
    prod_unit As String
    sup_name As String
    volumn_in As String
    stocking_money As Currency
    stocking_ratio As String
    money_ratio As String
End Type

Public Type TYPE_List
    code As String
    date_dill As Date
    emp_name As String
    whole_money As Currency
    cur_name As String
    status_name As String
End Type

Public Type TYPE_DELIVERY_STOCK_QUERY
    prod_name As String
    date As Date
    volumn As String
    price As Single
    money As Currency
    cust_name As String
    sup_name As String
    emp_name As String
End Type

Public Type Type_MK_Profit
    num As Long
    pro_name As String
    pro_type As String
    price_out As Single
    price_in As Single
    volumn_out As Long
    money_out As Single
    money_in As Single
    profit As Single
    ratio As Single
    unit As String
End Type

Public Type Type_GP_Gather
    month As String
    day As String
    code As String
    pro As String
    gather As String
    paying As String
    direct As String
    total As String
End Type

Public Type Type_Ss_StorageChange
    date_d As Date
    busi_code As String
    busi_name As String
    storage_in As Long
    storage_out As Long
    storage_lease As Long
End Type

Public Type Type_Cu_GPQuery
    cust_name As String
    money_before As Currency
    money_gather As Currency
    money_delivery As Currency
    money_after As Currency
End Type

Public Type Type_Ss_GPQuery
    product_name As String
    product_unit As String
    volumn_before As Long
    volumn_in As Long
    volumn_out As Long
    volumn_after As Long
End Type

Public g_typeListBus() As TYPE_ListBusiness
Public g_typeCustCompare() As TYPE_CUST_COMPARE
Public g_typeCustSaleAnalyze() As TYPE_CUST_SALE_ANALYZE
Public g_typeProdSaleAnalyze() As TYPE_PROD_SALE_ANALYZE
Public g_typeProdPurcAnalyze() As TYPE_PROD_PURC_ANALYZE
Public g_typeDeliveryQuery() As TYPE_DELIVERY_STOCK_QUERY
Public g_typeStockQuery() As TYPE_DELIVERY_STOCK_QUERY
Public g_typeMKProfit() As Type_MK_Profit
Public g_typeGPGather() As Type_GP_Gather
Public g_typeGPPaying() As Type_GP_Gather
Public g_typeSsStorageChange() As Type_Ss_StorageChange
Public g_typeCuGPQuery() As Type_Cu_GPQuery
Public g_typeSsGPQuery() As Type_Ss_GPQuery

Public Function GetProductUnit(strProductName As String, strProductType As String) As String
    Dim rs As New ADODB.Recordset, cmd As New ADODB.Command
    Set cmd.ActiveConnection = dbMyDB
    cmd.CommandType = adCmdText
    cmd.CommandText = "SELECT unit FROM Products WHERE product = '" & strProductName & "' AND product_type = '" & strProductType & "'"
    rs.CursorLocation = adUseClient
    rs.Open cmd, , adOpenStatic, adLockReadOnly
    If rs.RecordCount <> 1 Then
        GetProductUnit = ""
        Set cmd = Nothing
        rs.Close
        Set rs = Nothing
        Exit Function
    End If
    rs.MoveFirst
    GetProductUnit = Trim(rs!unit)
    Set cmd = Nothing
    rs.Close
    Set rs = Nothing
End Function

Public Function GetBigMoney(sngMoney As Currency, strMoney As String) As Boolean
    Dim str1 As String, int1 As Integer, i As Integer, strOne As String
    Dim sngLittle As Single
    strMoney = ""
    str1 = CStr(Int(sngMoney))
    int1 = Len(str1)
    If str1 = "0" Then GoTo NEXT_1
    If int1 > 12 Then
        MsgBox "单张凭证金额不可超过1万亿元！", vbOKOnly + vbExclamation, "操作提示"
        GetBigMoney = False
        Exit Function
    End If
    For i = int1 To 1 Step -1
        Select Case i
            Case 12
                strMoney = strMoney + GetBigNumber(Mid(str1, 1, 1)) + "仟"
            Case 11
                strOne = Mid(str1, int1 - i + 1, 1)
                If strOne = "0" Then
                    strMoney = strMoney + "零"
                Else
                    strMoney = strMoney + GetBigNumber(strOne) + "佰"
                End If
            Case 10, 6, 2
                strOne = Mid(str1, int1 - i + 1, 1)
                If strOne = "0" Then
                    If Right(strMoney, 1) <> "零" Then strMoney = strMoney + "零"
                Else
                    strMoney = strMoney + GetBigNumber(strOne) + "拾"
                End If
            Case 9
                strOne = Mid(str1, int1 - i + 1, 1)
                If strOne = "0" Then
                    If Right(strMoney, 1) = "零" Then strMoney = Left(strMoney, Len(strMoney) - 1)
                    strMoney = strMoney + "亿零"
                Else
                    strMoney = strMoney + GetBigNumber(strOne) + "亿"
                End If
            Case 8, 4
                strOne = Mid(str1, int1 - i + 1, 1)
                If strOne = "0" Then
                    If Right(strMoney, 1) <> "零" Then strMoney = strMoney + "零"
                Else
                    strMoney = strMoney + GetBigNumber(strOne) + "仟"
                End If
            Case 7, 3
                strOne = Mid(str1, int1 - i + 1, 1)
                If strOne = "0" Then
                    If Right(strMoney, 1) <> "零" Then strMoney = strMoney + "零"
                Else
                    strMoney = strMoney + GetBigNumber(strOne) + "佰"
                End If
            Case 5
                strOne = Mid(str1, int1 - i + 1, 1)
                If strOne = "0" Then
                    If Right(strMoney, 1) = "零" Then strMoney = Left(strMoney, Len(strMoney) - 1)
                    strMoney = strMoney + "万零"
                Else
                    strMoney = strMoney + GetBigNumber(strOne) + "万"
                End If
            Case 1
                strOne = Mid(str1, int1 - i + 1, 1)
                If strOne = "0" Then
                    If Right(strMoney, 1) <> "零" Then
                        strMoney = strMoney + "元"
                    Else
                        strMoney = Left(strMoney, Len(strMoney) - 1) + "元"
                    End If
                Else
                    strMoney = strMoney + GetBigNumber(strOne) + "元"
                End If
        End Select
    Next i
NEXT_1:
    str1 = Right(CStr(Format(sngMoney, "####0.00")), 2)
    If str1 = "00" Then
        strMoney = strMoney + "整"
    Else
        If sngMoney < 1 Then strMoney = "零元"
        If Left(str1, 1) = "0" Then
            strMoney = strMoney + "零"
        Else
            If CInt(Right(CStr(Int(sngMoney)), 1)) = 0 And sngMoney > 1 Then strMoney = strMoney + "零"
            strMoney = strMoney + GetBigNumber(Left(str1, 1)) + "角"
        End If
        If Right(str1, 1) <> "0" Then
            strMoney = strMoney + GetBigNumber(Right(str1, 1)) + "分"
        End If
    End If
    If Len(strMoney) < 4 Then strMoney = "零元零角零分"
    GetBigMoney = True
    Exit Function
ERROR_EXIT:
    m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
    m_tagErrInfo.strErrFile = "rptPrintSAOrder"
    m_tagErrInfo.strErrFunc = "InitDB"
    m_tagErrInfo.nErrNum = Err.Number
    m_tagErrInfo.strErrDesc = Error(Err.Number) & "初始化数据库失败。"
    If Err.Number <> 0 Then Err.Clear
    modErrorInfo.WriteErrLog m_tagErrInfo
    GetBigMoney = False
End Function

Private Function GetBigNumber(strSmall As String) As String
    Select Case strSmall
            Case "0"
                GetBigNumber = "零"
            Case "1"
                GetBigNumber = "壹"
            Case "2"
                GetBigNumber = "贰"
            Case "3"
                GetBigNumber = "叁"
            Case "4"
                GetBigNumber = "肆"
            Case "5"
                GetBigNumber = "伍"
            Case "6"
                GetBigNumber = "陆"
            Case "7"
                GetBigNumber = "柒"
            Case "8"
                GetBigNumber = "捌"
            Case "9"
                GetBigNumber = "玖"
        End Select
End Function