ʰ

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

      Begin VB.Label Label1 
         BackColor       =   &H80000018&
         BorderStyle     =   1  'Fixed Single
         Height          =   270
         Index           =   0
         Left            =   1650
         TabIndex        =   23
         Top             =   90
         Width           =   825
      End
      Begin VB.Label Label2 
         AutoSize        =   -1  'True
         Caption         =   "还款业务编号"
         Height          =   180
         Index           =   2
         Left            =   480
         TabIndex        =   22
         Top             =   510
         Width           =   1080
      End
      Begin VB.Label Label2 
         AutoSize        =   -1  'True
         Caption         =   "贷款业务编号"
         Height          =   180
         Index           =   1
         Left            =   480
         TabIndex        =   21
         Top             =   120
         Width           =   1080
      End
   End
   Begin ComctlLib.ImageList ImageList1 
      Left            =   30
      Top             =   420
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      MaskColor       =   12632256
      _Version        =   327682
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "本金还款单"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   -1  'True
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00800000&
      Height          =   240
      Index           =   0
      Left            =   3400
      TabIndex        =   19
      Top             =   780
      Width           =   1290
   End
End
Attribute VB_Name = "frmReturnBj1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'软件著作权: 北京用友软件集团有限公司
'系统名称: 资金管理8.0
'功能说明: 贷款还款、还息单
'作者: 赵春立

Option Explicit

Public FindFlag As Boolean
Public UnionFindflag As Boolean

Public sqlFind As String
Public sqlUnionkey As String

'1-银行还款，2-内部还款，3-银行利息还款，4-内部利息还款
Public iReturnType As Byte

Public Event Move(StepRs As Long)

Private VeriSuccess As Boolean
Private rstReturn As New UfRecordset, rstCred As New UfRecordset, rstCad As New UfRecordset
Private blnSavFlag As Boolean
Private blnAddFlag As Boolean
Private creMoney As Currency  ' 贷款金额
Private cadMoney As Currency  ' 利息金额
Private bSettle As Boolean       ' 贷款业务是否结清
Private blnCombo As Boolean
Private Checkqx As Boolean

Private Type CopyInfo
   blnCopy As Boolean
   strDkbh As String
   strDwmc As String
   strZhh As String
   dblHkje As Double
   strBib As String
   dblHl As Double
   dblBje As Double
   strFkfs As String
   dJkrq As Date
   dHkrq As Date
   strLldm As String
   strJbr As String
   strDigest As String
End Type

Private mCopy As CopyInfo
Private blnGetRecord As Boolean

Dim bRq As Boolean
Dim bZhh As Boolean

Private Sub Combo1_Click()
   If blnCombo Then Exit Sub
   If MoveCob Then
      GetRecord
   Else
      SetFormZero
   End If
End Sub

Private Sub Combo1_DropDown()
   ReQryCombo
End Sub

Private Sub ReQryCombo()
   Dim i As Integer
   Dim mStr As String
   
   ReQueryRecord rstReturn
   With rstReturn
'      If .Restartable Then
'         .Requery
'      Else
'         Set rstReturn = dbsZJ.OpenRecordset(.Name, .Type)
'      End If
      i = Combo1.ListIndex
      Combo1.clear
      If .EOF Then
         SetFormZero
         Exit Sub
      Else
         While Not .EOF
            Combo1.AddItem right(.Fields(0), 10)
            .MoveNext
         Wend
         If i > Combo1.ListCount - 1 Then i = Combo1.ListCount - 1
         blnCombo = True
         Combo1.ListIndex = i
         blnCombo = False
         Select Case iReturnType
             Case 1: mStr = "[cRetID]='08" & Combo1.List(Combo1.ListIndex) & "'"
             Case 2: mStr = "[cRetID]='09" & Combo1.List(Combo1.ListIndex) & "'"
             Case 3: mStr = "[cCraID]='10" & Combo1.List(Combo1.ListIndex) & "'"
             Case 4: mStr = "[cCraID]='11" & Combo1.List(Combo1.ListIndex) & "'"
         End Select
         .FindFirst mStr
      End If
   End With
End Sub

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

Private Sub Command1_Click(Index As Integer)
    Select Case Index
        Case 0: DisplayCalendar edtRq, Me.hwnd, Picture1.left, Picture1.top
        Case 5:
            View_Bref = False
            frmjscz.mTop = Me.top + Picture1.top + Frame1(0).top + edtFkfs.top
            frmjscz.mLeft = Me.left + Picture1.left + edtFkfs.left + edtFkfs.width + 100
            frmjscz.mJsfs = edtFkfs
            frmjscz.Show 1
            If View_Bref Then
                edtFkfs = View_Tref
            End If
            edtFkfs.SetFocus
    End Select
    
End Sub

Private Function GetSqlReturn() As String
    Dim id As Integer
    
    GetSqlReturn = "select * from "
    Select Case iReturnType
        Case 1
         If FindFlag Then
            GetSqlReturn = GetSqlReturn & "FD_Return WHERE cRetID like '08%'"
         Else
            GetSqlReturn = GetSqlReturn & "FD_Return WHERE [cBookCode] IS NULL AND cRetID like '08%' ORDER BY [cRetID]"
         End If
         Me.Caption = "银行还款"
         Label2(0) = "本金还款单"
         RefCmd1(0).RefUnitMode = RefBank
         RefCmd1(1).RefAccMode = RefOutsideAcc
        Case 2
         If FindFlag Then
            GetSqlReturn = GetSqlReturn & "FD_Return WHERE cRetID like '09%'"
         Else
            GetSqlReturn = GetSqlReturn & "FD_Return WHERE [cBookCode] IS NULL AND cRetID like '09%' ORDER BY [cRetID]"
         End If
         Me.Caption = "内部还款"
         Label2(0) = "本金还款单"
         RefCmd1(0).RefUnitMode = RefNotBank
         RefCmd1(1).RefAccMode = RefInsideAcc
        Case 3
         If FindFlag Then
            GetSqlReturn = GetSqlReturn & "FD_CreAcrRcp WHERE cCraID like '10%'"
         Else
            GetSqlReturn = GetSqlReturn & "FD_CreAcrRcp WHERE [cBookCode] IS NULL AND cCraID like '10%' ORDER BY [cCraID]"
         End If
         Me.Caption = "银行利息还款"
         Label2(0) = "利息还款单"
         RefCmd1(0).RefUnitMode = RefBank
         RefCmd1(1).RefAccMode = RefOutsideAcc
        Case 4
         If FindFlag Then
            GetSqlReturn = GetSqlReturn & "FD_CreAcrRcp WHERE cCraID like '11%'"
         Else
            GetSqlReturn = GetSqlReturn & "FD_CreAcrRcp WHERE [cBookCode] IS NULL AND cCraID like '11%' ORDER BY [cCraID]"
         End If
         Me.Caption = "内部利息还款"
         Label2(0) = "利息还款单"
         RefCmd1(0).RefUnitMode = RefNotBank
         RefCmd1(1).RefAccMode = RefInsideAcc

    End Select
    
End Function

Private Sub PasteInformation()
   With mCopy
      edtHkje = .dblHkje
      edtHl = .dblHl
      edtBje = .dblBje
      edtHkrq = .dHkrq
      edtJkrq = .dJkrq
      edtBib = .strBib
      edtDigest = .strDigest
      edtDkbh = .strDkbh
      edtEnter = .strDwmc
      edtFkfs = .strFkfs
      edtJbr = .strJbr
      edtLldm = .strLldm
      edtZhh = .strZhh
   End With
   
End Sub

Private Sub CopyInformation()
   With mCopy
      .blnCopy = True
      .dblHkje = edtHkje
      .dblHl = edtHl
      .dblBje = edtBje
      .dHkrq = edtHkrq
      .dJkrq = edtJkrq
      .strBib = edtBib
      .strDigest = edtDigest
      .strDkbh = edtDkbh
      .strDwmc = edtEnter
      .strFkfs = edtFkfs
      .strJbr = edtJbr
      .strLldm = edtLldm
      .strZhh = edtZhh
   End With
   
End Sub

Private Sub initFind_Form()
    Dim i As Integer
    For i = 4 To 8
        Toolbar1.Buttons(i).Visible = False
    Next i
    For i = 15 To 16
        Toolbar1.Buttons(i).Visible = False
    Next i
End Sub

Private Sub LoadStaticRes()
   ' 将资源放这儿
   Dim id As Integer
   Command1(0).Picture = LoadResPicture(1108, vbResBitmap)
   Command1(5).Picture = LoadResPicture(129, vbResBitmap)
   Label2(1) = "贷款业务编号"
   Label2(2) = "还款业务编号"
   Label2(3) = "日期"
   Label2(4) = IIf(iReturnType = 1 Or iReturnType = 3, "银行名称", "单位名称")
   Label2(5) = IIf(iReturnType = 1 Or iReturnType = 3, "银行账号", "账户号")
   Label2(6) = "还款金额"
   Label2(7) = "币别"
   Label2(8) = "汇率"
   Label2(9) = "付款方式"
   Label2(10) = "本位币还款金额"
   Label2(11) = "已还金额"
   Label2(12) = "借款日期"
   Label2(13) = "还款日期"
   Label2(14) = "利率代码"
   Label2(15) = "经办人"
   Label2(16) = "摘  要"
   Label5(5) = "审核："
   Label5(4) = "记账："
   Label5(3) = "制单："
   
End Sub

Private Sub InitForm()
    Dim rsTemp As New UfRecordset, sqlTemp As String, sqlT As String
    
    sqlTemp = "select * from FD_Class where csign='"
    sqlT = sqlTemp
    Select Case iReturnType
        Case 1:
            sqlTemp = sqlTemp & "08'"
            sqlT = sqlT & "05'"
            Me.HelpContextID = 88000032
        Case 2:
            sqlTemp = sqlTemp & "09'"
            sqlT = sqlT & "06'"
            Me.HelpContextID = 88000036
        Case 3:
            sqlTemp = sqlTemp & "10'"
            sqlT = sqlT & "05'"
            Me.HelpContextID = 88000034
        Case 4:
            sqlTemp = sqlTemp & "11'"
            sqlT = sqlT & "06'"
            Me.HelpContextID = 88000038
    End Select
    Set rsTemp = dbsZJ.OpenRecordset(sqlTemp, dbOpenDynaset)
    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 Or iReturnType = 2), "cRetID='", "cCraID='") & sqlUnionkey & "'"
    End If
    If Not rstReturn.EOF Then
        GetRecord
    Else
            oV.SetButtonStatus Checkqx, blnSavFlag, blnAddFlag, Toolbar1, Combo1, mCopy.blnCopy, Label1(2)
        SetControlsStatus
    End If
    
End Sub

'********************************************************************
'*函数说明: 取填充数据到窗体                                          *
'*参    数:                                                          *
'*                                                                   *
'*返回值  :                                                          *
'*********************************************************************
Private Sub GetRecord()
    blnGetRecord = True
    With rstReturn
        edtDkbh = right(![cCreID], Len(![cCreID]) - 2)
        If iReturnType = 1 Or iReturnType = 2 Then
            edtHkbh = right(![cRetID], Len(![cRetID]) - 2)
        Else
            edtHkbh = right(![cCraID], Len(![cCraID]) - 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 = FormatDate(![dbill_date])
        edtEnter = AccIDToUnitName(![cAccId])
        edtZhh = ![cAccId]
        edtHkje = Format(![mMoney], "#0.00")
        edtBib = AccToExch(![cAccId])
        edtHl = ![nFrat]
        edtBje = Format(![mMoney_F], "#0.00")
        edtFkfs = Jsfscton(![isettle], True)
        edtJbr = IIf(IsNull(![ctran_name]), "", ![ctran_name])
        edtDigest = IIf(IsNull(![cDigest]), "", ![cDigest])
        Label1(3) = IIf(IsNull(![cBookCode]), "", ![cBookCode])
        Label1(4) = ![cBillCode]
        Label1(2) = IIf(IsNull(![cCheckCode]), "", ![cCheckCode])