frmsettleinvoice.frm

金算盘软件代码

            blnSucceed = gclsBase.ExecSQL(strSql)
            If Not blnSucceed Then GoTo Err
        Else
            dblQuantity = NormalToMinQty(GetValue(lngRow, mintChkQtyCol), mdblFactor)
            dblSumQuantity = dblSumQuantity + dblQuantity
        End If
    Next lngRow
    
    dblAmount = C2Dbl(hlb(mintChkAmtCol).Caption)
    strSql = "UPDATE ItemActivityDetail SET dblCurrInvoiceAmount=" & dblAmount _
        & ",dblInvoiceQuantity=" & dblSumQuantity _
        & " WHERE lngActivityDetailID=" & mlngDetailID
    blnSucceed = gclsBase.ExecSQL(strSql)
    If Not blnSucceed Then GoTo Err
    
    strSql = "DELETE FROM " & IIf(mlngViewID = 1190, "PurchaseToInvoice", "SaleToInvoice") & " WHERE dblQuantity=0 AND dblCurrAmount=0"
    blnSucceed = gclsBase.ExecSQL(strSql)
    If Not blnSucceed Then GoTo Err
    strSql = "UPDATE ItemActivityDetail SET blnCloseInvoice=" & chkClose.Value & " WHERE lngActivityDetailID=" & mlngDetailID
    blnSucceed = gclsBase.ExecSQL(strSql)
    If Not blnSucceed Then GoTo Err
    
    gclsBase.BaseWorkSpace.CommitTrans
    mblnModify = False
    mblnOk = True
    SaveData = True
    If intQuit = 1 Then
       Unload Me
    End If
    Exit Function

Err:
    gclsBase.BaseWorkSpace.RollBacktrans
    ShowMsg Me.hWnd, "存盘失败：" & Err.Description, MB_SYSTEMMODAL + MB_ICONEXCLAMATION, Caption
End Function

'Flexgrid显示栏目设置
Private Sub setColumn()
    If mblnModify Then
        If ShowMsg(Me.hWnd, "栏目设置后，你刚刚做的核销将被取消，需要先存盘吗?", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "发票核销") = IDYES Then
            If Not SaveData(0) Then Exit Sub
        End If
    End If
    mclsGrid.GridToListSet
    mclsGrid.ListSet.SaveList
    If mclsGrid.ListSet.ShowListSet(mclsGrid.ListSet.ViewId, False) Then
        RefreshGrid
    End If
End Sub

Private Sub Form_Load()
    Me.HelpContextID = 17004
    mblnIsExpense = False
    Set mclsGrid = New Grid
    Set mclsGrid.Grid = msgGrid
    cmdOk(0).Picture = Utility.GetFormResPicture(1001, 0)
    cmdOk(1).Picture = Utility.GetFormResPicture(1002, 0)
    Set Me.Icon = Utility.GetFormResPicture(139, vbResIcon)
End Sub

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

    If mblnModify Then
        If ShowMsg(Me.hWnd, "数据未保存，是否退出?", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, Caption) = IDNO Then
            Cancel = True
            Exit Sub
        End If
    End If
    
    Set mclsGrid = Nothing
    Utility.RemoveFormResPicture 1001
    Utility.RemoveFormResPicture 1002
    Utility.RemoveFormResPicture 139
End Sub

'从Flexgrid中取出数字值
Private Function GetValue(lngRow As Long, intCol As Integer, Optional strType As String = "Double") As Variant
    GetValue = GetGridValue(lngRow, intCol, strType, msgGrid)
End Function

Private Sub mclsGrid_BeforeEdit(blnCancel As Boolean)
    Dim lngRow As Long
    lngRow = msgGrid.Row
'    If GetValue(lngRow, mintVoucherCol) > 0 Then
'        ShowMsg Me.hwnd, "发票已生成凭证,不能修改！", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, Caption
'        blnCancel = True
'    End If
End Sub

Private Sub mclsGrid_DataValid(blnCancel As Boolean)
    Dim dblChkAmount As Double
    Dim dblChkQuantity As Double
    Dim dblLastChkAmount As Double
    Dim dblLastChkQuantity As Double
    Dim lngRow As Long
    
    lngRow = msgGrid.Row
    Select Case msgGrid.col
    Case mintChkAmtCol
        dblLastChkAmount = GetValue(lngRow, mintTotalAmtCol) - GetValue(lngRow, mintLastUnChkAmtCol)
        If GetValue(lngRow, mintTotalAmtCol) > 0 Then
            If txtEdit.Value > 0 Then
                If Abs(GetValue(lngRow, mintUnChkAmtCol)) < Abs(txtEdit.Value) Then
                    ShowMsg Me.hWnd, "核销金额不能大于未核销金额！", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, Caption
                    blnCancel = True
                End If
            Else
                If dblLastChkAmount < Abs(txtEdit.Value) Then
                    ShowMsg Me.hWnd, "核销金额(绝对值)不能大于核销金额！", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, Caption
                    blnCancel = True
                End If
            End If
        ElseIf GetValue(lngRow, mintTotalAmtCol) < 0 Then
            If txtEdit.Value < 0 Then
                If Abs(GetValue(lngRow, mintUnChkAmtCol)) < Abs(txtEdit.Value) Then
                    ShowMsg Me.hWnd, "核销金额(绝对值)不能大于未核销金额(绝对值)！", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, Caption
                    blnCancel = True
                End If
            Else
                If Abs(dblLastChkAmount) < Abs(txtEdit.Value) Then
                    ShowMsg Me.hWnd, "核销金额(绝对值)不能大于核销金额！", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, Caption
                    blnCancel = True
                End If
            End If
        End If
        If Not blnCancel Then
            If txtEdit.Value <> 0 Then
                msgGrid.TextMatrix(lngRow, 1) = "√"
            Else
                msgGrid.TextMatrix(lngRow, 1) = ""
            End If
            
            If SamePrice(GetValue(lngRow, mintTotalQtyCol), GetValue(lngRow, mintTotalAmtCol)) Then
                If GetValue(lngRow, mintTotalAmtCol) <> 0 Then
                    dblChkQuantity = GetValue(lngRow, mintTotalQtyCol) * txtEdit.Value / GetValue(lngRow, mintTotalAmtCol)
                Else
                    dblChkQuantity = 0
                End If
                msgGrid.TextMatrix(lngRow, mintChkQtyCol) = MinToNormalQty(dblChkQuantity, mdblFactor)
            End If
            ShowHlb mintChkAmtCol, C2Dbl(hlb(mintChkAmtCol).Caption) + txtEdit.Value - GetValue(lngRow, mintChkAmtCol)
        End If
    Case mintChkQtyCol
        dblLastChkQuantity = GetValue(lngRow, mintTotalQtyCol) - GetValue(lngRow, mintLastUnChkQtyCol)
        dblLastChkQuantity = C2Dbl(MinToNormalQty(dblLastChkQuantity, mdblFactor))
        txtEdit.Text = NormalQty(txtEdit.Value, mdblFactor)
        If GetValue(lngRow, mintTotalQtyCol) > 0 Then
            If txtEdit.Value > 0 Then
                If Abs(GetValue(lngRow, mintUnChkQtyCol)) < Abs(txtEdit.Value) Then
                    ShowMsg Me.hWnd, "核销数量不能大于未核销数量！", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, Caption
                    blnCancel = True
                End If
            Else
                If dblLastChkQuantity < Abs(txtEdit.Value) Then
                    ShowMsg Me.hWnd, "核销数量(绝对值)不能大于核销数量！", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, Caption
                    blnCancel = True
                End If
            End If
        ElseIf GetValue(lngRow, mintTotalQtyCol) < 0 Then
            If txtEdit.Value < 0 Then
                If Abs(GetValue(lngRow, mintUnChkQtyCol)) < Abs(txtEdit.Value) Then
                    ShowMsg Me.hWnd, "核销数量(绝对值)不能大于未核销数量(绝对值)！", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, Caption
                    blnCancel = True
                End If
            Else
                If Abs(dblLastChkQuantity) < Abs(txtEdit.Value) Then
                    ShowMsg Me.hWnd, "核销数量(绝对值)不能大于核销数量！", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, Caption
                    blnCancel = True
                End If
            End If
        End If
        If Not blnCancel Then
            If txtEdit.Value <> 0 Then
                msgGrid.TextMatrix(lngRow, 1) = "√"
            Else
                msgGrid.TextMatrix(lngRow, 1) = ""
            End If
            
            If SamePrice(GetValue(lngRow, mintTotalQtyCol), GetValue(lngRow, mintTotalAmtCol)) Then
                dblChkAmount = GetValue(lngRow, mintTotalAmtCol) * NormalToMinQty(txtEdit.Value, mdblFactor) _
                    / GetValue(lngRow, mintTotalQtyCol)
                ShowHlb mintChkAmtCol, C2Dbl(hlb(mintChkAmtCol).Caption) + dblChkAmount - GetValue(lngRow, mintChkAmtCol)
                msgGrid.TextMatrix(lngRow, mintChkAmtCol) = strFormat(dblChkAmount, mintCurrencyDec)
            End If
        End If
    End Select
    
    If Not blnCancel Then
        lblNote(9).Caption = Format(mdblAmount - mdblInvoiceAmount - C2Dbl(hlb(mintChkAmtCol).Caption), mstrCurrFormat)
        mblnModify = True
    End If
End Sub

Private Sub mclsGrid_BeforeSave(blnCancel As Boolean)
    Dim dblUnChkAmount As Double
    Dim dblUnChkQuantity As Double
    Dim lngRow As Long
    
    lngRow = msgGrid.Row
    Select Case msgGrid.col
    Case mintChkAmtCol
        If mintTotalQtyCol <> 0 And SamePrice(GetValue(lngRow, mintTotalQtyCol), GetValue(lngRow, mintTotalAmtCol)) Then
            If txtEdit.Value <> 0 Then
                msgGrid.TextMatrix(lngRow, mintChkQtyCol) = MinToNormalQty((GetValue(lngRow, mintTotalQtyCol) * txtEdit.Value / msgGrid.TextMatrix(lngRow, mintTotalAmtCol)), mdblFactor)
            End If
        End If
    Case mintChkQtyCol
        If mintTotalQtyCol <> 0 And SamePrice(GetValue(lngRow, mintTotalQtyCol), GetValue(lngRow, mintTotalAmtCol)) Then
            If txtEdit.Value <> 0 Then
                msgGrid.TextMatrix(lngRow, mintChkAmtCol) = msgGrid.TextMatrix(lngRow, mintTotalAmtCol) * NormalToMinQty(txtEdit.Value, mdblFactor) / msgGrid.TextMatrix(lngRow, mintTotalQtyCol)
                msgGrid.TextMatrix(lngRow, mintChkQtyCol) = NormalQty(txtEdit.Value, mdblFactor)
                blnCancel = True
            End If
        End If
    End Select
End Sub

'本函数用于做核销与非核销处理
Private Sub msgGrid_Click()
    Dim lngRow As Long
    
    On Error GoTo Err
    
    If msgGrid.MouseRow > 0 And msgGrid.MouseRow < msgGrid.Rows And msgGrid.MouseCol = 1 And mlngVoucherID = 0 Then
        mblnModify = True
        lngRow = msgGrid.MouseRow
'        If GetValue(lngRow, mintVoucherCol) <= 0 Then
            If msgGrid.TextMatrix(lngRow, 1) = "" Then
                If (GetValue(lngRow, mintLastUnChkQtyCol) <> (GetValue(lngRow, mintChkQtyCol)) _
                    Or GetValue(lngRow, mintLastUnChkAmtCol) <> (GetValue(lngRow, mintChkAmtCol))) And C2Dbl(lblNote(9).Caption) <> 0 Then       '打√情况
                    msgGrid.TextMatrix(lngRow, 1) = "√"
                    If Abs(C2Dbl(lblNote(9).Caption)) >= Abs(GetValue(lngRow, mintLastUnChkAmtCol)) Then
                        msgGrid.TextMatrix(lngRow, mintChkAmtCol) = msgGrid.TextMatrix(lngRow, mintUnChkAmtCol)
                        ShowHlb mintChkAmtCol, C2Dbl(hlb(mintChkAmtCol).Caption) + GetValue(lngRow, mintUnChkAmtCol)
                        msgGrid.TextMatrix(lngRow, mintChkQtyCol) = MinToNormalQty(GetValue(lngRow, mintLastUnChkQtyCol), mdblFactor)
                    Else
                        msgGrid.TextMatrix(lngRow, mintChkAmtCol) = C2Dbl(lblNote(9).Caption)
                        ShowHlb mintChkAmtCol, C2Dbl(hlb(mintChkAmtCol).Caption) + C2Dbl(lblNote(9).Caption)
                        msgGrid.TextMatrix(lngRow, mintChkQtyCol) = MinToNormalQty(GetValue(lngRow, mintTotalQtyCol) * GetValue(lngRow, mintChkAmtCol) / GetValue(lngRow, mintTotalAmtCol), mdblFactor)
                    End If
                End If
            Else
                '取消打√(核销)情况
                msgGrid.TextMatrix(lngRow, 1) = ""
                ShowHlb mintChkAmtCol, C2Dbl(hlb(mintChkAmtCol).Caption) - GetValue(lngRow, mintChkAmtCol)
                msgGrid.TextMatrix(lngRow, mintChkAmtCol) = ""
                msgGrid.TextMatrix(lngRow, mintChkQtyCol) = ""
            End If
            lblNote(9).Caption = Format(mdblAmount - mdblInvoiceAmount - C2Dbl(hlb(mintChkAmtCol).Caption), mstrCurrFormat)
'        End If
    End If
    Exit Sub

Err:
    ShowMsg Me.hWnd, Err.Description, MB_SYSTEMMODAL + MB_ICONEXCLAMATION, Caption
End Sub

Private Sub msgGrid_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    With msgGrid
        If .MouseCol = 1 And mlngVoucherID = 0 Then
            .MousePointer = vbCustom
        Else
            .MousePointer = vbDefault
        End If
    End With
End Sub

'右键菜单
Private Sub msgGrid_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbRightButton And msgGrid.Rows > 1 Then
'        PopupMenu Me.MenuPopup, , X + 118, Y + 418
    End If
End Sub


Private Sub FindColPosition()
    mintUnChkAmtCol = GetGridCol("未核销金额", msgGrid)
    mintUnChkQtyCol = GetGridCol("未核销数量", msgGrid)
    mintChkAmtCol = GetGridCol("核销金额", msgGrid)
    mintChkQtyCol = GetGridCol("核销数量", msgGrid)
End Sub

Private Sub RefreshGrid()
    Dim intCount As Integer
    
    On Error Resume Next
    
    Set mclsGrid.Form = Me
    msgGrid.FixedCols = 0
    mclsGrid.ShowTotal = True
    mclsGrid.ListSet.ViewId = mlngViewID
    Set datSource.Resultset = GetList()
    If datSource.Resultset.EOF Then
        cmdOk(0).Enabled = False
        cmdOk(2).Enabled = False
        cmdOk(3).Enabled = False
    Else
        cmdOk(0).Enabled = (mlngVoucherID = 0)
        cmdOk(2).Enabled = (mlngVoucherID = 0)
        cmdOk(3).Enabled = (mlngVoucherID = 0)
    End If
    mclsGrid.ColOfs = mintOffsetCol
    FindColPosition
    msgGrid.ColWidth(0) = 0
    msgGrid.ColWidth(1) = 480
    intCount = 2
    While intCount < mintOffsetCol
        msgGrid.ColWidth(intCount) = 0
        intCount = intCount + 1
    Wend
    mclsGrid.ListSetToGrid
    mclsGrid.ListSet.ColumnFieldDec(mintUnChkAmtCol - mintOffsetCol + 1) = mintCurrencyDec
    mclsGrid.ListSet.ColumnFieldDec(mintChkAmtCol - mintOffsetCol + 1) = mintCurrencyDec
    mclsGrid.SetupStyle
    ShowTotalRow
    If mlngVoucherID = 0 Then
        Set mclsGrid.EditText = txtEdit
        mclsGrid.SetEditText ("核销金额")
        mclsGrid.SetEditText ("核销数量")
    End If
End Sub

Private Sub ShowHlb(ByVal intCol As Integer, ByVal dblAmount As Double)
    hlb(intCol).Caption = strFormat(dblAmount, mintCurrencyDec)
End Sub

Private Function SamePrice(ByVal dblQuantity As Double, ByVal dblAmount As Double) As Boolean
    If mdblQuantity <> 0 And dblQuantity <> 0 Then
        If AdjustDec(mdblAmount / mdblQuantity, gclsBase.PriceDec) = AdjustDec(dblAmount / dblQuantity, gclsBase.PriceDec) Then
            SamePrice = True
        End If
    End If
End Function