-+

VB财务软件系统下载源代码提供自由下载使用学习

    Label1(1) = rsTemp![ctext]
    Set rsTemp = dbsZJ.OpenRecordset(sqlT, dbOpenDynaset)
    Label1(0) = rsTemp![ctext]
    edtYhje = FormatCur(0)
    If UnionFindflag Then
        rstReturn.FindFirst IIf((iReturnType = 1), "cRetID='", "cUnaID='") & sqlUnionkey & " '"
    End If
    If Not rstReturn.EOF Then
        GetRecord
    Else
        SetFormZero
    End If

End Sub

'********************************************************************
'*函数说明: 取填充数据到窗体                                          *
'*参    数:                                                          *
'*                                                                   *
'*返回值  :                                                          *
'*********************************************************************
Private Sub GetRecord()
    blnGetRecord = True
    With rstReturn
        edtDkbh = right(![cUnwID], Len(![cUnwID]) - 2)
        If iReturnType = 1 Then
            edtHkbh = right(![cRetID], Len(![cRetID]) - 2)
        Else
            edtHkbh = right(![cUnaID], Len(![cUnaID]) - 2)
        End If
        edtHkbh.Visible = False
        blnCombo = True
'        Combo1.Text = edtHkbh          'cuidong 2001.08.23
        MoveComboByText Combo1, edtHkbh 'cuidong 2001.08.23
        Combo1.Visible = True
        blnCombo = False
        edtRq = Format(![dbill_date], "YYYY-MM-DD")
        edtSkdw = AccIDToUnitName(![cGAccID])
        edtSkzh = ![cGAccID]
        edtFkdw = AccIDToUnitName(![cPAccID])
        edtFkzh = ![cPAccID]
        edtHkje = Format(![mMoney], "#0.00")
        edtBib = AccToExch(![cGAccID])
        edtHl = ![nFrat]
        edtBje = Format(![mMoney_F], "#0.00")
        edtSkjb = IIf(IsNull(![crun_name]), "", ![crun_name]) ' 收款经办
        edtFkjb = IIf(IsNull(![cpay_name]), "", ![cpay_name]) ' 付款经办
        edtZxjb = IIf(IsNull(![cset_name]), "", ![cset_name]) ' 收款经办
        edtDigest = IIf(IsNull(![cDigest]), "", ![cDigest])
        Label1(3) = IIf(IsNull(![cBookCode]), "", ![cBookCode])
        Label1(4) = ![cBillCode]
        Label1(2) = IIf(IsNull(![cCheckCode]), "", ![cCheckCode])
    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 Function GetMoneyed(iRetType As Byte, bNow As Boolean) As Currency
    Dim rsRet As New UfRecordset, sqlRet As String
    
    Select Case iRetType
        Case 1
            sqlRet = "select sum(mmoney) as med from FD_UnwRet where [cUnwID]='07" & edtDkbh & "'"
        Case 2
            sqlRet = "select sum(mmoney) as med from FD_UnwAcrRcp where [cUnwID]='07" & edtDkbh & "'"
    End Select
    If bNow Then
      Select Case iRetType
         Case 1: sqlRet = sqlRet & " AND [cRetID] <> '12" & edtHkbh & "'"
         Case 2: sqlRet = sqlRet & " AND [cUnaID] <> '13" & edtHkbh & "'"
      End Select
    End If
    Set rsRet = dbsZJ.OpenRecordset(sqlRet, dbOpenDynaset)
    GetMoneyed = IIf(IsNull(rsRet![Med]), 0, rsRet![Med])
    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
    strTemp = "07" & edtDkbh                           'CuiDong Efficiency-A 2000/06/19 效率优化A
'    Set rsCred = dbsZJ.OpenRecordset("FD_UnwDeb", 2)  'CuiDong Efficiency-A 2000/06/19 效率优化A
    Set rsCred = dbsZJ.OpenRecordset("Select * From FD_UnwDeb Where cUnwID='" + strTemp + "'", 2) 'CuiDong Efficiency-A 2000/06/19 效率优化A
    With rsCred
'        .Index = "PrimaryKey"                         'CuiDong Efficiency-A 2000/06/20 效率优化A
'        strTemp = "07" & edtDkbh                      'CuiDong Efficiency-A 2000/06/19 效率优化A
'        .FindFirst "cUnwID='" + 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
            SetTxtFocus edtDkbh
            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
    sqlCad = "SELECT SUM(mmoney) AS cadMoney FROM FD_CadAcr WHERE [cDanID]='07" & edtDkbh & "' AND [dbill_date] <= '" & edtRq & "'"
    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_UnwDeb WHERE cUnwID='07" & edtDkbh & "'", dbOpenDynaset)
      Case 2
         Set rstCred = dbsZJ.OpenRecordset("SELECT * FROM FD_CadAcr WHERE cDanID='07" & 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 edtFkdw_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 edtFkdw_KeyDown(KeyCode As Integer, Shift As Integer)
   If KeyCode = vbKeyF2 Then
      RefCmd1(2).RunReference
      edtFkdw.SetFocus
   End If
End Sub

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

Private Sub edtFkdw_LostFocus()
   If edtFkdw <> "" Then
      UnitToAccID edtFkdw, edtFkzh
   End If
End Sub

Private Sub edtFkjb_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 edtFkjb_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        SendKeys "{Tab}", False
        KeyAscii = 0
        Exit Sub
    End If
End Sub

Private Sub edtFkzh_Change()
   bFkzh = True
   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
   Dim strTemp As String
   If edtFkzh <> "" Then
      strTemp = AccIDToUnitName(edtFkzh)
      If strTemp <> "" Then
         edtFkdw = strTemp
         edtBib = AccToExch(edtFkzh)
      End If
   End If
End Sub

Private Sub edtFkzh_KeyDown(KeyCode As Integer, Shift As Integer)
   If KeyCode = vbKeyF2 Then
      RefCmd1(3).RunReference
      edtFkzh.SetFocus
   End If
End Sub

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

Private Sub edtFkzh_LostFocus()
   Dim strTemp As String
   Dim iZhNy As Byte
   If edtFkzh <> "" And bFkzh Then
      bFkzh = False
      strTemp = AccIDToUnitName(edtFkzh)
      If strTemp = "" Then
         MsgBox "账户号不存在！", vbInformation, zjGl_Name
         SetTxtFocus edtFkzh
      Else
         edtFkdw = strTemp
         edtBib = AccToExch(edtFkzh)
      End If
      iZhNy = GetZhNY(edtFkzh)
      If iZhNy = 1 Then
        MsgBox "请输入内部账户！", vbInformation, zjGl_Name
        SetTxtFocus edtFkzh
      End If
   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 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
    If KeyAscii = Asc("-") Then KeyAscii = 0
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