frmsubmitadjustbill.frm

金算盘软件代码

                    End If
            Else
                clsBill.Memo_Click index
            End If
            clsBill.UpdateMainEditMenu
    End Select
    blnNotRaiseEvents = True
    DoEvents
    blnNotRaiseEvents = False
End Sub

Private Sub lblNote_MouseDown(index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
''    If blnNotRaiseEvents Then Exit Sub
''    If Index < 2 Then Exit Sub
''    Select Case Button
''        Case vbRightButton
''            clsBill.bytRegion = FNote
''            clsBill.bytIndex = Index
''            clsBill.UpdateMainEditMenu
''            MakeListEditMenu
''            clsBill.blnNotRespondKeyPress = True
''            PopupMenu frmMain.mnuListEdit
''            clsBill.blnNotRespondKeyPress = False
''            Exit Sub
''        Case vbLeftButton
''            If Index = 3 Or Index = 5 Then
''                    If x >= lblNote(Index).width - clsBill.DropButtonWidth And _
''                       x <= lblNote(Index).width And _
''                       y >= 0 And _
''                       y <= lblNote(Index).Height Then
''                        clsBill.Note_Click Index, True
''                    Else
''                        clsBill.Note_Click Index, False
''                    End If
''            Else
''                clsBill.Note_Click Index
''            End If
'''            clsBill.UpdateMainEditMenu
''    End Select
''    blnNotRaiseEvents = True
''    DoEvents
''    blnNotRaiseEvents = False
End Sub

Private Sub mclsMainControl_ChildActive()
    If mclsMainControl Is Nothing Then
        Exit Sub
    End If
    SetHelpID C2lng(Me.HelpContextID)
    ResponseMessage
    gclsSys.CurrFormName = Me.hWnd
End Sub

Private Sub mclsMainControl_EditDel()
   mclsMainControl_ListEditMenu (1)
End Sub

Private Sub mclsMainControl_EditDelLine()
    mclsMainControl_ListActivityMenu (1)
End Sub

Private Sub mclsMainControl_EditInActive()
    If chkPrint(1).Value <> 0 Then
        chkPrint(1).Value = 0
    Else
        chkPrint(1).Value = 1
    End If
    clsBill.UpdateMainEditMenu
End Sub

Private Sub mclsMainControl_EditInsLine()
    mclsMainControl_ListActivityMenu (0)
End Sub

Private Sub mclsMainControl_EditNew()
   mclsMainControl_ListEditMenu (0)
End Sub

Private Sub mclsMainControl_EditSearch()
    clsBill.cmdButton_Click 0
    frmTreeFind.Show
End Sub

Private Sub mclsMainControl_EditShowAll()
    If chkPrint(0).Value <> 0 Then
        chkPrint(0).Value = 0
    Else
        chkPrint(0).Value = 1
    End If
    clsBill.UpdateMainEditMenu
End Sub

Private Sub mclsMainControl_EditShowList()
   ShowRelationList
End Sub

Private Sub mclsMainControl_FilePrintReceipt()
    If clsBill.blnIsChanged Then
        If SaveBill() = False Then Exit Sub
    End If
    frmPrintReceipt.ShowfrmPrintReceipt 35
End Sub

Private Sub mclsMainControl_ListActivityMenu(ByVal intIndex As Integer)
    Dim strMsg(5) As String, strMsg1(5) As String
    Dim intYesNo As Integer
    Dim i%, j%
    strMsg1(0) = "确实要删除该条代销调拨单记录吗？"
    strMsg1(1) = "确实要删除该条已经作废代销调拨单记录吗？"
    strMsg1(2) = "该张代销调拨单已经收款,删除将要影响对应的收款单记录,确实要删除该条代销调拨单记录吗？"
    strMsg1(3) = "该张代销调拨单已经生成记帐凭证,不能删除！"
    strMsg1(4) = "该张代销调拨单已经生成记帐凭证,不能修改！"
    clsBill.cmdButton_Click 0
    Select Case intIndex
        Case 0  '插入记录
            clsBill.CHK_CLICK 0
            clsBill.InsertARow
            GrdCol.col = 1
            clsBill.grdCol_EnterCell False
            MakeListActivityMenu
        Case 1  '删除记录
'            If clsBill.lngNowID <> 0 Then
'                If clsLst.IsVoucher(clsBill.lngNowID) Then
'                    ShowMsg Me.hwnd, strMsg1(3), MB_ICONQUESTION + MB_DEFBUTTON1 + MB_SYSTEMMODAL, "警告信息"
'                    Exit Sub
'                End If
'            End If
            If chkPrint(1).Value = True Then
                intYesNo = ShowMsg(Me.hWnd, strMsg1(1), MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "删除单据")
'            ElseIf blnReceiveMoney(clsBill.lngNowID) Then
'                intYesNo = ShowMsg(Me.hwnd, strMsg1(2), MB_YESNO + MB_ICONEXCLAMATION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "删除单据")
            Else
                intYesNo = ShowMsg(Me.hWnd, strMsg1(0), MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "删除单据")
            End If
            If intYesNo = IDYES Then
                clsBill.blnCtrlBinding = False
                If Not clsBill.blnDeleteARow(GrdCol.Row) Then
                    ShowMsg Me.hWnd, "删除当前记录失败！", MB_OK + MB_ICONEXCLAMATION + MB_SYSTEMMODAL, "删除单据"
                    clsBill.SetAFocus
                    Exit Sub
                End If
'                If grdCol.Row >= 1 Then
'                    grdCol.RemoveItem grdCol.Row
'                    clsBill.bytRegion = FcmdButton
'                    clsBill.bytIndex = 0
'                    clsBill.InputCtrInvisible
'                    clsBill.setAllItemproperty
'                End If
                clsBill.blnCtrlBinding = True
                clsBill.grdCol_EnterCell
                clsBill.BuildNoteMsg True
                clsBill.WriteTotalRow
                MakeListActivityMenu
            Else
                clsBill.SetAFocus
            End If
        Case 2  'bar
        Case 3  '复制记录
            clsBill.CopyARow
            MakeListActivityMenu
            clsBill.SetAFocus
        Case 4  '粘贴记录
            clsBill.PasteARow
            MakeListActivityMenu
            clsBill.SetAFocus
        Case 5  'Bar
        Case 6  '搜索
            frmTreeFind.Show
        Case 7  '查询缺号
            Dim frmDlg As New frmBillNo
             frmDlg.ShowTypeID 26
            clsBill.SetAFocus
    End Select
End Sub

Private Sub mclsMainControl_ListEditMenu(ByVal intIndex As Integer)
    Dim strMsg(5) As String
    Dim intYesNo As Integer
    Dim i%, j%
    strMsg(0) = "确实要删除该张代销调拨单全部记录吗？"
    strMsg(1) = "确实要删除该张已经作废代销调拨单全部记录吗？"
    strMsg(2) = "该张应付单已经收款,删除将要影响对应的收款单记录,确实要删除该张代销调拨单全部记录吗？"
    strMsg(3) = "该张代销调拨单已经生成记帐凭证,不能删除！"
    strMsg(4) = "该张代销调拨单已经生成记帐凭证,不能修改！"
    clsBill.cmdButton_Click 0
    Select Case intIndex
        Case 0  '插入单据
'            clsBill.GetANewBill lblHead(5 - 1).Tag, lblHead(3 - 1).Tag, lblField(1).Caption
            If clsBill.lngNowID = 0 And clsBill.blnIsChanged = False Then Exit Sub
            ShowANewBill
        Case 1  '删除单据
            Dim mclsAdjust  As New clsAdjust
            clsBill.blnIsChanged = False
            mclsAdjust.SethWnd Me.hWnd
            If Not mclsAdjust.DeleteLendAdjust(lngInActivityID) Then
                clsBill.SetAFocus
                Exit Sub
            End If
            gclsSys.SendMessage Me.hWnd, 56
            ShowANewBill
'            gclsSys.SendMessage Me.hwnd, 56
        Case 2  'BAR
        Case 3  '复制单据
            clsBill.SaveBillToCollection
            MakeListEditMenu
            clsBill.SetAFocus
        Case 4  '粘贴单据
            clsBill.LoadBillFromCollection
            MakeListEditMenu
            clsBill.SetAFocus
        Case 5  'BAR
        Case 6  '搜索
            frmTreeFind.Show
        Case 7  '查询单据缺号
             Dim frmTmp As Form
             Set frmTmp = New frmBillNo
             frmTmp.ShowTypeID 26
            clsBill.SetAFocus
        Case 8  '模板表体列宽恢复
            ModifyColWidthDefault Me
            clsBill.TemplateChange C2lng(lblHead(4).Tag)
            clsBill.SetAFocus
        Case 10
            CallBillList 26, True
        Case 11
            CallBillList 26, False
        Case 12
            GotoOldBill
        Case 13
            mclsMainControl_FilePrintReceipt
        Case 15
            CmdNote_Click
            clsBill.SetAFocus
    End Select
End Sub
Private Sub refTmpID_Change()
    clsBill.TemplateChange C2lng(lblHead(4).Tag)
End Sub

Private Sub SaveActivity(ByVal recTmp As rdoResultset, ByVal i As Integer)
    With recTmp
        !lngReceiptTypeID = 26
        !blnIsPrinted = 0
        !lngTemplateID = C2lng(lblHead(4).Tag)
        If i = 1 Then
           !lngCustomerID = C2lng(lblHead(2).Tag) '调入单位
           !lngActivityTypeID = 24
        Else
           !lngCustomerID = C2lng(lblHead(0).Tag) '调出单位
           !lngActivityTypeID = 25
        End If
'        !strReceiptNo = strAlphaOfStr(LTrim(lblField(2).Caption)) '单据编号前缀
'        !lngReceiptNo = C2Dbl(strDigitOfStr(LTrim(lblField(2).Caption))) '单据号
        !strReceiptNo = IIf(SubStr(strAlphaOfStr(LTrim(lblField(2).Caption)), 1, 6) = "", " ", SubStr(strAlphaOfStr(LTrim(lblField(2).Caption)), 1, 6))
        !lngReceiptNo = C2Dbl(strDigitOfStr(LTrim(lblField(2).Caption)))
        !strDate = lblField(3).Caption '日期
        !intYear = clsBill.intAccountYear
        !bytPeriod = clsBill.bytAccountPeriod
        !lngDepartmentID = clsBill.getFieldID(4) '部门
        !lngEmployeeID = clsBill.getFieldID(5) '业务员
        !dblRate = C2Dbl(lblField(6).Caption) _
               '汇率
        !lngCurrencyID = IIf(clsBill.getFieldID(7) > 0, clsBill.getFieldID(7), gclsBase.NaturalCurId) '币种
        !lngClassID2 = clsBill.getFieldID(8) '项目
        !lngClassID1 = clsBill.getFieldID(9) '统计
        !lngOperatorID = C2lng(LblMemo(5).Tag) '操作员
        !strNote = IIf(SubStr(Trim(LblMemo(1).Caption), , 40) = "", " ", SubStr(Trim(LblMemo(1).Caption), , 40))
        !blnIsPrint = IIf(chkPrint(0).Value = 0, 0, 1)
        !blnIsVoid = IIf(chkPrint(1).Value = 0, 0, 1)
    
    End With
End Sub
Private Sub SaveActivityDetailBody(recTmp As rdoResultset, ByVal i As Integer _
        , ByVal lngInActivityID As Long, ByVal lngOutActivityID As Long _
        , Optional ByVal blnIsAddNew As Boolean = True)
    Dim j As Integer
    Dim dblCostAmount As Double
    Dim dblCostDiff As Double
    Dim dblSaleTax As Double
    Dim lngDetailID As Long
'成本方法-------------------------------------------------------------------------------------------------------
    Dim recTmp2 As rdoResultset
    Dim strSql As String
    
    strSql = "SELECT dblCostAmount,dblCostDiff,dblSaleTax,dblAmount,dblTaxAmount FROM ItemActivityDetail WHERE lngActivityDetailID=" & C2lng(GrdCol.TextMatrix(i, 30))
    Set recTmp2 = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
    If recTmp2.EOF = False Then
        dblCostAmount = recTmp2!dblCostAmount / (recTmp2!dblAmount + recTmp2!dblTaxAmount)
        dblCostDiff = recTmp2!dblCostDiff / (recTmp2!dblAmount + recTmp2!dblTaxAmount)
        dblSaleTax = recTmp2!dblSaleTax / (recTmp2!dblAmount + recTmp2!dblTaxAmount)
    Else
        dblCostAmount = 0
        dblCostDiff = 0
        dblSaleTax = 0
    End If
    recTmp2.Close
    Set recTmp2 = Nothing
'-------------------------------------------------------------------------------------------------------
    
    With recTmp
        Dim lngCount As Long
        For j = 1 To 2
            If blnIsAddNew Then
                .AddNew
                !lngActivityDetailID = GetNewID("ItemActivityDetail")
            Else
                If j = 1 Then  '入库
                    lngDetailID = C2lng(GrdCol.TextMatrix(i, 41))
                Else  '出库
                    lngDetailID = C2lng(GrdCol.TextMatrix(i, 0))
                End If
                If lngDetailID = 0 Then
                    .AddNew
                    !lngActivityDetailID = GetNewID("ItemActivityDetail")
                Else
                    If LocateRec(recTmp, lngDetailID, lngCount) = False Then
                        .AddNew
                        !lngActivityDetailID = GetNewID("ItemActivityDetail")
                    Else
                        .Edit
                    End If
                End If
            End If
            !lngRowID = i
            !lngItemID = C2lng(GrdCol.TextMatrix(i, 29)) '商品
            !lngOrderDetailID = C2lng(GrdCol.TextMatrix(i, 30)) '订单ID
            If clsBill.blnItemIsBatch(i) Then
                UpdatePiCiInfo recTmp
            End If

            !lngUnitID = C2Dbl(GrdCol.TextMatrix(i, 31)) '单位
            !dblQuantity = NumberConvert(clsBill.strGrdCell(i, 5), C2Dbl(GrdCol.TextMatrix(i, 40)))    '调拨数量
            !dblDiscountRate = 100
            If j = 1 Then
                GrdCol.TextMatrix(i, 41) = !lngActivityDetailID
                !lngActivityID = lngInActivityID
                !dblCurrPrice = C2Dbl(clsBill.strGrdCell(i, 14)) / C2Dbl(GrdCol.TextMatrix(i, 40)) '调入单价
                !dblCurrPriceTax = C2Dbl(clsBill.strGrdCell(i, 15)) / C2Dbl(GrdCol.TextMatrix(i, 40)) '调入含税单价
                !dblCurrAmount = C2Dbl(clsBill.strGrdCell(i, 16)) '调入原币金额
                !dblAmount = C2Dbl(clsBill.strGrdCell(i, 17)) '调入本币金额
                !dblCurrTaxAmount = C2Dbl(clsBill.strGrdCell(i, 18)) '调入原币税额
                !dblTaxAmount = C2Dbl(clsBill.strGrdCell(i, 19)) '调入本币税额
            Else
                GrdCol.TextMatrix(i, 0) = !lngActivityDetailID
                !lngActivityID = lngOutActivityID
                !dblCurrPrice = C2Dbl(clsBill.strGrdCell(i, 6)) / C2Dbl(GrdCol.TextMatrix(i, 40)) '调出单价
                !dblCurrPriceTax = C2Dbl(clsBill.strGrdCell