billpublic.bas

金算盘软件代码

    dblPlanPrice As Double                          '计划价
    dblCostPrice As Double                          '成本单价
    blnIsStockItem As Boolean                  '是否存货
    blnIsBatchManager As Boolean              '是否批次管理
    blnIsBorrow As Boolean                        '是否受托商品
    blnIsCombination As Boolean                  '是否组件商品
    blnIsCostBatch As Boolean                    '是否按批计成本
    blnIsAssembly As Boolean                      '是否组装
    bytDiscMethod As Byte            '折扣方式(1+2+4+8+16,1 商品折扣,2 到款折扣,4 批量折扣,8 促销折扣,16 客户折扣)
    strRecentDate As String         '最近调价日期
    dblNoDiscAmount As Double       '销售价中不打折扣金额（不含税价）
    dblNoDiscAmount1 As Double     '销售价中不打折扣金额（含税价）
    dblRecenetPurchasePriceTax As Double        '最近含税采购价
    dblRecenetSalePriceTax As Double            '最近含税销售价
End Type

'当前输入位置
Public Type clsCurrentInput
    bytRegion As clsInputRegion     '当前输入区域
    bytIndex As Byte                'INDEX序号
End Type
'通用输入控件类型
Public Enum InputCtrType
     TText = 0          'TextBox文本输入框
     tCurrency = 1      '带计算器的金额输入框
     tdate = 2          '带日历的日期输入框
     TRefer = 3         '带参照的参照输入
     TPicBox = 4        '自定义图片框组合输入
     TSpinText = 5      '可加减1的文本输入框
     TCombo = 6         '标准组合输入框
     TButton = 7        '转帐凭证中的浏览按钮
     TRecList = 8
End Enum

Public Type FormColor
    lngCaptionForeColor As Long
    lngFiledCaptionBackColor As Long
    lngFiledCaptionForeColor As Long
    lngGridLineColor As Long
    lngGridFixedBackColor As Long
    lngGridBorderColor As Long
    lngGridFixedForeColor As Long
    lngBillTailTitleColor As Long
    lngBackColor As Long
    lngFooterForeColor As Long '单据尾标题前景色
End Type

'通用输入控件对象属性类
Public Type ClassField
    lngID As Long               ' ID值 存放 ID,
                                '      等于0时为存放内容
                                '      内容存放在lblField(i).Caption
    Text As String
    blnVisible As Boolean        ' 可视性
    bytRow As Byte               ' 行号     决定显示位置
    bytCol As Byte               ' 列号     决定显示位置
    strFieldName As String       ' 字段名   决定存取对象
    bytFieldSize As Byte         ' 字段长度 决定控件宽度
    bytMinSize As Byte           ' 字段最小长度,决定控件显示最小宽度
    lngCtrType As InputCtrType   ' 所用粘贴输入控件类型
    bytReferSort As enumTabType  ' 参照类型序号
    blnAdded As Boolean         ' 参照自动添加标志
    blnReadOnly As Boolean      ' 只读标志
End Type
'通用PIC输入控件对象属性类
Public Type ClassPicInputField
    lngID As Long               ' ID值 存放 ID,
                                ' 等于0时为存放内容,存放在lblInput(i).Caption
    bytRow As Byte              ' 行号     决定显示位置
    bytGrdCol As Byte           ' 存储内容的GRID列号
    bytGrdIDCol As Byte         ' 存储ID的GRID列号
    lngCtrType As InputCtrType   ' 所用粘贴输入控件类型
    bytReferSort As enumTabType    ' 参照类型序号
    blnAdded As Boolean         ' 参照自动添加标志
End Type
'通用Grid列附加属性类
Public Type ClassGridProperty
    strColCaption As String     'GRID列标题
    bytGrdIDCol As Byte         ' 存储对应ID的GRID列号,为0时为非ID方式存储
    lngCtrType As InputCtrType  ' 所用粘贴输入控件类型
    bytReferSort As enumTabType         ' 参照类型序号
    blnUsable As Boolean        ' 可用标志 为TRUE时可用（可显示）
    blnAdded As Boolean         ' 参照自动添加标志
    lngColWidth As Long         ' 列宽
    blnReadOnly As Boolean      ' 只读标志
    bytIsCodeField As Byte      ' 1 层次编码字段 2 非层次编码字段
    bytCodeType As Byte         ' 显示格式
    '4.编码+名称 5 编码+全称 1编码 2名称 3 全称 6 编码+一级名称+倒数1级名称 7 编码+一级名称+倒数2级名称 8 编码+一级名称+倒数3级名称 9 一级名称+倒数1级名称 10 一级名称+倒数2级名称 11 一级名称+倒数3级名称；非层次编码 3 编码+名称 1 编码 2 名称
End Type

Public Type AccountantPeriod
    dtmStart As Date
    dtmEnd As Date
End Type
'确定凭证是否复核、记帐等属性
Public Type VoucherProperty
    lngIsCheck As Long    '是否已复核
    lngIsPostID As Long   '是否已记帐
End Type
'定义表的枚举类型
Public Enum enumTabType
    xCustomer = 1   '单位
    xDepartment = 2  '部门
    xEmployee = 3    '业务员
    xCLASS1 = 4       '统计
    xCurrencys = 5   '币种
    xTerm = 6 '付款条件
    xAccount = 7     '科目
    xItem = 8       '商品表
    xJob = 9       '工程表
    xPosition = 10   '货位
    xRemark = 11     '摘要表
    xCustom1 = 12    '自定义项目1
    xCustom2 = 13    '自定义项目2
    xCustom3 = 14    '自定义项目3
    xCustom4 = 15    '自定义项目4
    xCustom5 = 16    '自定义项目5
    xClass2 = 17    '项目
    xRate = 18      '汇率
    xVoucherType = 19 '凭证类型
    xCustom0 = 20    '自定义项目0
    xTemplatE = 21   '单据模版
    xAccountType = 22 '科目类型
    xInvRecAccount = 23 '应收/应付科目
    xCustomerAddress = 24 '单位发货地址表
    xCustomerBank = 25  '单位开户银行表
    xBusinessAddress = 26   '企业地址表
    xBusinessBank = 27      '企业开户银行表
    xItemUnit = 28          '商品单位表
    xTax = 29               '税率
    xTransVoucher = 30      '转帐凭证
    xPaymentMethod = 31     '付款方式
    xInvoiceType = 32        '发票类型
    xAdjustItem = 33    '特殊的商品
    xOperator = 34      '操作员
    xHospital = 35      '医疗机构（保险）
    xPolicy = 36        '投保单位（保险）
    xPayCustomer = 37   '付款方（邮电）
    xProjectOrder = 38  '工程合同（邮电）
    xProject = 39       '工程（邮电）

End Enum

Public Type xReceiptType   '自定义单据数组类型
    lngReceiptTypeID As Long
    strReceiptTypeName As String
    lngReceiptID As Long
End Type

Public Type AccountblnOther
    blnIsInActive As Boolean      '封存标志
    blnIsDetail As Boolean          '末级标志
    blnIsCustomer As Boolean      '单位核算标示
    blnIsDepartment As Boolean  '部门核算标志
    blnIsEmployee As Boolean      '职工核算标志
    blnIsJob As Boolean              '工程核算标志
    blnIsClass1 As Boolean          '统计核算标志1
    blnIsClass2 As Boolean          '统计核算标志2
    blnIsQuantity As Boolean       '数量核算标志
    blnIsMultiCurrency As Boolean   '多币种核算标志
    blnIsAllCurrency As Boolean       '核算全部币种标志
    blnDefault As Boolean        '全非
    lngAccountID As Long        '科目ID
    strAccountCode As String   '科目编码
    strAccountName As String  '科目名称
    strAccountFullName As String  '科目全称
    intAccountNatureID As Integer '科目性质ID： 0 其它 1 现金 2 银行 3 应收 4 应付 5 存货
    strQuantityUnit As String   '数量单位
    blnIsCash As Boolean        '现金或现金等价物标志
    blnIsProject As Boolean     '有工程项目标志
    
End Type
                            
'字符串转为长整数(处理空串为0)
Public Function C2lng(ByVal strOne As String) As Long
    On Error Resume Next
    strOne = FilterString(strOne)
    If Val(strOne) <= 2 ^ 31 - 1 And Val(strOne) >= -2 ^ 31 Then
        C2lng = CLng(Val(strOne))
    Else
        C2lng = 2 ^ 31 - 1
    End If
End Function
'字符串转为双精度型(处理空串处理为0)
Public Function C2Dbl(ByVal strOne As String) As Double
    On Error Resume Next
    If IsNull(strOne) Then
        C2Dbl = 0
        Exit Function
    End If
    strOne = FilterString(strOne)
    C2Dbl = CDbl(Val(strOne))
End Function
'字符串转为日期型(处理空串处理为当前日期)
Public Function C2Date(ByVal strOne As String) As Date
    On Error Resume Next
    If Not IsDate(strOne) Then
        If gclsBase Is Nothing Then
            C2Date = Date
        Else
            C2Date = gclsBase.BaseDate
        End If
    Else
        C2Date = CDate(strOne)
    End If
End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   替换字符串中字符
'   以cChart分隔的字符
'   参数：字符串                            如："~001~002~010"
'         分隔符（长度为1）                 如："~"
'         替换符（长度为1）                 如：" "
'   返回：过滤的字符crepl用代替            如："001~002"变为 “001 002”
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function ReplaceString(ByVal cStrAuth As String, Optional cChart As String = " ", Optional cRepl As String = " ") As String

    Dim nBit1 As Integer, nLen As Integer, nBit2 As Integer
    Dim strNew  As String
    nLen = Len(cStrAuth)
      strNew = cStrAuth
   Do While InStr(strNew, cChart) <> 0
        nBit1 = InStr(strNew, cChart)
        '分隔符在第一字符位置出现,取分隔符后
        If nBit1 = 1 Then
            strNew = cRepl & Mid(strNew, 2)

        '分隔符不在第一字符位置出现,取分隔符前
        Else
            strNew = Left(strNew, nBit1 - 1) & cRepl & Right(strNew, nLen - nBit1)
        End If
    Loop
    ReplaceString = strNew
    
End Function
'---------------------------------
'入口： 给定小数位数
'功能：返回一个格式字符串
'出口：返回一个格式字符串
'---------------------------------
Public Function FormatString(ByVal intDec As Integer) As String
    Dim intI As Integer
    If intDec = 0 Then
        FormatString = "###,###,###,###,###,##0"
        Exit Function
    End If
    FormatString = "###,###,###,###,###,##0."
    For intI = 1 To intDec
        FormatString = FormatString + "0"
    Next intI
End Function
'-----------------------------------------
'入口：给定一个科目ID号
'功能：从科目库中判断各对应的标志(AccountblnOther类型)
'出口：返回一个带有各标志的AccountblnOther类型的值
'-----------------------------------------
Public Function blnOther(ByVal lngAccountID As Long) As AccountblnOther
    On Error Resume Next
    Dim recTmp As rdoResultset
    Dim strSQL As String
'为各种标志设置默认的值
    blnOther.blnIsInActive = False
    blnOther.blnIsAllCurrency = False
    blnOther.blnIsClass1 = False
    blnOther.blnIsClass2 = False