银行还款单.frm

财务信息管理系统,适合做毕业论文的人使用

    End With
    GetCretInfo
    blnGetRecord = False
    blnSavFlag = False
    blnAddFlag = False
        oV.SetButtonStatus Checkqx, blnSavFlag, blnAddFlag, Toolbar1, Combo1, mCopy.blnCopy, Label1(2)
    SetControlsStatus
    On Error Resume Next
    edtRq.SetFocus
    On Error GoTo 0
End Sub

'********************************************************************
'*函数说明: 设置控件状态                                              *
'*参    数:                                                          *
'*                                                                   *
'*返回值  :                                                          *
'*********************************************************************
Private Sub SetControlsStatus()
   Dim bVouched As Boolean
   
   edtBib.Locked = True
   edtBje.Locked = True
   edtYhje.Locked = True
   edtJkrq.Locked = True
   edtHkrq.Locked = True
   edtLldm.Locked = True
   If blnAddFlag Then
      edtHkbh.Locked = False
   Else
      edtHkbh.Locked = True
   End If
   bVouched = oV.hasMadePZ(IIf(iReturnType = 1, "08", IIf(iReturnType = 2, "09", IIf(iReturnType = 3, "10", "11"))) & Combo1.List(Combo1.ListIndex))
   If (bVouched Or FindFlag Or Label1(2) <> "" Or rstReturn.RecordCount = 0) And Not blnAddFlag Then
      edtDkbh.Locked = True
      edtRq.Locked = True
      edtEnter.Locked = True
      edtZhh.Locked = True
      edtHkje.Locked = True
      edtHl.Locked = True
      edtFkfs.Locked = True
      edtJbr.Locked = True
      edtDigest.Locked = True
      Command1(0).Enabled = False
      Command1(5).Enabled = False
      RefCmd1(0).Enabled = False
      RefCmd1(1).Enabled = False
   Else
      edtDkbh.Locked = False
      edtRq.Locked = False
      edtEnter.Locked = False
      edtZhh.Locked = False
      edtHkje.Locked = False
      edtHl.Locked = IIf(ZjAccInfo.zjStandExch = edtBib, True, False)
      edtFkfs.Locked = False
      edtJbr.Locked = False
      edtDigest.Locked = False
      Command1(0).Enabled = True
      Command1(5).Enabled = True
      RefCmd1(0).Enabled = True
      RefCmd1(1).Enabled = True
   End If

End Sub

Private Function GetMoneyed(iRetType As Byte, bNow As Boolean) As Currency
   Dim rsRet As New UfRecordset
   Dim sqlRet As String
    
   Select Case iRetType
      Case 1
          sqlRet = "select sum(mmoney) as med from FD_Return where [cCreID]='05" & edtDkbh & "'"
      Case 2
          sqlRet = "select sum(mmoney) as med from FD_Return where [cCreID]='06" & edtDkbh & "'"
      Case 3
          sqlRet = "select sum(mmoney) as med from FD_CreAcrRcp where [cCreID]='05" & edtDkbh & "'"
      Case 4
          sqlRet = "select sum(mmoney) as med from FD_CreAcrRcp where [cCreID]='06" & edtDkbh & "'"
   End Select
   If bNow Then
   Select Case iRetType
       Case 1
           sqlRet = sqlRet & " AND [cRetID]<>'08" & edtHkbh & "'"
       Case 2
           sqlRet = sqlRet & " AND [cRetID]<>'09" & edtHkbh & "'"
       Case 3
           sqlRet = sqlRet & " AND [cCraID]<>'10" & edtHkbh & "'"
       Case 4
           sqlRet = sqlRet & " AND [cCraID]<>'11" & edtHkbh & "'"
   End Select
   End If
   Set rsRet = dbsZJ.OpenRecordset(sqlRet, dbOpenDynaset)
   If rsRet.EOF Then
     GetMoneyed = 0
   Else
     GetMoneyed = IIf(IsNull(rsRet![Med]), 0, rsRet![Med])
   End If
   rsRet.oClose
    
End Function

Private Function GetCretInfo() As Boolean
    'CuiDong Efficiency-A 2000/06/19 效率优化A OK
    Dim rsCred As New UfRecordset, id As Integer, strTemp As String
    
    GetCretInfo = False
'    Set rsCred = dbsZJ.OpenRecordset("FD_Cred", 2)  'CuiDong Efficiency-A 2000/06/19 效率优化A
    Select Case iReturnType                          'CuiDong Efficiency-A 2000/06/19 效率优化A
        Case 1, 3: strTemp = "05" & edtDkbh          'CuiDong Efficiency-A 2000/06/19 效率优化A
        Case 2, 4: strTemp = "06" & edtDkbh          'CuiDong Efficiency-A 2000/06/19 效率优化A
    End Select                                       'CuiDong Efficiency-A 2000/06/19 效率优化A
    Set rsCred = dbsZJ.OpenRecordset("Select * From FD_Cred Where ccreid ='" + strTemp + "'", 2)   'CuiDong Efficiency-A 2000/06/19 效率优化A
    With rsCred
'        .Index = "PrimaryKey"                       'CuiDong Efficiency-A 2000/06/20 效率优化A
'        Select Case iReturnType                     'CuiDong Efficiency-A 2000/06/19 效率优化A
'            Case 1, 3: strTemp = "05" & edtDkbh     'CuiDong Efficiency-A 2000/06/19 效率优化A
'            Case 2, 4: strTemp = "06" & edtDkbh     'CuiDong Efficiency-A 2000/06/19 效率优化A
'        End Select                                  'CuiDong Efficiency-A 2000/06/19 效率优化A
'        .FindFirst "ccreid ='" + strTemp + "'"      'CuiDong Efficiency-A 2000/06/19 效率优化A
'        If .NoMatch Then                            'CuiDong Efficiency-A 2000/06/19 效率优化A
        If .EOF Or .BOF Then                         'CuiDong Efficiency-A 2000/06/19 效率优化A
            MsgBox "贷款业务编号不存在！", vbInformation, zjGl_Name
            Exit Function
        Else
            edtJkrq = FormatDate(![dbill_date])
            edtHkrq = FormatDate(![Dret_date])
            edtLldm = ![cintrid]
            edtYhje = FormatCur(GetMoneyed(iReturnType, False))
            creMoney = ![mMoney]
        End If
    End With
    rsCred.oClose
    GetCretInfo = True
    
End Function

Private Function GetCadInfo() As Boolean
    Dim rsCad As New UfRecordset, sqlCad As String
    Dim id As Integer, strTemp As String
    
    GetCadInfo = False
    Select Case iReturnType
      Case 3: sqlCad = "SELECT SUM(mmoney) AS cadMoney FROM FD_CadAcr WHERE [cDanID]='05" & edtDkbh & "' AND [dbill_date] <= '" & edtRq & "'"
      Case 4: sqlCad = "SELECT SUM(mmoney) AS cadMoney FROM FD_CadAcr WHERE [cDanID]='06" & edtDkbh & "' AND [dbill_date] <= '" & edtRq & "'"
    End Select
    Set rsCad = dbsZJ.OpenRecordset(sqlCad, dbOpenDynaset)
    With rsCad
        If IsNull(![cadMoney]) Then
            MsgBox "此笔贷款业务不存在或未生成利息单！", vbInformation, zjGl_Name
            Exit Function
        Else
            cadMoney = ![cadMoney]
        End If
    End With
    rsCad.oClose
    GetCadInfo = True
    
End Function

Private Sub ReturnDelete()
   Select Case iReturnType
      Case 1
         Set rstCred = dbsZJ.OpenRecordset("SELECT * FROM FD_Cred WHERE cCreID='05" & edtDkbh & "'", dbOpenDynaset)
      Case 2
         Set rstCred = dbsZJ.OpenRecordset("SELECT * FROM FD_Cred WHERE cCreID='06" & edtDkbh & "'", dbOpenDynaset)
      Case 3
         Set rstCred = dbsZJ.OpenRecordset("SELECT * FROM FD_CadAcr WHERE cDanID='05" & edtDkbh & "'", dbOpenDynaset)
      Case 4
         Set rstCred = dbsZJ.OpenRecordset("SELECT * FROM FD_CadAcr WHERE cDanID='06" & edtDkbh & "'", dbOpenDynaset)
   End Select
   If rstCred![bSettle] Then
      If JudgeLockOrNot(rstCred, 1) Then
         Exit Sub
      Else
         rstCred.Edit
         rstCred![bSettle] = False
         rstCred.Update
      End If
   End If
   rstReturn.Delete
   MoveRs 3
   
End Sub

Private Sub edtBib_Change()
   ' 币别为空，Lock汇率
   If edtBib = "" Then
       edtHl = ""
       edtHl.Locked = True
   Else
       edtHl.NumPoint = Gethldec(edtBib)
       edtHl = GetCurHl(edtBib, edtRq)
       edtHl.Locked = False
   End If
   If ZjAccInfo.zjStandExch = edtBib Then
      edtHl.Locked = True
      edtHl = 1
   End If
   If Not blnSavFlag And Not blnGetRecord Then
       Combo1.Visible = False
       edtHkbh.Visible = True
       blnSavFlag = True
           oV.SetButtonStatus Checkqx, blnSavFlag, blnAddFlag, Toolbar1, Combo1, mCopy.blnCopy, Label1(2)
   End If
End Sub

Private Sub edtBib_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        SendKeys "{Tab}", False
        KeyAscii = 0
        Exit Sub
    End If
End Sub

Private Sub edtBje_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        SendKeys "{Tab}", False
        KeyAscii = 0
        Exit Sub
    End If
End Sub

Private Sub edtDigest_Change()
    If Not blnSavFlag And Not blnGetRecord Then
        Combo1.Visible = False
        edtHkbh.Visible = True
        blnSavFlag = True
            oV.SetButtonStatus Checkqx, blnSavFlag, blnAddFlag, Toolbar1, Combo1, mCopy.blnCopy, Label1(2)
    End If
End Sub

Private Sub edtDigest_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        SendKeys "{Tab}", False
        KeyAscii = 0
        Exit Sub
    End If
End Sub

Private Sub edtDkbh_Change()
    If Not blnSavFlag And Not blnGetRecord Then
        Combo1.Visible = False
        edtHkbh.Visible = True
        blnSavFlag = True
            oV.SetButtonStatus Checkqx, blnSavFlag, blnAddFlag, Toolbar1, Combo1, mCopy.blnCopy, Label1(2)
    End If
End Sub

Private Sub edtDkbh_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        SendKeys "{Tab}", False
        KeyAscii = 0
        Exit Sub
    End If
End Sub
'贷款业务编号
Private Sub edtDkbh_LostFocus()
   If edtDkbh <> "" Then
       edtDkbh = String(8 - Len(edtDkbh), "0") & edtDkbh
       If Not GetCretInfo Then
           SetTxtFocus edtDkbh
       End If
   End If
End Sub

Private Sub edtEnter_Change()
    If Not blnSavFlag And Not blnGetRecord Then
        Combo1.Visible = False
        edtHkbh.Visible = True
        blnSavFlag = True
            oV.SetButtonStatus Checkqx, blnSavFlag, blnAddFlag, Toolbar1, Combo1, mCopy.blnCopy, Label1(2)
    End If
End Sub

Private Sub edtEnter_KeyDown(KeyCode As Integer, Shift As Integer)
   If KeyCode = vbKeyF2 Then
      RefCmd1(0).RunReference
      edtEnter.SetFocus
   End If
End Sub

Private Sub edtEnter_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        SendKeys "{Tab}", False
        KeyAscii = 0
        Exit Sub
    End If
End Sub

Private Sub edtEnter_LostFocus()
   If edtEnter <> "" Then
      UnitToAccID edtEnter, edtZhh
   End If
End Sub

Private Sub edtFkfs_Change()
    If Not blnSavFlag And Not blnGetRecord Then
        Combo1.Visible = False
        edtHkbh.Visible = True
        blnSavFlag = True
            oV.SetButtonStatus Checkqx, blnSavFlag, blnAddFlag, Toolbar1, Combo1, mCopy.blnCopy, Label1(2)
    End If
End Sub

Private Sub edtFkfs_KeyDown(KeyCode As Integer, Shift As Integer)
   If KeyCode = vbKeyF2 Then
      Command1(5).Value = True
      SetTxtFocus edtFkfs
   End If
End Sub

Private Sub edtFkfs_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        SendKeys "{Tab}", False
        KeyAscii = 0
        Exit Sub
    End If
End Sub

Private Sub edtHkbh_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        SendKeys "{Tab}", False
        KeyAscii = 0
        Exit Sub
    End If
End Sub

Private Sub edtHkbh_LostFocus()
   If edtHkbh <> "" Then
       edtHkbh = String(8 - Len(edtHkbh), "0") & edtHkbh
   End If
End Sub

Private Sub edtHkje_Change()
   On Error Resume Next
   edtBje = edtHkje * edtHl
   If Err <> 0 Then edtBje = ""
   On Error GoTo 0
   If Not blnSavFlag And Not blnGetRecord Then
       Combo1.Visible = False
       edtHkbh.Visible = True
       blnSavFlag = True
           oV.SetButtonStatus Checkqx, blnSavFlag, blnAddFlag, Toolbar1, Combo1, mCopy.blnCopy, Label1(2)
   End If
End Sub

Private Sub edtHkje_KeyPress(KeyAscii As Integer)
   If KeyAscii = vbKeyReturn Then
       SendKeys "{Tab}", False
       KeyAscii = 0
       Exit Sub
   End If
End Sub

Private Sub edtHkrq_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        SendKeys "{Tab}", False
        KeyAscii = 0
        Exit Sub
    End If
End Sub

Private Sub edtHl_Change()
   On Error Resume Next
   edtBje = edtHkje * edtHl
   If Err <> 0 Then edtBje = ""
   On Error GoTo 0
   If Not blnSavFlag And Not blnGetRecord Then
       Combo1.Visible = False
       edtHkbh.Visible = True
       blnSavFlag = True
           oV.SetButtonStatus Checkqx, blnSavFlag, blnAddFlag, Toolbar1, Combo1, mCopy.blnCopy, Label1(2)
   End If
End Sub

Private Sub edtHl_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        SendKeys "{Tab}", False
        KeyAscii = 0
        Exit Sub
    End If
    If KeyAscii = Asc("-") Then KeyAscii = 0
End Sub

Private Sub edtJbr_Change()
    If Not blnSavFlag And Not blnGetRecord Then
        Combo1.Visible = False
        edtHkbh.Visible = True
        blnSavFlag = True
            oV.SetButtonStatus Checkqx, blnSavFlag, blnAddFlag, Toolbar1, Combo1, mCopy.blnCopy, Label1(2)
    End If