frmcalcamount.frm

金算盘软件代码

    
    '加载窗体位置
    Utility.LoadFormSetting Me
    Me.MousePointer = vbDefault
End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next

    '保存窗体位置
    Utility.SaveFormSetting Me
    '释放窗体资源
    Utility.UnLoadFormResPicture Me
    
    Set mclsGrid = Nothing

End Sub


Private Sub Form_Activate()
    Dim lngRow As Long
    SetHelpID HelpContextID
    
    If mclsGrid.ListSet.ViewId = 0 Then
        Me.MousePointer = vbHourglass
        
        '如果没有初始Grid
        msgTable.FixedCols = 0
        mclsGrid.ListSet.ViewId = mViewID
        Set datItem.Resultset = GetList()
        msgTable.ColWidth(1) = 0
        msgTable.ColWidth(2) = 0
        msgTable.ColWidth(3) = 0
        msgTable.ColWidth(4) = 0
        msgTable.ColWidth(5) = 0
        msgTable.ColWidth(6) = 0
        msgTable.ColWidth(7) = 0
        msgTable.ColWidth(8) = 0
        msgTable.ColWidth(9) = 0
        msgTable.ColWidth(10) = 0
        msgTable.ColWidth(11) = 400
        If Not datItem.Resultset Is Nothing Then
            Set mclsGrid.Grid = msgTable
            mclsGrid.ColOfs = 12
            mclsGrid.SetupStyle
            mclsGrid.ListSetToGrid
        Else
            msgTable.Cols = 2
        End If
        
        Me.MousePointer = vbDefault
    End If
    frmMain.SetEditUnEnabled
End Sub

Private Sub msgTable_Click()
    Dim strSql As String
    Dim lngRow As Long
    
    With msgTable
        If .MouseCol = mintColCheck Then
            If .MouseRow < .Rows And .MouseRow >= .FixedRows Then
                lngRow = .MouseRow
                If .TextMatrix(lngRow, mintColCheck) = "√" Then
                    .TextMatrix(lngRow, mintColCheck) = ""
                    strSql = "UPDATE ItemActivityDetail SET lngCostOrder=0 " _
                        & "WHERE lngActivityDetailID=" & .TextMatrix(lngRow, mintColDetailID)
                Else
                   .TextMatrix(.MouseRow, mintColCheck) = "√"
                    strSql = "UPDATE ItemActivityDetail SET lngCostOrder=" & mlngID _
                        & " WHERE lngActivityDetailID=" & .TextMatrix(lngRow, mintColDetailID)
                End If
                gclsBase.ExecSQL strSql
            End If
        End If
    End With
End Sub

Private Sub msgTable_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    With msgTable
        If .MouseCol = mintColCheck Then
            If .MousePointer <> flexCustom Then .MousePointer = flexCustom
        Else
            If .MousePointer <> flexDefault Then .MousePointer = flexDefault
        End If
    End With
End Sub

Private Sub ChoiceAll()
    Dim strSql As String
    Dim strID As String
    Dim lngRow As Long
    
    With msgTable
        For lngRow = 1 To .Rows - 1
            If .TextMatrix(lngRow, mintColCheck) <> "√" Then
               .TextMatrix(lngRow, mintColCheck) = "√"
                If strID = "" Then
                    strID = .TextMatrix(lngRow, mintColDetailID)
                Else
                    strID = strID & "," & .TextMatrix(lngRow, mintColDetailID)
                End If
            End If
        Next lngRow
    End With
    
    If strID <> "" Then
        strSql = "UPDATE ItemActivityDetail SET lngCostOrder=" & mlngID _
            & " WHERE lngActivityDetailID IN (" & strID & ")"
        gclsBase.ExecSQL strSql
    End If
End Sub

Private Sub ClearAll()
    Dim strSql As String
    Dim strID As String
    Dim lngRow As Long
    
    With msgTable
        For lngRow = 1 To .Rows - 1
            If .TextMatrix(lngRow, mintColCheck) = "√" Then
               .TextMatrix(lngRow, mintColCheck) = ""
                If strID = "" Then
                    strID = .TextMatrix(lngRow, mintColDetailID)
                Else
                    strID = strID & "," & .TextMatrix(lngRow, mintColDetailID)
                End If
            End If
        Next lngRow
    End With
    
    If strID <> "" Then
        strSql = "UPDATE ItemActivityDetail SET lngCostOrder=0" _
            & " WHERE lngActivityDetailID IN (" & strID & ")"
        gclsBase.ExecSQL strSql
    End If
End Sub


Private Sub GenCostAdjust()
    Dim strSql As String
    Dim lngRow As Long
    Dim refUpdate As rdoQuery
    Dim recDetail As rdoResultset
    Dim dblAmount As Double
    Dim blnFirst As Boolean
    Dim lngCostActivityID As Long
    Dim lngActivityDetailID As Long
    Dim errNo As Long
    
    On Error GoTo ErrHandle
    
    strSql = "DELETE FROM ItemActivityDetail " _
        & "WHERE lngActivityID IN (SELECT lngActivityID FROM ItemActivity " _
        & "WHERE strDate>='" & Format(mdtmStart, "yyyy-mm-dd") & "' AND strDate<='" & Format(mdtmEnd, "yyyy-mm-dd") & "' " _
        & "AND lngActivityTypeID=" & atOutCostAdjust & " AND strReceiptNo='CB')"
    gclsBase.ExecSQL strSql
    
    strSql = "DELETE FROM ItemActivity " _
        & "WHERE strDate>='" & Format(mdtmStart, "yyyy-mm-dd") & "' AND strDate<='" & Format(mdtmEnd, "yyyy-mm-dd") & "' AND strReceiptNo='CB' " _
        & "AND lngActivityTypeID=" & atOutCostAdjust
    gclsBase.ExecSQL strSql
    
    BillPublic.blnMaxNODecrease mintYear, mintPeriod, rtOutCostAdjust, "CB", 99999999
    
    blnFirst = True
    With msgTable
        For lngRow = 1 To .Rows - 1
            If .TextMatrix(lngRow, mintColCheck) = "√" Then
                If blnFirst Then
                    lngCostActivityID = GetNewID("ItemActivity")
                    strSql = "INSERT INTO ItemActivity(intYear,bytPeriod,lngActivityID,lngActivityTypeID,lngReceiptTypeID," _
                        & "strReceiptNo,lngReceiptNo,lngTemplateID,lngCurrencyID,dblRate,lngOperatorID,strDate) " _
                        & "VALUES(" & mintYear & "," & mintPeriod & "," & lngCostActivityID & "," & atOutCostAdjust & "," _
                        & rtOutCostAdjust & ",'CB'," & TransferPublic.GetMaxNO(mintYear, mintPeriod, rtOutCostAdjust, "CB", Format(mdtmEnd, "yyyy-mm-dd")) & "," _
                        & GettemplateID(rtOutCostAdjust) & "," & gclsBase.NaturalCurId & ",1," & gclsBase.OperatorID & ",'" _
                        & Format(mdtmEnd, "YYYY-MM-DD") & "')"
                    If Not gclsBase.ExecSQL(strSql) Then GoTo ErrHandle
                    blnFirst = False
                End If
                    
                strSql = "UPDATE ItemActivityDetail SET lngCostOrder=" & mlngID _
                    & " WHERE lngActivityDetailID=" & .TextMatrix(lngRow, mintColDetailID)
                gclsBase.ExecSQL strSql
                
                dblAmount = C2Dbl(msgTable.TextMatrix(lngRow, mintColAmt))
                strSql = "UPDATE ItemActivityDetail SET dblAmount=dblAmount+" & dblAmount _
                    & ",dblCurrAmount=dblCurrAmount+" & dblAmount _
                    & ",dblCostAmount=dblCostAmount+" & dblAmount _
                    & ",dblAvgCostAmount=dblAvgCostAmount+" & dblAmount _
                    & " WHERE lngActivityID=" & lngCostActivityID & " AND lngItemID=" & C2lng(msgTable.TextMatrix(lngRow, mintColItemID)) _
                    & " AND lngPositionID=" & C2lng(msgTable.TextMatrix(lngRow, 3)) _
                    & " AND strProduceNum='" & msgTable.TextMatrix(lngRow, 4) & "'" _
                    & " AND lngCustomID0=" & C2lng(msgTable.TextMatrix(lngRow, 5)) _
                    & " AND lngCustomID1=" & C2lng(msgTable.TextMatrix(lngRow, 6)) _
                    & " AND lngCustomID2=" & C2lng(msgTable.TextMatrix(lngRow, 7)) _
                    & " AND lngCustomID3=" & C2lng(msgTable.TextMatrix(lngRow, 8)) _
                    & " AND lngCustomID4=" & C2lng(msgTable.TextMatrix(lngRow, 9)) _
                    & " AND lngCustomID5=" & C2lng(msgTable.TextMatrix(lngRow, 10))
                gclsBase.ExecSQL strSql
                If gclsBase.BaseDB.RowsAffected = 0 Then
                    lngActivityDetailID = GetNewID("ItemActivityDetail")
                    strSql = "INSERT INTO ItemActivityDetail(lngActivityID,lngActivityDetailID,lngItemID,lngUnitID,lngRowID,lngPositionID," _
                        & "strProduceNum,lngCustomID0,lngCustomID1,lngCustomID2,lngCustomID3,lngCustomID4,lngCustomID5," _
                        & "dblAmount,dblCurrAmount,dblCostAmount,dblAvgCostAmount) " _
                        & "VALUES(" & lngCostActivityID & "," & lngActivityDetailID & "," & C2lng(msgTable.TextMatrix(lngRow, mintColItemID)) & "," _
                        & C2lng(msgTable.TextMatrix(lngRow, mintColUnitID)) & "," & lngRow & "," _
                        & C2lng(msgTable.TextMatrix(lngRow, 3)) & ",'" & (msgTable.TextMatrix(lngRow, 4)) & "'," _
                        & C2lng(msgTable.TextMatrix(lngRow, 5)) & "," & C2lng(msgTable.TextMatrix(lngRow, 6)) & "," _
                        & C2lng(msgTable.TextMatrix(lngRow, 7)) & "," & C2lng(msgTable.TextMatrix(lngRow, 8)) & "," _
                        & C2lng(msgTable.TextMatrix(lngRow, 9)) & "," & C2lng(msgTable.TextMatrix(lngRow, 10)) & "," _
                        & dblAmount & "," & dblAmount & "," & dblAmount & "," & dblAmount & ")"
                    gclsBase.ExecSQL strSql
                End If
                
'                UpdateItemDaily2 C2lng(msgTable.TextMatrix(lngRow, mintColItemID)), _
'                    Format(mdtmEnd, "yyyy-mm-dd"), atOutCostAdjust, cmFIFO, dblAmount, 0, 0, _
'                    msgTable.TextMatrix(lngRow, 4), C2lng(msgTable.TextMatrix(lngRow, 5)), _
'                    C2lng(msgTable.TextMatrix(lngRow, 6)), C2lng(msgTable.TextMatrix(lngRow, 7)), _
'                    C2lng(msgTable.TextMatrix(lngRow, 8)), C2lng(msgTable.TextMatrix(lngRow, 9)), _
'                    C2lng(msgTable.TextMatrix(lngRow, 10))
'                UpdatePositionDaily C2lng(msgTable.TextMatrix(lngRow, mintColItemID)), _
'                    Format(mdtmEnd, "yyyy-mm-dd"), atOutCostAdjust, cmFIFO, dblAmount, 0, 0, _
'                    C2lng(msgTable.TextMatrix(lngRow, 3)), (msgTable.TextMatrix(lngRow, 4)), _
'                    C2lng(msgTable.TextMatrix(lngRow, 5)), C2lng(msgTable.TextMatrix(lngRow, 6)), _
'                    C2lng(msgTable.TextMatrix(lngRow, 7)), C2lng(msgTable.TextMatrix(lngRow, 8)), _
'                    C2lng(msgTable.TextMatrix(lngRow, 9)), C2lng(msgTable.TextMatrix(lngRow, 10))
            Else
                strSql = "UPDATE ItemActivityDetail SET lngCostOrder=0 WHERE lngActivityDetailID=" & .TextMatrix(lngRow, mintColDetailID)
                gclsBase.ExecSQL strSql
            End If
        Next lngRow
    End With
    If lngCostActivityID > 0 Then
        strSql = "DELETE FROM ItemActivityDetail WHERE lngActivityID=" & lngCostActivityID & " AND dblAmount=0"
        gclsBase.ExecSQL strSql
        strSql = "SELECT lngActivityDetailID FROM ItemActivityDetail WHERE lngActivityID=" & lngCostActivityID & " AND dblAmount<>0"
        Set recDetail = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
        If recDetail.EOF Then
            recDetail.Close
            Set recDetail = Nothing
            strSql = "DELETE FROM ItemActivityDetail WHERE lngActivityID=" & recDetail!lngActivityDetailID
            gclsBase.ExecSQL strSql
            strSql = "DELETE FROM ItemActivity WHERE lngActivityID=" & lngCostActivityID
            gclsBase.ExecSQL strSql
        Else
            recDetail.Close
            Set recDetail = Nothing
        End If
    End If
    Exit Sub
    
ErrHandle:
    errNo = Errors.ErrorsDeal(True, Me)
    Select Case errNo
    Case edtResume: Resume
    Case edtResumeNext: Resume Next
    Case edtCanNotKnown
        ShowMsg hwnd, "程序出错：" & Err.Description, vbOKOnly + vbCritical, Caption
    End Select
End Sub