hcconst.bas

财务信息管理系统,适合做毕业论文的人使用

Attribute VB_Name = "hcConst"
'软件著作权: 北京用友软件集团有限公司
'系统名称: 资金管理8.0
'功能说明: 常量定义、基础设置、利息计算所用一些函数过程
'作者:
Global Const gstrSEP_DIR$ = "\"
Global Const COLOR_WHITE = &H80000005    '  background color contains blue.
Global Const COLOR_GRAY = &H80000000     '  background color contains green.

Global Const CX_SumTEXT = " 合计 "  'cuidong S.A 2001.09.10
Global Const CX_SumCHARSQL = "NULL" 'cuidong S.A 2001.09.11
Global Const CX_SumCHAR = ""        'cuidong S.A 2001.09.11

'结息日设置
Global Const CAD_SAVING = 0
Global Const CAD_CREDIT = 1

'开户单位类型
Global Const UNI_DEPARMENT = 0
Global Const UNI_PERSON = 1

'单位定义编辑状态
Global Const ENT_STATUS_ADD = 0
Global Const ENT_STATUS_EDIT = 1

Global Const FRM_ACCDEF_WIDTH = 9300
Global Const FRM_ACCDEF_HEIGHT = 6195
Global Const FRM_ENTDEF_WIDTH = 9060
Global Const FRM_ENTDEF_HEIGHT = 4800
Global Const FRM_ACCSET_WIDTH = 9300
Global Const FRM_ACCSET_HEIGHT = 5715
Global Const FRM_INTRSET_WIDTH = 8820
Global Const FRM_INTRSET_HEIGHT = 4980
Global Const FRM_CADSET_WIDTH = 7415
Global Const FRM_CADSET_HEIGHT = 4515
Global Const FRM_CLASS_WIDTH = 6375
Global Const FRM_CLASS_HEIGHT = 4505
Global Const FRM_LXJS_WIDTH = 9300
Global Const FRM_LXJS_HEIGHT = 5925

'设置输出字段长度
Global Const lngYear = 4
Global Const lngMonth = 2
Global Const lngDay = 2
Global Const lngDays = 6
Global Const lngText = 20
Global Const lngCurrency = 18

Global Const SAVELOCK_DELAY = #1/1/2001 12:00:08 AM# - #1/1/2001 12:00:01 AM#  'cuidong 2001.08.28

Public clsUnit As New clsEntDef
Public clsAcc As New clsAccDef
Public clsCads As New clsCAD

Enum Acc_Src
  zj = 0
  zw = 1
End Enum

Enum Acc_IO
  InSide = 0
  OutSide = 1
End Enum

Enum Acc_PC
  current = 1
  periodic = 0
End Enum

Enum Ed_Status
  Parent_Add = 0
  Child_Add = 1
  Child_Edit = 2
  Child_Borwse = 3
End Enum


Type UnitType
  I_O As Acc_IO
End Type


Public Enum edstatus
  addintrcode = 0
  addintrdate = 1
  editintrdate = 2
End Enum

'账户属性
Type AccountProperty
    bfind As Boolean
    AccCode As String
    AccName As String
    UnitCode As String
    iio As Acc_IO
    ipc As Acc_PC
    isrc As Acc_Src
    IntrID As String
    CadID As String
    CurrencyName As String
    iYt As Long
    cYtID As String
End Type

Enum BillType
    Save_Bill = 1
    Cred_Bill = 2
    UnwDeb_Bill = 3
    Lj_Bill = 0
End Enum

Enum IRMethod
    AccCode_Method = 0
    IntrCode_Method = 1
End Enum
    
Type IRKey
    AccCode As String
    IRCode As String
    IRMethod As IRMethod
    bfind As Boolean
End Type

Type Interest_Rate
    zyll    As Double
    cqll    As Double
    yqll    As Double
    cdell   As Double
End Type

Enum RefType
    iKm = 17
    iPerson = 10
    iBank = 2
    iDepart = 9
    iCustomer = 0
    iVendor = 1
    iItem = 6
End Enum

Type LXDInfomation
    corrvch_id As String
    LxdType    As BillType
    AccCode    As String
    pAccID     As String
    gAccID     As String
    DanID      As String
    isf        As Byte
    money      As Currency
    Js         As Currency
    cdeLx      As Currency
    cdeJs      As Currency
    FromDay    As Date
    EndDay     As Date
    BillDay    As Date
    IntrCode   As String
    CadCode    As String
    Freq       As Single
    ArType     As Byte
    cDigest    As String 'cuidong TY.A 2001.10.22
End Type

Enum ButType
    TB_PRINT = 0
    TB_PREVIEW = 1
    TB_DATAOUT = 2
    TB_ADD = 3
    TB_Del = 4
    TB_FIND = 5
    TB_Freeze = 6
    TB_Destroy = 7
    TB_HELP = 8
    TB_EXIT = 9
    TB_IMPORT = 10
    TB_ADD1 = 11
    TB_DEL1 = 12
 '   TB_CUT = 13
    TB_COPY = 14
    TB_PASTE = 15
    TB_Save = 16
    TB_CALC = 17
    TB_SWITCH = 18
    TB_Refresh = 19
    TB_BILL = 20
    TB_Export
    TB_AddNew
    TB_Edit
    TB_Delete
    TB_Cancel
    TB_AddCol
    TB_DelCol
    TB_ColumnSet
    TB_First
    TB_Previous
    TB_Next
    TB_Last
    TB_Check
    TB_CancelCheck
    TB_Pz
    TB_ShowDestroy
    TB_Grouping
    TB_Approve
    TB_SelAll
    TB_UnSelAll
    TB_BatchCheck
    TB_BatchCancel
    TB_Ratio
End Enum

Enum SwitchMode
    AS_CODE = 0
    AS_NAME = 1
End Enum

Type ClipView
    RecNum As Long
    ClpArr(100, 6) As String
End Type

Enum TabType
    TAB_CADSET = 0
    TAB_INTRSET = 1
    TAB_UNITDEF = 2
    TAB_ACCDEF = 3
    TAB_ACCSET = 4
    TAB_clsSET = 5
End Enum

Enum LxjsMethod
    LXJS_M_ACC = 1
    LXJS_M_UNIT = 0
    LXJS_M_BILL = 2
End Enum

Type prnReport
   iColNumber  As Long
   cColName    As String
   iColType    As DataTypeEnum
   iColLength  As Long
End Type

Public prnReport1() As prnReport

'cuidong S.A 2001.09.11
'------------------------------------
Public Type CX_SumType
    mMoney As Currency   '金额
    sExchName As String  '货币类型
    nFrat As Double      '汇率
    mMoney_1 As Currency '金额1
    mMoney_2 As Currency '金额2
    mMoney_3 As Currency '金额3
    mMoney_4 As Currency '金额4
    mMoney_5 As Currency '金额5
    mMoney_6 As Currency '金额6
End Type
Public CX_Sum() As CX_SumType
'------------------------------------

'cuidong S.A 2001.09.11
'初始化数组
Public Sub CX_Sum_Init()
    ReDim CX_Sum(0 To 0)
End Sub

'cuidong S.A 2001.09.11
'查询时，累计Grid项目中各币种/汇率的金额、本位币总和
Public Sub CX_Sum_Add(ByVal mMoney As Currency, _
                      ByVal sExchName As String, _
                      ByVal nFrat As Double, _
                      ByVal mMoney_1 As Currency, _
                      Optional ByVal mMoney_2 As Currency = 0, _
                      Optional ByVal mMoney_3 As Currency = 0, _
                      Optional ByVal mMoney_4 As Currency = 0, _
                      Optional ByVal mMoney_5 As Currency = 0, _
                      Optional ByVal mMoney_6 As Currency = 0 _
                      )
    Dim bfind As Boolean
    Dim i As Long
    
    bfind = False
    
    For i = 1 To UBound(CX_Sum)
'        If sExchName = CX_Sum(i).sExchName And nFrat = CX_Sum(i).nFrat Then
        If sExchName = CX_Sum(i).sExchName Then
           bfind = True
           Exit For
        End If
    Next i
    
    If Not bfind Then
       i = UBound(CX_Sum) + 1
       ReDim Preserve CX_Sum(0 To i)
       CX_Sum(i).sExchName = sExchName
       CX_Sum(i).nFrat = nFrat
    End If
    
    CX_Sum(i).mMoney = CX_Sum(i).mMoney + mMoney
    CX_Sum(i).mMoney_1 = CX_Sum(i).mMoney_1 + mMoney_1
    CX_Sum(i).mMoney_2 = CX_Sum(i).mMoney_2 + mMoney_2
    CX_Sum(i).mMoney_3 = CX_Sum(i).mMoney_3 + mMoney_3
    CX_Sum(i).mMoney_4 = CX_Sum(i).mMoney_4 + mMoney_4
    CX_Sum(i).mMoney_5 = CX_Sum(i).mMoney_5 + mMoney_5
    CX_Sum(i).mMoney_6 = CX_Sum(i).mMoney_6 + mMoney_6
    
End Sub


'cuidong 2001.08.24
'帐户加锁
Public Function BillSaveLock(ByVal stype As String) As Boolean
    '帐户余额变动时，自查询帐户余额起，至更新数据库结束后始终将其锁定。
    Dim sPCName As String
    
    'On Error Goto Err_BillSaveLock
    'sPCName=UCase()
    'Select sPCName, dLockDateTime, GetDate() From Table Where sType = 'sType'
    'IF Not Rs.EOF or Rs.BOF Then
    '   IF Rs.Fields(0).Value=sPCName THEN
    '      Update Table Set dLockDateTime=GetDate() Where sType='sType' And sPCName='sPCName'
    '   ELSE
    '      IF Rs.Fields(2).Value-Rs.Fields(1).Value> SAVELOCK_DELAY then
    '         BillSaveUnLock sType
    '         BillSaveLock = BillSaveLock (sType)
    '      ELSE
    '         '需要等待
    '         显示等待窗口
    '         dDateTime=Now
    '         Do While Now<>dDateTime
    '             DoEvents
    '         Loop
    '         BillSaveLock = BillSaveLock (sType)
    '      END IF
    '   END IF
    'ELSE
    '   Insert Into Table(sType,sPCName,dLockDateTime) Values('sType','sPCName',GetDate())
    'END IF
    'Rs.Close
    '
    'BillSaveLock =True
    '
    'Err_BillSaveLock:
    'On Error Resume next
    'Rs.Close
End Function
'cuidong 2001.08.24
'帐户解琐
Public Function BillSaveUnLock(ByVal stype As String) As Boolean
    '配合BillSaveLock，保存过程结束后，将其解锁。
    'On Error Goto Err_BillSaveUnLock
    'Delect * From Table Where sType='sType'