frmdlpayment.frm

金算盘软件代码

    If Me.Height < mintFormHeight Then Me.Height = mintFormHeight
    If Me.Width < mintFormWidth Then Me.Width = mintFormWidth
    RedrawForm

End Sub
Private Sub RedrawForm()
    '重画MS FlexGrid 控件
    Dim leftx As Integer
    On Error Resume Next
    With msgGrid
        .Left = ListFormLeft
        .Width = ScaleWidth - ListFormLeft - 5 * ListFormRight - DlFormButtonWidth
        .Height = ScaleHeight - .top - 2 * ListFormBottom - hLb(0).Height
    End With
    
    '重画其余控件
    leftx = ScaleWidth - 2 * ListFormRight - DlFormButtonWidth
    Cmdall(0).Left = leftx
    Cmdall(6).Left = leftx
    Cmdall(1).Left = leftx
    Cmdall(2).Left = leftx
    Cmdall(3).Left = leftx
    Cmdall(4).Left = leftx
    
    Cmdall(6).top = Me.ScaleTop + lblPayAmount.Height + lblPayAmount.top
    Cmdall(1).top = Cmdall(6).top + 9 + DlFormButtonHeight
    Cmdall(2).top = Cmdall(1).top + 133 + DlFormButtonHeight
    Cmdall(3).top = Cmdall(2).top + 9 + DlFormButtonHeight
    Cmdall(4).top = Cmdall(3).top + 9 + DlFormButtonHeight
    
    lblNote(0).top = 120
    lblCustomer.top = 120
    lblNote(0).Left = msgGrid.Left
    lblCustomer.Left = msgGrid.Left + 600
    lblCustomer.Width = Int(msgGrid.Width / 3.5)
    
    lblNote(1).top = 120
    lblCurrency.top = 120
    
    lblNote(1).Left = lblCustomer.Left + lblCustomer.Width + Int(msgGrid.Width / 88)
    lblCurrency.Left = lblNote(1).Left + lblNote(1).Width - 7
    lblCurrency.Width = Int(msgGrid.Width / 7)
    
    lblNote(2).top = 120
    lblPayAmount.top = 120
    lblPayAmount.Width = Int(msgGrid.Width / 5.5)
    lblPayAmount.Left = leftx - lblPayAmount.Width + 128
    lblNote(2).Left = lblPayAmount.Left - lblNote(2).Width + 7
    mclsGrid.TotalRowAdjust
    Me.Refresh
End Sub

Private Sub setColumn()
'响应栏目设置操作
Dim intCount As Integer
    Dim lngRow As Long

    On Error GoTo Err
    
    If mblnModify Then
        If ShowMsg(Me.hwnd, "栏目设置后，你刚刚做的结算将被取消，需要先存盘吗？", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "应付款核销") = IDYES Then
           SaveData False
        Else
           mdblPayAmount = mdblPayAmount + C2Dbl(hLb(mintEditAmtCol).Caption)
           lblPayAmount.Caption = strFormat(mdblPayAmount, mintCurrencyDec)
           hLb(mintEditAmtCol).Caption = ""
        End If
    End If
    mclsGrid.GridToListSet
    mclsGrid.ListSet.SaveList
    If mclsGrid.ListSet.ShowListSet(mclsGrid.ListSet.ViewId) Then
        msgGrid.Rows = 1
        msgGrid.FixedCols = 0
        'Set datAP.Recordset = GetList()
        Set datAP.Resultset = GetList()
        FindColPosition
        mclsGrid.ListSetToGrid
        mclsGrid.SetupStyle
    End If
    Exit Sub

Err:
    ShowMsg Me.hwnd, "栏目设置操作不成功！    ", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, "栏目设置"
End Sub

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_DataValid(blnCancel As Boolean)
    Dim lngRow As Long
    Dim dblChkQty As Double
    Dim dblChkAmt As Double
    
    lngRow = msgGrid.Row
    Select Case msgGrid.col
    Case mintEditAmtCol
        If Abs(txtEdit.Value) > Abs(GetValue(lngRow, mintLastBalAmtCol)) Then
            If txtEdit.Visible Then
                ShowMsg Me.hwnd, "核销金额不能大于未核销金额！", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, msgcaption
            End If
            blnCancel = True
        Else
            If Abs(txtEdit.Value) > Abs(mdblPayAmount + GetValue(lngRow, mintEditAmtCol)) Then
                If txtEdit.Visible Then
                    ShowMsg Me.hwnd, "核销金额不能大于可核销金额！", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, msgcaption
                End If
                blnCancel = True
            End If
        End If
    Case mintEditQtyCol
        If GetValue(lngRow, mintTotalQtyCol) <> 0 Then
            dblChkQty = NormalToMinQty(txtEdit.Value, GetValue(lngRow, mintFactorCol))
            If Abs(dblChkQty) > Abs(GetValue(lngRow, mintLastBalQtyCol)) Then
                If txtEdit.Visible Then
                    ShowMsg Me.hwnd, "核销数量不能大于未核销数量！", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, msgcaption
                End If
                blnCancel = True
            End If
        End If
    End Select
End Sub

Private Sub mclsGrid_BeforeSave(blnCancel As Boolean)
    Dim lngRow As Long
    Dim dblChkQty As Double
    Dim dblChkAmt As Double
    
    mblnModify = True
    lngRow = msgGrid.Row
    Select Case msgGrid.col
    Case mintEditAmtCol
        dblChkAmt = txtEdit.Value
        If mintEditQtyCol > 0 Then
            If GetValue(lngRow, mintTotalQtyCol) <> 0 Then
                dblChkQty = GetValue(lngRow, mintTotalQtyCol) * txtEdit.Value / GetValue(lngRow, mintTotalAmtCol)
                msgGrid.TextMatrix(lngRow, mintEditQtyCol) = MinToNormalQty(dblChkQty, GetValue(lngRow, mintFactorCol))
            End If
        End If
        If dblChkAmt <> 0 Then
            msgGrid.TextMatrix(lngRow, mintCheckCol) = "√"
        Else
            msgGrid.TextMatrix(lngRow, mintCheckCol) = ""
        End If
    Case mintEditQtyCol
        If GetValue(lngRow, mintTotalQtyCol) <> 0 Then
            dblChkQty = NormalToMinQty(txtEdit.Value, GetValue(lngRow, mintFactorCol))
            dblChkAmt = GetValue(lngRow, mintTotalAmtCol) * dblChkQty / GetValue(lngRow, mintTotalQtyCol)
            msgGrid.TextMatrix(lngRow, mintEditAmtCol) = dblChkAmt
        End If
    End Select
    mdblPayAmount = mdblPayAmount - (dblChkAmt - GetValue(lngRow, mintEditAmtCol))
    lblPayAmount.Caption = strFormat(mdblPayAmount, mintCurrencyDec)
    ShowHlb C2Dbl(hLb(mintEditAmtCol).Caption) + (dblChkAmt - GetValue(lngRow, mintEditAmtCol))
    If dblChkAmt <> 0 Then
        msgGrid.TextMatrix(lngRow, mintCheckCol) = "√"
    Else
        msgGrid.TextMatrix(lngRow, mintCheckCol) = ""
        txtEdit.Text = "0"
    End If
End Sub

Private Sub mclsGrid_AfterRefresh(lngRow As Long)
    With msgGrid
        If mintBalQtyCol > 0 Then
            .TextMatrix(lngRow, mintBalQtyCol) = MinToNormalQty(GetValue(lngRow, mintLastBalQtyCol), GetValue(lngRow, mintFactorCol))
        End If
        If mintEditQtyCol > 0 Then
            .TextMatrix(lngRow, mintEditQtyCol) = MinToNormalQty(GetValue(lngRow, mintLastChkQtyCol), GetValue(lngRow, mintFactorCol))
        End If
        Debug.Print .TextMatrix(lngRow, mintBalAmtCol) & .TextMatrix(lngRow, mintEditAmtCol)
    End With
End Sub

Private Sub msgGrid_Click()
    Dim lngRow As Long
    Dim intQtyCol As Integer
    Dim intAmtCol As Integer
    Dim dblAmount As Double
    
    On Error GoTo Err
    
    lngRow = msgGrid.Row
    If msgGrid.Rows > msgGrid.FixedRows And msgGrid.MouseCol = mintCheckCol Then
        intAmtCol = mintEditAmtCol
        intQtyCol = mintEditQtyCol
        If msgGrid.TextMatrix(lngRow, mintCheckCol) <> "√" Then
            msgGrid.TextMatrix(lngRow, mintCheckCol) = "√"
            If mdblPayAmount * GetValue(lngRow, mintLastBalAmtCol) > 0 Then
                If mdblPayAmount >= GetValue(lngRow, mintLastBalAmtCol) And mdblPayAmount > 0 _
                    Or mdblPayAmount <= GetValue(lngRow, mintLastBalAmtCol) And mdblPayAmount < 0 Then
                    msgGrid.TextMatrix(lngRow, intAmtCol) = msgGrid.TextMatrix(lngRow, mintLastBalAmtCol)
                    mdblPayAmount = mdblPayAmount - GetValue(lngRow, mintLastBalAmtCol)
                Else
                    msgGrid.TextMatrix(lngRow, intAmtCol) = mdblPayAmount
                    mdblPayAmount = 0
                End If
            Else
                msgGrid.TextMatrix(lngRow, intAmtCol) = msgGrid.TextMatrix(lngRow, mintLastBalAmtCol)
                mdblPayAmount = mdblPayAmount - GetValue(lngRow, mintLastBalAmtCol)
            End If
            mclsGrid.FormatCell lngRow, intAmtCol
            ShowHlb C2Dbl(hLb(intAmtCol).Caption) + GetValue(lngRow, intAmtCol)
            lblPayAmount.Caption = strFormat(mdblPayAmount, mintCurrencyDec)
            If intQtyCol > 0 And (GetValue(lngRow, mintTableIDCol) <> 1) Then        '=2表示是商品表
                If (GetValue(lngRow, mintLastBalQtyCol) <> 0) And (GetValue(lngRow, intAmtCol) <> 0) Then
                    msgGrid.TextMatrix(lngRow, intQtyCol) = GetValue(lngRow, mintLastBalQtyCol) * GetValue(lngRow, intAmtCol) / GetValue(lngRow, intAmtCol)
                End If
            End If
        Else
            msgGrid.TextMatrix(lngRow, mintCheckCol) = ""
            mdblPayAmount = mdblPayAmount + GetValue(lngRow, intAmtCol)
            ShowHlb C2Dbl(hLb(intAmtCol).Caption) - GetValue(lngRow, intAmtCol)
            lblPayAmount.Caption = strFormat(mdblPayAmount, mintCurrencyDec)
            msgGrid.TextMatrix(lngRow, intAmtCol) = 0
            mclsGrid.FormatCell lngRow, intAmtCol
        End If
        mclsGrid.FormatCell lngRow, intAmtCol
        mblnModify = True
    End If
    Exit Sub

Err:
    ShowMsg Me.hwnd, "在进行核销与非核销操作时失败！ ", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, "应付款核销"
End Sub

Private Sub msgGrid_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
'鼠标在GRID中移动时响应的事件
    With msgGrid
        If .MouseCol = mintCheckCol 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.mnuPopup, , x + 118, y + 418
    End If
End Sub

Private Sub FindColPosition()
    mintEditAmtCol = GetGridCol("本次核销", msgGrid)
    mintEditQtyCol = GetGridCol("核销数量", msgGrid)
    mintBalAmtCol = GetGridCol("未核销金额", msgGrid)
    mintBalQtyCol = GetGridCol("未核销数量", msgGrid)
End Sub

Private Sub ShowHlb(dblAmount As Double)
    If dblAmount <> 0 Then
        hLb(mintEditAmtCol).Caption = strFormat(dblAmount, mintCurrencyDec)
    Else
        hLb(mintEditAmtCol).Caption = ""
    End If
End Sub

Private Function GetActivity(lngDetailID As Long) As Boolean
    Dim strSql As String
    'Dim recDetail As Recordset
    Dim recDetail As rdoResultset
    
    mstrActivityFrom = "应收应付"
    
    'Strsql = "SELECT strDate,lngCustomerID,lngActivityTypeID,lngCurrencyID,dblCurrAmount,dblCurrPaymentAmount,blnIsReceipt " _
        & "FROM ActivityDetail INNER JOIN Activity ON ActivityDetail.lngActivityID=Activity.lngActivityID " _
        & "WHERE lngActivityDetailID=" & lngDetailID
    'Set recDetail = gclsBase.BaseDB.OpenRecordset(Strsql, dbOpenSnapshot)
    
    strSql = "SELECT strDate,lngCustomerID,lngActivityTypeID,lngCurrencyID,dblCurrAmount,dblCurrPaymentAmount,blnIsReceipt " _
        & "FROM ActivityDetail , Activity WHERE ActivityDetail.lngActivityID=Activity.lngActivityID  " _
        & " AND lngActivityDetailID=" & lngDetailID
    Set recDetail = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    
    If Not recDetail.EOF Then
        mlngCustomerID = recDetail!lngCustomerID
        mlngCurrencyID = recDetail!lngCurrencyID
        mdtmEndDate = recDetail!strDate
        Select Case recDetail!lngActivityTypeID
        Case atReceipt, atPayment
            mdblPayAmount = recDetail!dblCurrAmount
            mstrActivityFrom = "现金银行"
            mintDirection = 1
        Case atCreditAP, atDebitAR, atFinanCharge
            mdblPayAmount = recDetail!dblCurrAmount
            If recDetail!blnIsReceipt Then
                mintDirection = -1
            Else
                mintDirection = 1
            End If
        Case atCreditAR, atDebitAP
            mdblPayAmount = recDetail!dblCurrAmount
            If Not recDetail!blnIsReceipt Then
                mintDirection = -1
            Else
                mintDirection = 1
            End If
        End Select
        GetActivity = True
    Else
        GetActivity = False
    End If
    recDetail.Close
End Function