frmjobpay.frm

金算盘软件代码

        If C2Dbl(lblF(11).Caption) >= 0 And C2Dbl(lblF(10).Caption) > C2Dbl(lblF(11).Caption) Or C2Dbl(lblF(11).Caption) < 0 And C2Dbl(lblF(10).Caption) < C2Dbl(lblF(11).Caption) Then
            If strErr <> "" Then
                strErr = strErr & vbCrLf
            End If
            strErr = strErr & "累计付款金额" & lblF(10).Caption & "大于累计已开票金额" & C2Dbl(lblF(11).Caption) & "！"
        End If
        If strErr <> "" Then
            ShowMsg Me.hwnd, strErr, MB_SYSTEMMODAL + MB_ICONINFORMATION, Me.Caption
        End If
    End If
    lngProjectID = ProjectID
    AddOrderRefer
End Function
Private Sub AddOrderRefer()
    Dim lngOldID As Long
    Dim clsTmp As RecordClass
            Set clsTmp = New RecordClass
            refInput(0).SeekCol = "1,2"
            refInput(0).SQL = clsTmp.RecordSQL(xProjectOrder, lngProjectID)
            Set refInput(0).Recordset = clsTmp.RecordCon(xProjectOrder, lngProjectID)
            refInput(0).Tag = MsgNO(xProjectOrder)
            refInput(0).AddRefer "<新增>"
            refInput(0).AddRefer "<修改>"
            refInput(0).AddRefer "<删除>"
            refInput(0).ColWidth(2) = 500
            refInput(0).ColWidth(3) = 1400
            refInput(0).ColWidth(4) = 1400
    Set clsTmp = Nothing
End Sub
Private Sub AddCustomerRefer()
    Dim lngOldID As Long
    Dim clsTmp As RecordClass
            Set clsTmp = New RecordClass
            refInput(1).SeekCol = "1,2,3"
            refInput(1).SQL = clsTmp.RecordSQL(xCustomer, 0)
            Set refInput(1).Recordset = clsTmp.RecordCon(xCustomer, 0)
            refInput(1).Tag = MsgNO(xCustomer)
            refInput(1).AddRefer "<新增>"
            refInput(1).AddRefer "<修改>"
            refInput(1).AddRefer "<删除>"
    Set clsTmp = Nothing
End Sub
Private Sub AddPayCustomerRefer()
    Dim lngOldID As Long
    Dim clsTmp As RecordClass
            Set clsTmp = New RecordClass
            refInput(2).SeekCol = "1,2"
            refInput(2).SQL = clsTmp.RecordSQL(xPayCustomer, 0)
            Set refInput(2).Recordset = clsTmp.RecordCon(xPayCustomer, 0)
            refInput(2).Tag = MsgNO(xPayCustomer)
            refInput(2).AddRefer "<新增>"
            refInput(2).AddRefer "<修改>"
            refInput(2).AddRefer "<删除>"
    Set clsTmp = Nothing
End Sub
Private Sub AddPaymentMethodRefer()
    Dim lngOldID As Long
    Dim clsTmp As RecordClass
            Set clsTmp = New RecordClass
            refInput(3).SeekCol = "1,2,3"
            refInput(3).SQL = clsTmp.RecordSQL(xPaymentMethod)
            Set refInput(3).Recordset = clsTmp.RecordCon(xPaymentMethod)
            refInput(3).Tag = MsgNO(xPaymentMethod)
            refInput(3).AddRefer "<新增>"
            refInput(3).AddRefer "<修改>"
            refInput(3).AddRefer "<删除>"
    Set clsTmp = Nothing
End Sub
Private Sub AddProjectRefer()
    Dim lngOldID As Long
    Dim clsTmp As RecordClass
            Set clsTmp = New RecordClass
            refInput(4).SeekCol = "1,2,3"
            refInput(4).SQL = clsTmp.RecordSQL(xProject, 0)
            Set refInput(4).Recordset = clsTmp.RecordCon(xProject, 0)
            refInput(4).Tag = MsgNO(xProject)
            refInput(4).AddRefer "<新增>"
            refInput(4).AddRefer "<修改>"
            refInput(4).AddRefer "<删除>"
    Set clsTmp = Nothing
End Sub

Private Function SaveBill() As Boolean
    Dim recTmp As rdoResultset
    Dim strSql As String
    Dim blnTrans As Boolean
    If refInput(4).ID <= 0 Then
            ShowMsg Me.hwnd, "在建工程必须输入！", MB_SYSTEMMODAL + MB_ICONINFORMATION, Me.Caption
            refInput(4).SetFocus
            Exit Function
    ElseIf IsDetail(xProject, refInput(4).ID) = False Then
            ShowMsg Me.hwnd, "在建工程必须输入末级项目！", MB_SYSTEMMODAL + MB_ICONINFORMATION, Me.Caption
            refInput(4).SetFocus
            Exit Function
    Else
        lngProjectID = refInput(4).ID
    End If
    If IsDate(dtmInput.Text) = False Then
            ShowMsg Me.hwnd, "付款日期输入错误！", MB_SYSTEMMODAL + MB_ICONINFORMATION, Me.Caption
            dtmInput.SetFocus
            Exit Function
    End If
    If refInput(2).ID = 0 Then
            ShowMsg Me.hwnd, "付款方应为必输项！", MB_SYSTEMMODAL + MB_ICONINFORMATION, Me.Caption
            refInput(2).SetFocus
            Exit Function
    End If
    If C2Dbl(curInput(0).Text) <> 0 Then
        If refInput(0).ID = 0 Then
                ShowMsg Me.hwnd, "发票已到金额不为0时合同号为必输项！", MB_SYSTEMMODAL + MB_ICONINFORMATION, Me.Caption
                refInput(0).SetFocus
                Exit Function
        End If
        If refInput(1).ID = 0 Then
                ShowMsg Me.hwnd, "发票已到金额不为0时单位应为必输项！", MB_SYSTEMMODAL + MB_ICONINFORMATION, Me.Caption
                refInput(1).SetFocus
                Exit Function
        End If
    End If
    If Abs(C2Dbl(curInput(1).Text)) > Abs(C2Dbl(lblTitle(3).Caption)) Then
        ShowMsg Me.hwnd, "本次付款金额" & curInput(1).Text & "大于凭证分录金额" & Abs(C2Dbl(lblTitle(3).Caption)), MB_SYSTEMMODAL + MB_ICONINFORMATION, Me.Caption
    End If
    gclsBase.BaseDB.BeginTrans
    blnTrans = True
    On Error GoTo ErrHandle
    If lngOldCustomerID <> refInput(1).ID Then
        If ChangeAllAccount_From_VoucherDetail("D", lngVoucherDetailID) = False Then GoTo ErrHandle
    End If
    strSql = "UPDATE VoucherDetail SET " & _
        "strPayDate='" & Format$(dtmInput.Text, "yyyy-mm-dd") & "',lngOrderID=" & refInput(0).ID & _
        ",lngCustomerID=" & refInput(1).ID & _
        ",lngPayCustomerID=" & refInput(2).ID & _
        ",lngPaymentMethodID=" & refInput(3).ID & _
        ",strCheckNumber='" & IIf(txtInput(0).Text = "", " ", txtInput(0).Text) & "'" & _
        ",strPayMan='" & IIf(txtInput(1).Text = "", " ", txtInput(1).Text) & "'" & _
        ",lngProjectID=" & lngProjectID & _
        ",dblPaymentAmount=" & C2Dbl(curInput(1).Text) & _
        " WHERE lngVoucherDetailID=" & lngVoucherDetailID
    If gclsBase.ExecSQL(strSql) = False Then
        gclsBase.BaseDB.RollBacktrans
        Exit Function
    End If
    If lngOldCustomerID <> refInput(1).ID Then
        If ChangeAllAccount_From_VoucherDetail("I", lngVoucherDetailID) = False Then GoTo ErrHandle
    End If
    
    If C2Dbl(curInput(0).Text) = 0 Then
        strSql = "DELETE FROM ProjectInvoice WHERE  lngVoucherDetailID=" & lngVoucherDetailID
        If gclsBase.ExecSQL(strSql) = False Then
            gclsBase.BaseDB.RollBacktrans
            Exit Function
        End If
    Else
        strSql = "SELECT * FROM ProjectInvoice WHERE  lngVoucherDetailID=" & lngVoucherDetailID
        Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenDynamic, rdConcurValues)
        If recTmp.EOF Then
            recTmp.AddNew
            recTmp!lngInvoiceDetailID = GetNewID("ProjectInvoice")
            recTmp!lngVoucherDetailID = lngVoucherDetailID
        Else
            recTmp.Edit
        End If
        recTmp!lngProjectID = lngProjectID
        recTmp!lngOrderID = refInput(0).ID
        recTmp!lngCustomerID = refInput(1).ID
        recTmp!strDate = Format$(dtmInput.Text, "YYYY-MM-DD")
        recTmp!dblAmount = C2Dbl(curInput(0).Text)
        
        recTmp.Update
        recTmp.Close
        Set recTmp = Nothing
    End If
    blnTrans = False
    gclsBase.BaseDB.CommitTrans
        
    SaveBill = True
    Exit Function
ErrHandle:
    If blnTrans Then gclsBase.BaseDB.RollBacktrans
    Err.Clear
End Function


Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If UnloadMode = vbFormControlMenu Then
        If blnIsChanged Then
            If ShowMsg(Me.hwnd, "是否保存在建工程付款单？", MB_SYSTEMMODAL + MB_ICONQUESTION + MB_YESNO + MB_DEFBUTTON1, Me.Caption) = IDYES Then
                If SaveBill() = False Then
                    Cancel = 1
                End If
            End If
        End If
    End If
End Sub

Private Sub refInput_AddNew(Index As Integer)
    ReferEvent 0, Index
End Sub

Private Sub refInput_Change(Index As Integer)
'    If Index = 0 Then
'        If refInput(0).ID > 0 Then
'            Dim recTmp As rdoResultset
'            Set recTmp = gclsBase.BaseDB.OpenResultset("SELECT lngCustomerID FROM ProjectOrder WHERE lngOrderID=" & refInput(0).ID, rdOpenForwardOnly)
'            If recTmp.EOF = True Then
'            ElseIf recTmp(0) <= 0 Then
'            Else
'                refInput(1).SeekId recTmp(0)
'            End If
'            recTmp.Close
'            Set recTmp = Nothing
'        End If
'    End If
'    blnIsChanged = True
End Sub

Private Sub refInput_Choose(Index As Integer)
    If Index = 0 Then
        If refInput(0).ID > 0 Then
            Dim recTmp As rdoResultset
            Set recTmp = gclsBase.BaseDB.OpenResultset("SELECT lngCustomerID FROM ProjectOrder WHERE lngOrderID=" & refInput(0).ID, rdOpenForwardOnly)
            If recTmp.EOF = True Then
            ElseIf recTmp(0) <= 0 Then
            Else
                refInput(1).SeekId recTmp(0)
            End If
            recTmp.Close
            Set recTmp = Nothing
        End If
    ElseIf Index = 4 Then
        If Not lngProjectID = refInput(4).ID Then ProjectChange refInput(4).ID
    End If
    blnIsChanged = True
End Sub

Private Sub refInput_Edit(Index As Integer)
    ReferEvent 1, Index
End Sub

Private Sub refInput_Delete(Index As Integer)
    ReferEvent 2, Index
End Sub
Private Sub ReferEvent(ByVal intOrder As Integer, ByVal Index As Long)
    Dim intRef As Integer
    Dim clsTmp As RecordClass
    Dim blnResult As Boolean
    Set clsTmp = New RecordClass
    If Index = 0 Then
        intRef = xProjectOrder
    ElseIf Index = 1 Then
        intRef = xCustomer
    ElseIf Index = 2 Then
        intRef = xPayCustomer
    ElseIf Index = 3 Then
        intRef = xPaymentMethod
    ElseIf Index = 4 Then
        intRef = xProject
    End If
    If intOrder = 0 Then
        blnResult = clsTmp.NewRefer(refInput(Index), refInput(Index).Text, , , intRef, lngProjectID, lblTitle(1).Caption)
    ElseIf intOrder = 1 Then
        blnResult = clsTmp.EditRefer(refInput(Index), refInput(Index).ID, refInput(Index).Text, , intRef)
    ElseIf intOrder = 2 Then
        blnResult = clsTmp.DelRefer(refInput(Index), refInput(Index).ID, , , intRef)
    End If
    If blnResult Then
        Dim lngID As Long
        lngID = refInput(Index).ID
        If Index = 0 Then
            AddOrderRefer
        ElseIf Index = 1 Then
            AddCustomerRefer
        ElseIf Index = 2 Then
            AddPayCustomerRefer
        ElseIf Index = 3 Then
            AddPaymentMethodRefer
        ElseIf Index = 4 Then
            AddProjectRefer
        End If
        refInput(Index).SeekId lngID
    End If
    refInput(Index).SetFocus
    Set clsTmp = Nothing
End Sub


Private Sub refInput_LostFocus(Index As Integer)
  Dim strMsg As String
    refInput(Index).MoveFocus
    If refInput(Index).ID = 0 And refInput(Index).Text <> "" Then
        If Index = 0 Then
            strMsg = "合同"
        ElseIf Index = 1 Then
            strMsg = "单位"
        ElseIf Index = 2 Then
            strMsg = "付款方"
        ElseIf Index = 3 Then
            strMsg = "付款方式"
        ElseIf Index = 4 Then
            strMsg = "在建工程"
        Else
        End If
        strMsg = "是否新增" & strMsg & refInput(Index).Text & "？"
        If ShowMsg(Me.hwnd, strMsg, MB_SYSTEMMODAL + MB_ICONQUESTION + MB_YESNO + MB_DEFBUTTON1, Me.Caption) = IDYES Then
            ReferEvent 0, Index
        Else
            refInput(Index).Text = ""
        End If
    End If
End Sub

Private Sub txtInput_Change(Index As Integer)
    blnIsChanged = True
End Sub