adjustcost.cls

金算盘软件代码

    ReceiptType(27).lngReceiptTypeID = 27
    ReceiptType(27).strReceiptTypeName = "代销调价"
    ReceiptType(27).lngReceiptID = 7

    ReceiptType(28).lngReceiptTypeID = 28
    ReceiptType(28).strReceiptTypeName = "商品调拨"
    ReceiptType(28).lngReceiptID = 8

    ReceiptType(29).lngReceiptTypeID = 29
    ReceiptType(29).strReceiptTypeName = "商品调价"
    ReceiptType(29).lngReceiptID = 9
    
    ReceiptType(30).lngReceiptTypeID = 30
    ReceiptType(30).strReceiptTypeName = "商品组装"
    ReceiptType(30).lngReceiptID = 10

    ReceiptType(31).lngReceiptTypeID = 31
    ReceiptType(31).strReceiptTypeName = "商品拆卸"
    ReceiptType(31).lngReceiptID = 10

    ReceiptType(32).lngReceiptTypeID = 32
    ReceiptType(32).strReceiptTypeName = "入库成本"
    ReceiptType(32).lngReceiptID = 11

    ReceiptType(33).lngReceiptTypeID = 33
    ReceiptType(33).strReceiptTypeName = "商品盘点"
    ReceiptType(33).lngReceiptID = 12

    ReceiptType(34).lngReceiptTypeID = 34
    ReceiptType(34).strReceiptTypeName = "应付贷项"
    ReceiptType(34).lngReceiptID = 13

    ReceiptType(35).lngReceiptTypeID = 35
    ReceiptType(35).strReceiptTypeName = "应付借项"
    ReceiptType(35).lngReceiptID = 13

    ReceiptType(36).lngReceiptTypeID = 36
    ReceiptType(36).strReceiptTypeName = "应收借项"
    ReceiptType(36).lngReceiptID = 14
    
    ReceiptType(37).lngReceiptTypeID = 37
    ReceiptType(37).strReceiptTypeName = "应收贷项"
    ReceiptType(37).lngReceiptID = 14

    ReceiptType(38).lngReceiptTypeID = 38
    ReceiptType(38).strReceiptTypeName = "财务费用"
    ReceiptType(38).lngReceiptID = 14

    ReceiptType(39).lngReceiptTypeID = 39
    ReceiptType(39).strReceiptTypeName = "付款单"
    ReceiptType(39).lngReceiptID = 15

    ReceiptType(40).lngReceiptTypeID = 40
    ReceiptType(40).strReceiptTypeName = "收款单"
    ReceiptType(40).lngReceiptID = 16
    
    ReceiptType(41).lngReceiptTypeID = 41
    ReceiptType(41).strReceiptTypeName = "记帐凭证"
    ReceiptType(41).lngReceiptID = 17

    ReceiptType(42).lngReceiptTypeID = 42
    ReceiptType(42).strReceiptTypeName = "库存商品"
    ReceiptType(42).lngReceiptID = 18

    ReceiptType(43).lngReceiptTypeID = 43
    ReceiptType(43).strReceiptTypeName = "受托代销"
    ReceiptType(43).lngReceiptID = 18

    ReceiptType(44).lngReceiptTypeID = 44
    ReceiptType(44).strReceiptTypeName = "委托代销"
    ReceiptType(44).lngReceiptID = 18

    ReceiptType(45).lngReceiptTypeID = 45
    ReceiptType(45).strReceiptTypeName = "分期商品"
    ReceiptType(45).lngReceiptID = 18

    ReceiptType(46).lngReceiptTypeID = 46
    ReceiptType(46).strReceiptTypeName = "直运商品"
    ReceiptType(46).lngReceiptID = 18
    
    ReceiptType(47).lngReceiptTypeID = 47
    ReceiptType(47).strReceiptTypeName = "委托加工"
    ReceiptType(47).lngReceiptID = 18
    
    ReceiptType(48).lngReceiptTypeID = 48
    ReceiptType(48).strReceiptTypeName = "固资增加"
    ReceiptType(48).lngReceiptID = 19
    
    ReceiptType(49).lngReceiptTypeID = 49
    ReceiptType(49).strReceiptTypeName = "固资减少"
    ReceiptType(49).lngReceiptID = 19
    
    ReceiptType(50).lngReceiptID = 50
    ReceiptType(50).strReceiptTypeName = "其它变动"
    ReceiptType(50).lngReceiptID = 19
    
    ReceiptType(51).lngReceiptTypeID = 51
    ReceiptType(51).strReceiptTypeName = "固资卡片"
    ReceiptType(51).lngReceiptID = 20
End Sub
Private Sub InitTabName()
            TabName(1) = "Customer"        '单位
    TabName(2) = "Department"        '部门
    TabName(3) = "Employee"        '业务员
    TabName(4) = "Class1"        '统计
    TabName(5) = "Currencys"        '币种
    TabName(6) = "Term"        '付款条件
    TabName(7) = "Account"        '科目
    TabName(8) = "Item"        '商品
    TabName(9) = "Job"        '工程
    TabName(10) = "Position"        '货位
    TabName(11) = "Remark"        '摘要
    TabName(12) = "Custom1"        '自定义项目1
    TabName(13) = "Custom2"        '自定义项目2
    TabName(14) = "Custom3"        '自定义项目3
    TabName(15) = "Custom4"        '自定义项目4
    TabName(16) = "Custom5"        '自定义项目5
    TabName(17) = "Class2"        '项目
    TabName(18) = "Rate"        '汇率
    TabName(19) = "VoucherType"        '凭证类型
    TabName(20) = "Custom0"        '自定义项目0
    TabName(21) = "Template"        '单据模版
    TabName(22) = "AccountType"        '科目类型
    TabName(23) = ""
    TabName(24) = "CustomerAddress"     '单位发货地址
    TabName(25) = "CustomerBank"        '单位开户银行
    TabName(26) = "BusinessAddress"     '企业发货地址
    TabName(27) = "BusinessBank"        '企业开户银行
    TabName(28) = "ItemUnit"            '商品单位表
    TabName(29) = "Tax"                 '税率
    TabName(30) = "TransVoucher"        '转帐凭证
    TabName(31) = "Paymentmethod"       '付款方式
    TabName(32) = ""                    '发票类型
    TabName(33) = "Item"                '特殊的商品
    TabName(34) = "Operator"            '操作员
End Sub


Private Sub Class_Initialize()
    intGrdBorderWidth = Screen.TwipsPerPixelX
    intGrdBorderHeight = Screen.TwipsPerPixelY
    InitTabName
    InitReceiptArray
    
    Dim intCur As Integer
    Dim intRate As Integer
    
    CurRateDec gclsBase.NaturalCurId, intCur, intRate
    strDec = FormatString(intCur)
    intCurDecS = intCur
    strCurDec = strDec
    strPriceDec = FormatString(gclsBase.PriceDec)
    strRateDec = FormatString(intRate)
    intRateDecS = intRate
End Sub
'---------------------------------
'确定GRID上的某一行是否为空行
'出口：为TRUE时不是空行,为FALSE时是空行
'---------------------------------
Public Function blnNotNullRow(ByVal lngRow As Long) As Boolean
    If C2Lng(frmName.grdCol.TextMatrix(lngRow, ColProperty(xlngColItem).bytGrdIDCol)) <> 0 _
        And C2Dbl(frmName.grdCol.TextMatrix(lngRow, xlngColCurPrice)) <> 0 And C2Dbl(frmName.grdCol.TextMatrix(lngRow, xlngColAmount)) <> 0 Then
        blnNotNullRow = True
    Else
        blnNotNullRow = False
    End If
End Function
'--------------------------------------
'在GRID上删除一行
'入口：行号
'--------------------------------------
Public Function blnDeleteARow(ByVal lngRow As Long) As Boolean
    Dim recTmp As Recordset
    Dim strSql As String
    Dim lngID As Long
    lngID = C2Lng(frmName.grdCol.TextMatrix(lngRow, 0))
    On Error GoTo ErrorHandle
    If lngID > 0 Then
        strSql = "DELETE * FROM ItemActivityDetail WHERE lngActivityDetailID =" & lngID
        gclsBase.BaseDB.Execute strSql
   End If
        blnDeleteARow = True
EndProc:
    Exit Function
ErrorHandle:
    blnDeleteARow = False
'    gclsBase.BaseWorkSpace.RollBack
'    Resume Endproc
End Function

'------------------------------
'在GRID上写红字
'------------------------------
Public Sub WriteGrd(ByVal strText As String, ByVal lngRow As Long, ByVal lngCol As Long)
    Dim lngR As Long, lngC As Long
    Dim blnB As Boolean
    Dim strNew As String
    If lngRow > frmName.grdCol.Rows - 1 Or lngCol > frmName.grdCol.Cols - 1 Or _
       lngRow < 0 Or lngCol < 0 Then
        Exit Sub
    End If
    strText = Trim(strText)
    If frmName.grdCol.ColAlignment(lngCol) = flexAlignRightCenter And Len(strText) > 0 Then
        blnB = My.blnCtrlBinding
        My.blnRefresh = False
        My.blnCtrlBinding = False
        lngR = frmName.grdCol.Row
        lngC = frmName.grdCol.col
        frmName.grdCol.Row = lngRow
        frmName.grdCol.col = lngCol
        strNew = Left(strText, 1)
        If Val(strText) < 0 Then
            frmName.grdCol.CellForeColor = RGB(255, 0, 0)
            frmName.grdCol.TextMatrix(lngRow, lngCol) = IIf(Mid(Mid(strText, 2), 1, 1) = ".", "0" & Mid(strText, 2), Mid(strText, 2))
        ElseIf Val(strText) = 0 Then
            frmName.grdCol.CellForeColor = RGB(0, 0, 0)
            frmName.grdCol.TextMatrix(lngRow, lngCol) = ""
        Else
            frmName.grdCol.TextMatrix(lngRow, lngCol) = IIf(Mid(strText, 1, 1) = ".", "0" & strText, strText)
            frmName.grdCol.CellForeColor = RGB(0, 0, 0)
        End If
        If lngCol <> xlngColNumber And ColProperty(lngCol).lngCtrType = tCurrency Then  '金额类小数位调整
            strPriceDec = FormatString(gclsBase.PriceDec)
            Select Case lngCol
            Case xlngColCurOldPrice, xlngColCurOldPriceTax, xlngColCurPrice, xlngColCurPriceTax
                frmName.grdCol.TextMatrix(lngRow, lngCol) = Format(frmName.grdCol.TextMatrix(lngRow, lngCol), strPriceDec)
            Case xlngColCurAmount, xlngColCurAmountTax, xlngColCurTaxAmount
                frmName.grdCol.TextMatrix(lngRow, lngCol) = Format(frmName.grdCol.TextMatrix(lngRow, lngCol), strCurDec)
            Case xlngColOldPrice, xlngColOldPriceTax, xlngColPrice, xlngColPriceTax
                frmName.grdCol.TextMatrix(lngRow, lngCol) = Format(frmName.grdCol.TextMatrix(lngRow, lngCol), strPriceDec)
            Case xlngColAmount, xlngColAmountTax, xlngColTaxAmount
                frmName.grdCol.TextMatrix(lngRow, lngCol) = Format(frmName.grdCol.TextMatrix(lngRow, lngCol), strDec)
            End Select
        End If
        frmName.grdCol.Row = lngR
        frmName.grdCol.col = lngC
        My.blnCtrlBinding = blnB
        My.blnRefresh = True
    Else
        frmName.grdCol.TextMatrix(lngRow, lngCol) = strText
    End If

End Sub
'------------------------------
'从GRID上某一单元格内取出字符串
'------------------------------
Public Function strGrdCell(ByVal lngRow As Long, ByVal lngCol As Long) As String
    Dim lngR As Long, lngC As Long
    Dim blnB As Boolean
    If lngRow > frmName.grdCol.Rows - 1 Or lngCol > frmName.grdCol.Cols - 1 Or _
       lngRow < 0 Or lngCol < 0 Then
        Exit Function
    End If
    If frmName.grdCol.ColAlignment(lngCol) = flexAlignRightCenter Then
        blnB = My.blnCtrlBinding
        My.blnRefresh = False
        My.blnCtrlBinding = False
        lngR = frmName.grdCol.Row
        lngC = frmName.grdCol.col
        frmName.grdCol.Row = lngRow
        frmName.grdCol.col = lngCol
        If CLng(frmName.grdCol.CellForeColor) = CLng(RGB(255, 0, 0)) Then
            strGrdCell = "-" & FilterString(frmName.grdCol.TextMatrix(lngRow, lngCol))
        Else
            strGrdCell = FilterString(frmName.grdCol.TextMatrix(lngRow, lngCol))
        End If

        frmName.grdCol.Row = lngR
        frmName.grdCol.col = lngC
        My.blnCtrlBinding = blnB
        My.blnRefresh = True
    Else
        strGrdCell = frmName.grdCol.TextMatrix(lngRow, lngCol)
    End If
End Function

Private Sub Class_Terminate()
    Set mclsSubClass = Nothing
    Set mclsHook = Nothing
    Set HookHe = Nothing
    Erase Field
'    Erase PicLbl
    Erase ColProperty
    Erase lngPosition
    Erase strColRow
    Erase arrItemProperty
    Set ColBill = Nothing  '单据内容集合(不包括ActivityID和DetailID)
    Set ctrInput = Nothing
    Set ctrPicInput = Nothing
    Set frmName = Nothing
    Set clsRecord = Nothing
End Sub

Private Sub HookHe_OnMessage(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long, bCancel As Long)
    If Msg = WM_KEYDOWN Then
        If wParam = 37 Or wParam = 38 Or wParam = 39 Or wParam = 40 Or wParam = 9 Or wParam = 13 Then    'TAB键处理程序
            blnKeyInForm = True
        ElseIf wParam = 27 Then 'ESCAPE
            blnKeyInForm = True
        End If
    End If
    If Msg = WM_KEYUP Then
        If Not blnKeyInForm Then Exit Sub
        blnKeyInForm = False
        If wParam = 37 Or wParam = 38 Or wParam = 39 Or wParam = 40 Or wParam = 9 Then      'TAB键处理程序
            If Not m_bBusy Then
                m_bBusy = True
                TabOrder (wParam)
'                bCancel = 1
                m_bBusy = False
            End If
        ElseIf wParam = 27 Then 'ESCAPE