frmcashsettle.frm

金算盘软件代码

        strSql = "SELECT lng" & strTmp & "ID, str" & strTmp & "Code, str" & strTmp & "Name " & _
            " FROM " & strTmp & _
            " WHERE blnIsInActive=0 ORDER BY str" & strTmp & "Code "
    Case "付款方式"
        mlngMsgNO = Message.msgPaymentMethod
        strTmp = "PaymentMethod"
        strSql = "SELECT lng" & strTmp & "ID, str" & strTmp & "Code, str" & strTmp & "Name " & _
            " FROM " & strTmp & _
            " WHERE blnIsInActive=0 ORDER BY str" & strTmp & "Code "
    Case "部门"
        mlngMsgNO = Message.msgDepartment
        strTmp = "Department"
        strSql = "SELECT lng" & strTmp & "ID, str" & strTmp & "Code, str" & strTmp & "Name " & _
            " FROM " & strTmp & _
            " WHERE blnIsInActive=0 ORDER BY str" & strTmp & "Code "
    Case "职员"
        mlngMsgNO = Message.msgEmployee
        strTmp = "Employee"
        strSql = "SELECT lng" & strTmp & "ID, str" & strTmp & "Code, str" & strTmp & "Name " & _
            " FROM " & strTmp & _
            " WHERE blnIsInActive=0 AND blnCash=1"
        If RowDatas(GrdCol.Row).lngDepartmentID > 0 Then
            strSql = strSql & " AND lngDepartmentID=" & RowDatas(GrdCol.Row).lngDepartmentID
        End If
        strSql = strSql & " ORDER BY str" & strTmp & "Code "
    Case "统计"
        mlngMsgNO = Message.msgClass
        strTmp = "Class"
        strSql = "SELECT lng" & strTmp & "ID, str" & strTmp & "Code, str" & strTmp & "Name " & _
            " FROM Class1" & _
            " WHERE blnIsInActive=0 ORDER BY str" & strTmp & "Code "
    Case "项目"
        mlngMsgNO = Message.msgClass2
        strTmp = "Class"
        strSql = "SELECT lng" & strTmp & "ID, str" & strTmp & "Code, str" & strTmp & "Name " & _
            " FROM Class2" & _
            " WHERE blnIsInActive=0 ORDER BY str" & strTmp & "Code "
    End Select
    refInput.SQL = strSql
    Set refInput.Recordset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    refInput.AddRefer "<新增>"
    refInput.AddRefer "<修改>"
    refInput.AddRefer "<删除>"
EndProc:
End Sub

Private Sub InsertARow()
    GrdCol.Rows = GrdCol.Rows + 1
    ReDim Preserve RowDatas(UBound(RowDatas) + 1)
    GrdCol.RowData(GrdCol.Rows - 1) = UBound(RowDatas)
    GrdCol.Row = GrdCol.Rows - 1
    GrdCol.col = 1
End Sub

Private Sub RemoveARow(ByVal lngRowno As Long)
    If lngRowno < 1 Then Exit Sub
    If GrdCol.Rows = 2 Then
        GrdCol.Rows = 1
        ReDim RowDatas(0)
        cmdOkCancel(3).Enabled = False
    Else
        GrdCol.RemoveItem lngRowno
    End If
    WriteTotalRow
End Sub

Private Sub InitForm()
    lblHead(0).Caption = "单位：" & frmName.lblHead(1).Caption
    lblHead(1).Caption = "日期：" & frmName.lblField(2).Caption
    lblHead(2).Caption = IIf(ReceiptType = 39, "采购单编号：", "销售单编号：") & frmName.lblField(1).Caption
    lblHead(3).Caption = "币种：" & frmName.lblField(7).Caption
    lblHead(4).Caption = "汇率：" & frmName.lblField(6).Caption
    lblHead(5).Caption = "原币金额：" & Format$((C2Dbl(GetLabel(frmName.lblTotal(9))) + C2Dbl(GetLabel(frmName.lblTotal(12)))), FormatString(lngCurrDec))
    lblHead(6).Caption = "本币金额：" & Format$((C2Dbl(GetLabel(frmName.lblTotal(10))) + C2Dbl(GetLabel(frmName.lblTotal(13)))), FormatString(gclsBase.NaturalCurDec))
    GetAmount
    GrdCol.Rows = 1
    cmdOkCancel(3).Enabled = False
    ReDim RowDatas(0)
    setRefer 0
    setRefer 1
    setRefer 2
End Sub

Private Sub mnuEditDel_Click()
    RemoveARow GrdCol.Row
End Sub

Private Sub mnuEditNew_Click()
    InsertARow
End Sub

Private Sub refHead_AddNew(Index As Integer)
    Dim lngNewID As Long
    Dim lngOldID As Long
    lngOldID = refHead(Index).ID
    Select Case Index
    Case 0
        lngNewID = AddCard(msgTemplate, refHead(Index).Text, , IIf(mlngReceiptTypeID > 12, 40, 39), , , C2lng(refHead(0).TextMatrix(4, 1)))
        If lngNewID > 0 Then
            setRefer Index
            refHead(Index).SeekId lngNewID
        Else
            refHead(Index).SeekId lngOldID
        End If
    Case 1
        lngNewID = AddCard(msgTemplate, refHead(Index).Text, , IIf(mlngReceiptTypeID > 12, 37, 35))
        If lngNewID > 0 Then
            setRefer Index
            refHead(Index).SeekId lngNewID
        Else
            refHead(Index).SeekId lngOldID
        End If
    Case 2
        lngNewID = AddCard(msgAccount, refHead(Index).Text)
        If lngNewID > 0 Then
            setRefer Index
            refHead(Index).SeekId lngNewID
        Else
            refHead(Index).SeekId lngOldID
        End If
    End Select
End Sub

Private Sub refHead_Choose(Index As Integer)
    If Index = 0 Then
        TemplateChange refHead(Index).ID
    End If
    mblnIsChanged = True
End Sub

Private Sub refHead_Delete(Index As Integer)
    Select Case Index
    Case 0
        If DelCard(msgTemplate, refHead(Index).ID, Me.hwnd) Then
            setRefer Index
        End If
    Case 1
        If DelCard(msgTemplate, refHead(Index).ID, Me.hwnd) Then
            setRefer Index
        End If
    Case 2
        If DelCard(msgAccount, refHead(Index).ID, Me.hwnd) Then
            setRefer Index
        End If
    End Select

End Sub

Private Sub refHead_Edit(Index As Integer)
    Dim lngNewID As Long
    
    refHead(Index).MoveFocus
    If refHead(Index).ID = 0 Then
        cMsgBox "请先选择一参照项！", Me.Caption
        Exit Sub
    End If
    
    lngNewID = refHead(Index).ID
    Select Case Index
    
    Case 0
        Call EditCard(msgTemplate, refHead(Index).ID, , ReceiptType, False)
    Case 1
        Call EditCard(msgTemplate, refHead(Index).ID, , IIf(ReceiptType = 39, 35, 37), False)
    Case 2
        Call EditCard(msgAccount, refHead(Index).ID)
    End Select
    setRefer Index
    refHead(Index).SeekId lngNewID
End Sub

Private Sub refHead_Validate(Index As Integer, Cancel As Boolean)
    If Me.Visible = False Then Exit Sub
    Dim strMsg As String
    If refHead(Index).ID = 0 And refHead(Index).Text <> "" Then
        Select Case Index
        Case 0
            strMsg = mstrDoing & "单据模板" & refHead(Index).Text & "不存在，是否新增？"
        Case 1
            strMsg = "折扣单据模板" & refHead(Index).Text & "不存在，是否新增？"
        Case 2
            strMsg = "折扣科目" & refHead(Index).Text & "不存在，是否新增？"
        End Select
        If ShowMsg(Me.hwnd, strMsg, MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, Me.Caption) = IDYES Then
            refHead_AddNew Index
        Else
            refHead(Index).Text = ""
        End If
        Cancel = True
    End If
    
    If refHead(Index).ID <= 0 Then Exit Sub
    If Index = 1 Then
        If ReceiptType = 39 Then
            SaveSet 1, "应收应付核销", "应付单据模板", CStr(refHead(1).ID), True, "Long"
        Else
            SaveSet 1, "应收应付核销", "应收单据模板", CStr(refHead(1).ID), True, "Long"
        End If
    ElseIf Index = 2 Then
        If DiscountAccount_Choose(refHead(2).ID) = False Then
            Cancel = True
        End If
    End If
End Sub

Private Sub refInput_AddNew()
    Dim lngNewID As Long
    Dim lngOldID As Long
    lngOldID = refInput.ID
    lngNewID = AddCard(mlngMsgNO, refInput.Text)
    If lngNewID > 0 Then
        setRefer 3
        refInput.SeekId lngNewID
    Else
        refInput.SeekId lngOldID
    End If
End Sub

Private Sub refInput_Delete()
    If DelCard(mlngMsgNO, refInput.ID, Me.hwnd) Then
        setRefer 3
    End If
End Sub

Private Sub refInput_Edit()
    refInput.MoveFocus
    If refInput.ID = 0 Then
        cMsgBox "请先选择一参照项！", Me.Caption
        Exit Sub
    End If
    Dim lngOldID As Long
    lngOldID = refInput.ID
    EditCard mlngMsgNO, refInput.ID
    refInput.SeekId lngOldID
End Sub

Private Sub GetAmount()
    '取应核销金额
    '...
    'lblHead(5).Caption =
    'lblHead(6).Caption =
End Sub

Private Sub WriteTotalRow()
    Dim i As Long
    Dim dblTotalCurrAmount As Double
    Dim dblTotalCurrDiscAmount As Double
    Dim dblTotalAmount As Double
    Dim dblTotalDiscAmount As Double
    GetLngColNO
    For i = 1 To GrdCol.Rows - 1
        dblTotalCurrAmount = dblTotalCurrAmount + C2Dbl(GrdCol.TextMatrix(i, xlngColNo(6)))
        dblTotalAmount = dblTotalAmount + C2Dbl(GrdCol.TextMatrix(i, xlngColNo(7)))
        dblTotalCurrDiscAmount = dblTotalCurrDiscAmount + C2Dbl(GrdCol.TextMatrix(i, xlngColNo(8)))
        dblTotalDiscAmount = dblTotalDiscAmount + C2Dbl(GrdCol.TextMatrix(i, xlngColNo(9)))
    Next
    For i = 1 To GrdCol.Cols - 1
        hlb(i).Caption = ""
    Next
    hlb(xlngColNo(6)).Caption = IIf(dblTotalCurrAmount = 0, "", Format(dblTotalCurrAmount, strCurrDec))
    hlb(xlngColNo(7)).Caption = IIf(dblTotalAmount = 0, "", Format(dblTotalAmount, FormatString(gclsBase.NaturalCurDec)))
    hlb(xlngColNo(8)).Caption = IIf(dblTotalCurrDiscAmount = 0, "", Format(dblTotalCurrDiscAmount, strCurrDec))
    hlb(xlngColNo(9)).Caption = IIf(dblTotalDiscAmount = 0, "", Format(dblTotalDiscAmount, FormatString(gclsBase.NaturalCurDec)))
End Sub

Private Sub SaveInput()
    If mNotSaveInput Then Exit Sub
    If Me.ActiveControl Is Nothing Then Exit Sub
    If UCase(Me.ActiveControl.Name) = "REFHEAD" Or UCase(Me.ActiveControl.Name) = "CMDOKCANCEL" Then Exit Sub
    mclsGrid.Save
'    If grdCol.col = grdCol.Cols - 1 Then
'        grdCol.col = grdCol.col - 1
'    Else
'        grdCol.col = grdCol.col + 1
'    End If
End Sub

Private Sub refInput_Validate(Cancel As Boolean)
    SaveInput
End Sub

Private Sub txtInput_Validate(Cancel As Boolean)
    SaveInput
End Sub
Private Sub curInput_Validate(Cancel As Boolean)
    SaveInput
End Sub

Private Sub dtmInput_Validate(Cancel As Boolean)
    If dtmInput.IsDropDown Then
'        dtmInput.ClosePanel
'        Cancel = True
        Exit Sub
    End If
    SaveInput
End Sub
'-----------------------------------------------------
'以下代码为蔡奇科维护
'-----------------------------------------------------
Private Function SaveBill() As Boolean
    Dim strSql  As String
    Dim i As Long
    If mblnIsChanged = False Then
        '未改变
        SaveBill = True
        Exit Function
    End If
    
    If DataValid() = False Then Exit Function
    mstrErrMsg = ""
    gclsBase.BaseWorkSpace.BeginTrans
    For i = 1 To GrdCol.Rows - 1
        If GetGridRefID("Account", i) > 0 Then '科目ID
            If GetGridRefID("ActivityID", i) = 0 Then
                If SaveNewBill(i) = False Then GoTo ErrH
            Else
                If SaveModifyBill(GetGridRefID("ActivityID", i), i) = False Then GoTo ErrH
            End If
        End If
    Next i
    
    If ModifyItemActivity(mlngActivityID) = False Then GoTo ErrH '修改商品业务表
    If ModifyCashToARAP(mlngActivityID) = False Then GoTo ErrH '修改对照表
    If DeleteOtherActivity(mlngActivityID) = False Then GoTo ErrH '删除多余的收/付款单及折扣单
    
    mblnSucceed = -1
    For i = 1 To GrdCol.Rows - 1
        If RowDatas(GrdCol.RowData(i)).lngActivityID > 0 And RowDatas(GrdCol.RowData(i)).lngAccountID > 0 Then
            mblnSucceed = 1
            Exit For
        End If
    Next
    If mblnSucceed = -1 Then
        strSql = "UPDATE ItemActivity SET blnIsCash=0 WHERE lngActivityID=" & mlngActivityID
    Else