frmadjustcost.frm

金算盘软件代码

            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
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(3) = "该张受托代销调价单已经生成记帐凭证，不能删除其中的分录！"
    strMsg1(4) = "该张受托代销调价单已经生成记帐凭证，不能修改其中的分录！"
    Select Case intIndex
        Case 0  '插入记录
            clsBill.InsertARow
        Case 1  '删除记录
            If IsVoucher_ItemActivity(clsBill.lngNowID) > 0 Then
                ShowMsg Me.hwnd, strMsg1(3), MB_OK + MB_ICONEXCLAMATION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "删除分录"
                Exit Sub
            End If
            If chkPrint(1).Value = 1 Then
                intYesNo = ShowMsg(Me.hwnd, strMsg1(1), MB_YESNO + MB_ICONQUESTION + 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
'                    Exit Sub
'                End If
                If grdCol.Row >= 1 And grdCol.Rows > 2 Then
                    grdCol.RemoveItem grdCol.Row
                    clsBill.setAllItemproperty
                    grdCol.col = xlngColItem
                ElseIf grdCol.Row = 1 Then
                    clsBill.InsertARow True
                    grdCol.RemoveItem 2
                    grdCol.col = xlngColItem
                    clsBill.setAllItemproperty
                End If
                clsBill.blnCtrlBinding = True
                clsBill.grdCol_EnterCell
                clsBill.BuildNoteMsg True
                For i% = 1 To grdCol.Cols - 1
                    If grdCol.ColAlignment(i%) = 7 Then lblTotal(i%).Caption = CStr(clsBill.dblTotalOfCol(i%))
                Next i%
                                
           End If
        Case 2  'bar
        Case 3  '复制记录
            clsBill.CopyARow
        Case 4  '粘贴记录
            clsBill.PasteARow
        Case 5  'Bar
        Case 6  '搜索
            frmTreeFind.ShowFind
        Case 7  '查询缺号
            Dim frmTmp As Form
            Set frmTmp = New frmBillNo
            frmTmp.ShowTypeID C2Lng(lblHead(2).Tag)
            Set frmTmp = Nothing
    End Select
    '合计行计算
    clsBill.writeTotal
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(3) = "该张受托代销调价单已经生成记帐凭证，不能删除！"
    strMsg(4) = "该张受托代销调价单已经生成记帐凭证，不能修改！"
    Select Case intIndex
    Case 0  '插入单据
'        clsBill.GetANewBill lblHead(5 - 1).Tag, lblHead(3 - 1).Tag, lblField(1).Caption
        ShowANewBill
    Case 1  '删除单据
        If IsVoucher_ItemActivity(clsBill.lngNowID) > 0 Then
            ShowMsg Me.hwnd, strMsg(3), MB_OK + MB_ICONEXCLAMATION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "删除分录"
            Exit Sub
        End If
        If chkPrint(1).Value = 1 Then
            intYesNo = ShowMsg(Me.hwnd, strMsg(1), MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "删除受托代销调价单")
        Else
            intYesNo = ShowMsg(Me.hwnd, strMsg(0), MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "删除受托代销调价单")
        End If
        If intYesNo = IDYES Then
            strSql = "DELETE * FROM ItemActivity WHERE lngActivityID=" & clsBill.lngNowID
            gclsBase.BaseDB.Execute strSql
            strSql = "DELETE * FROM ItemActivityDetail WHERE lngActivityID=" & clsBill.lngNowID
            gclsBase.BaseDB.Execute strSql
            Dim dtmDate1 As Date
            dtmDate1 = C2Date(lblField(2).Caption)
            clsBill.intAccountYear = gclsBase.FYearOfDate(dtmDate1)   '会计年度
            clsBill.bytAccountPeriod = gclsBase.PeriodOfDate(dtmDate1)   '会计期间
            blnMaxNODecrease clsBill.intAccountYear, clsBill.bytAccountPeriod, C2Lng(lblHead(2).Tag), strAlphaOfStr(lblField(1).Caption), C2Lng(strDigitOfStr(lblField(1).Caption))
            clsBill.blnIsChanged = False
            clsBill.lngNowID = 0
            gclsSys.SendMessage Me.hwnd, 30 + C2Lng(lblHead(2).Tag)
            ShowANewBill
        End If
    Case 2  'BAR
    Case 3  '复制单据
        clsBill.SaveBillToCollection
    Case 4  '粘贴单据
        clsBill.LoadBillFromCollection
    Case 5  'BAR
    Case 6  '搜索
        frmTreeFind.ShowFind
    Case 7  '查询单据缺号
        Dim frmTmp As Form
        Set frmTmp = New frmBillNo
        frmTmp.ShowTypeID C2Lng(lblHead(2).Tag)
        Set frmTmp = Nothing
    End Select
    '合计行计算
    clsBill.writeTotal
End Sub
Private Sub refTmpID_Change()
    clsBill.TemplateChange C2Lng(lblHead(4).Tag)
End Sub

Private Sub SaveActivity(recTmp As Recordset)
    With recTmp
        !lngActivityTypeID = ReceiptType2ActivityType(C2Lng(lblHead(3 - 1).Tag))
        !lngReceiptTypeID = C2Lng(lblHead(3 - 1).Tag)
        !strReceiptNo = SubStr(strAlphaOfStr(LTrim(lblField(1).Caption)), 1, 6)
        !lngReceiptNo = C2Lng(strDigitOfStr(LTrim(lblField(1).Caption)))
        !lngTemplateID = C2Lng(lblHead(5 - 1).Tag)
        BillPublic.setPrevPlateAndBillNo !lngReceiptTypeID, !lngTemplateID, !strReceiptNo
        !lngCustomerID = IIf(lblHead(1).Visible, C2Lng(lblHead(1 - 1).Tag), 0)
        !lngDepartmentID = IIf(lblField(4).Visible, clsBill.getFieldID(4), 0)
        !lngEmployeeID = IIf(lblField(3).Visible, clsBill.getFieldID(3), 0)
        !lngClassID2 = IIf(lblField(7).Visible, clsBill.getFieldID(7), 0)
        !lngClassID1 = IIf(lblField(8).Visible, clsBill.getFieldID(8), 0)
        !lngCurrencyID = IIf(lblField(6).Visible, clsBill.getFieldID(6), 0)
        !dblRate = IIf(lblField(5).Visible, C2Dbl(lblField(5).Caption), 1)
        !strDate = lblField(2).Caption
        !lngOperatorID = gclsBase.OperatorID
        Dim strT As String
        strT = lblmemo(1).Caption
        !strNote = IIf(strLen(strT) < 40, strT + " ", SubStr(strT, 1, 40))
        !blnIsPrint = IIf(chkPrint(0).Value = 0, False, True)
        !blnIsVoid = IIf(chkPrint(1).Value = 0, False, True)
    End With
End Sub
Private Sub SaveActivityDetailBody(recTmp As Recordset, ByVal i As Integer)
    Dim arrItemProperty As ItemProperty
    Dim strSql As String
    Dim dblFactor As Double
        
    BillPublic.GetItemProperty C2Lng(grdCol.TextMatrix(i, xlngColItemID)), arrItemProperty
    With recTmp
        !lngRowID = i
        !lngItemID = C2Lng(clsBill.strGrdCell(i, xlngColItemID))
        !lngUnitID = C2Lng(clsBill.strGrdCell(i, xlngColItemUnitID))
        dblFactor = ConvertFactor(!lngUnitID, !lngItemID)
        !dblCurrPrice = Format(C2Dbl(clsBill.strGrdCell(i, xlngColCurOldPrice)) / dblFactor, FormatString(gclsBase.PriceDec))
        !dblCurrNewPrice = Format(C2Dbl(clsBill.strGrdCell(i, xlngColCurPrice)) / dblFactor, FormatString(gclsBase.PriceDec))
        !dblQuantity = C2Dbl(NumberConvert(clsBill.strGrdCell(i, xlngColNumber), dblFactor, True))
        !dblCurrAmount = C2Dbl(clsBill.strGrdCell(i, xlngColCurAmount))
        !dblAmount = C2Dbl(clsBill.strGrdCell(i, xlngColAmount))
        !lngTaxID = C2Lng(clsBill.strGrdCell(i, xlngColTaxID))
        !dblCurrTaxAmount = C2Dbl(clsBill.strGrdCell(i, xlngColCurTaxAmount))
        !dblTaxAmount = C2Dbl(clsBill.strGrdCell(i, xlngColTaxAmount))
        !lngJobID = C2Lng(clsBill.strGrdCell(i, xlngColJobID))
        !lngCustomID0 = C2Lng(clsBill.strGrdCell(i, xlngColCustom0ID))
        !lngCustomID1 = C2Lng(clsBill.strGrdCell(i, xlngColCustom1ID))
        !lngCustomID2 = C2Lng(clsBill.strGrdCell(i, xlngColCustom2ID))
        !lngCustomID3 = C2Lng(clsBill.strGrdCell(i, xlngColCustom3ID))
        !lngCustomID4 = C2Lng(clsBill.strGrdCell(i, xlngColCustom4ID))
        !lngCustomID5 = C2Lng(clsBill.strGrdCell(i, xlngColCustom5ID))
        If chkPrint(1).Value <> 1 Then
            Dim priceTmp1, priceTmp2 As Double
            Select Case arrItemProperty.strCostMethod
                Case "7"
                priceTmp1 = C2Dbl(clsBill.strGrdCell(i, xlngColPrice))
    '            priceTmp2 = (priceTmp1 / (1 + TaxIDToRate(!lngTaxID))) / dblFactor
                priceTmp2 = C2Dbl(Format(priceTmp1 / dblFactor, FormatString(gclsBase.PriceDec)))
                
                strSql = "UPDATE Item SET dblSalePrice = " & priceTmp2 _
                    & ",dblMaxSalePrice=IIF(dblMaxSalePrice>" & priceTmp2 & ",dblMaxSalePrice, " & priceTmp2 _
                    & "),dblMinSalePrice=IIF(dblMinSalePrice<" & priceTmp2 & ",dblMinSalePrice, " & priceTmp2 _
                    & "),dblRecenetSalePrice=" & priceTmp2 _
                    & " WHERE lngItemId = " & C2Lng(clsBill.strGrdCell(i, xlngColItemID))
            Case "6"
                priceTmp1 = C2Dbl(clsBill.strGrdCell(i, xlngColPrice))
                priceTmp2 = priceTmp1 / dblFactor
                strSql = "UPDATE Item SET dblPlanPrice = " & priceTmp2 _
                    & " WHERE lngItemId = " & C2Lng(clsBill.strGrdCell(i, xlngColItemID))
            Case Else
                priceTmp1 = C2Dbl(clsBill.strGrdCell(i, xlngColPrice))
                priceTmp2 = priceTmp1 / dblFactor
                strSql = "UPDATE Item SET dblPurchasePrice = " & priceTmp2 _
                    & ",dblMaxPurchasePrice=IIF(dblMaxPurchasePrice>" & priceTmp2 & ",dblMaxPurchasePrice, " & priceTmp2 _
                    & "),dblMinPurchasePrice=IIF(dblMinPurchasePrice<" & priceTmp2 & ",dblMinPurchasePrice, " & priceTmp2 _
                    & "),dblRecenetPurchasePrice=" & priceTmp2 _
                    & " WHERE lngItemId = " & C2Lng(clsBill.strGrdCell(i, xlngColItemID))
            End Select
            gclsBase.BaseDB.Execute strSql
        End If
        '设已存储标志
        grdCol.TextMatrix(i, 0) = !lngActivityDetailID
    End With
End Sub
Private Function SaveNewBill() As Boolean
    Dim recActivity As Recordset
    Dim recDetail As Recordset
    Dim lngNewActivityID As Long
    Dim dtmDate1 As Date
    Dim strAlpha As String
    Dim lngDigit As Long
    Dim i As Long
'    On Error GoTo ErrorHandle
    Dim recTemp As Recordset
    
    '制单日合法性校验
    If gclsBase.PeriodClosed(lblField(2).Caption) Then
        ShowMsg Me.hwnd, "制单日不能在已结帐期间内！", MB_ICONEXCLAMATION + MB_OK + MB_SYSTEMMODAL, "保存单据"
        lblField(2).Caption = Format(gclsBase.BaseDate, "yyyy-mm-dd")
        SaveNewBill = False
        Exit Function
    End If
    If clsBill.blnIsChanged = False Then
        SaveNewBill = True
        Exit Function
    Else
        SaveNewBill = False
    End If
'    If clsBill.DataValid() = False Then
'        Exit Function
'    End If
    Me.MousePointer = vbHourglass
    gclsBase.BaseWorkSpace.BeginTrans
    '修改商品表
    Set recActivity = gclsBase.BaseDB.OpenRecordset( _
            "SELECT * FROM itemActivity where false", dbOpenDynaset)
    If recActivity Is Nothing Then
        gclsBase.BaseWorkSpace.RollBack
        GoTo EndProc
    End If
    With recActivity
        .AddNew
            lngNewActivityID = !lngActivityID
            SaveActivity recActivity
            '取出重用信息
            dtmDate1 = !strDate
            strAlpha = !strReceiptNo
            lngDigit = !lngReceiptNo
        .Update
        '设置已存储(修改)标志
        clsBill.lngNowID = lngNewActivityID
            
    End With
    clsBill.intAccountYear = gclsBase.FYearOfDate(dtmDate1)   '会计年度
    clsBill.bytAccountPeriod = gclsBase.PeriodOfDate(dtmDate1)   '会计期间
    '修改最大编号表
    If blnModifyMaxNO(clsBill.intAccountYear, clsBill.bytAccountPeriod, _
                C2Lng(lblHead(3 - 1).Tag), strAlpha, CStr(lngDigit)) = False Then
        gclsBase.BaseWorkSpace.RollBack
        clsBill.lngNowID = 0
        For i = 1 To grdCol.Rows - 1
            grdCol.TextMatrix(i, 0) = 0
        Next i
        GoTo EndProc
    End If
    '修改明细表
    Set recDetail = gclsBase.BaseDB.OpenRecordset( _
            "SELECT * FROM ItemActivityDetail where false", _
            dbOpenDynaset)
    With recDetail
        If grdCol.Rows >= 2 Then
            For i = 1 To grdCol.Rows - 1
                If clsBill.blnNotNullRow(i) Then
                    .AddNew
                        !lngActivityID = lngNewActivityID
                        grdCol.TextMatrix(i, 0) = !lngActivityDetailID
                        SaveActivityDetailBody recDetail, i
                    .Update
                End If
            Next i
        End If
    End With
    
    gclsBase.BaseWorkSpace.CommitTrans
    clsBill.blnIsChanged = False
'    mclsMainControl.Messages.Add 30 + C2Lng(lblHead(2).Tag)
    gclsSys.SendMessage Me.hwnd, 30 + C2Lng(lblHead(2).Tag)
    SaveNewBill = True
EndProc:
    If Not recActivity Is Nothing Then
        recActivity.Close
    End If
    If Not recDetail Is Nothing Then
        recDetail.Close
    End If
    Me.MousePointer = vbDefault
    Exit Function

ErrorHandle:

    gclsBase.BaseWorkSpace.RollBack
    Dim edtBill As ErrDealType
    
    clsBill.lngNowID = 0
    For i = 1 To grdCol.Rows - 1
        grdCol.TextMatrix(i, 0) = 0
    Next i
    
    edtBill = Errors.ErrorsDeal
    ShowMsg Me.hwnd, "保存单据失败！ ", MB_ICONEXCLAMATION + MB_SYSTEMMODAL, "保存单据"
    If edtBill = edtResume Then
       Resume EndProc
    End If
    If edtBill = edtCanNotKnown Then
       Resume EndProc
    End If
    If edtBill = edtCanNotResume Then
       Resume EndProc