银行贷款单.frm

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

         TabIndex        =   41
         Top             =   180
         Width           =   720
      End
      Begin VB.Label lbldkd 
         AutoSize        =   -1  'True
         Caption         =   "日期"
         Height          =   180
         Index           =   22
         Left            =   5820
         TabIndex        =   40
         Top             =   180
         Width           =   360
      End
      Begin VB.Label lbldkd 
         AutoSize        =   -1  'True
         Caption         =   "审核："
         Height          =   180
         Index           =   24
         Left            =   660
         TabIndex        =   39
         Top             =   3690
         Width           =   540
      End
      Begin VB.Label lbldkd 
         AutoSize        =   -1  'True
         Caption         =   "记帐："
         Height          =   180
         Index           =   25
         Left            =   3420
         TabIndex        =   38
         Top             =   3690
         Width           =   540
      End
      Begin VB.Label lbldkd 
         AutoSize        =   -1  'True
         Caption         =   "制单："
         Height          =   180
         Index           =   26
         Left            =   6300
         TabIndex        =   37
         Top             =   3690
         Width           =   540
      End
      Begin VB.Shape Shape2 
         Height          =   3165
         Left            =   300
         Top             =   480
         Width           =   7575
      End
   End
   Begin ComctlLib.ImageList ImageList1 
      Left            =   30
      Top             =   600
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      MaskColor       =   12632256
      _Version        =   327682
   End
   Begin VB.Label lbldkd 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      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           =   23
      Left            =   3400
      TabIndex        =   43
      Top             =   810
      Width           =   1290
   End
End
Attribute VB_Name = "frmCred"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'软件著作权: 北京用友软件集团有限公司
'系统名称: 资金管理8.0
'功能说明: 贷款单
'作者: 赵春立

Option Explicit
Private mCopy_binCopy As Boolean
Public FindFlag As Boolean
Public UnionFindflag As Boolean

Public sqlUnionkey As String
Public sqlFind As String
Public iCredType As Byte '1-银行贷款，2-内部贷款

Public Event Move(StepRs As Long)
Public Event ShowErr(ErrDescription As String)

Private VeriSuccess As Boolean
Private rstCred As adodb.Recordset
Private blnSavFlag As Boolean
Private blnAddFlag As Boolean

Private blnCombo As Boolean
Private Checkqx As Boolean
Private iArtype_Cred As Byte
Private WithEvents frmYqjx As frmCred_cz1
Attribute frmYqjx.VB_VarHelpID = -1

'''''Public Type CopyInfo
'''''   blnCopy As Boolean
'''''   strYhmc As String
'''''   strYhzh As String
'''''   dblJkje As Double
'''''   strBib As String
'''''   dblHl As Double
'''''   dblBje As Double
'''''   dHkrq As Date
'''''   strLldm As String
'''''   strDbje As String
'''''   strEnter As String
'''''   strJsr As String
'''''   strCad As String
'''''   strDigest As String
'''''   intArtype As Integer
'''''End Type

Dim mCopy As CopyInfo
Private blnGetRecord As Boolean

Dim bRq As Boolean
Dim bYhzh As Boolean
Dim bHkrq As Boolean
Dim bLldm As Boolean
Dim bCad 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
   Dim rsName As String
   Dim rsType As Byte
   
   On Error GoTo ReQry
   If rstCred Is Nothing Then
''''ReQry:   Set rstCred = dbsZJ.OpenRecordset(rstCred.Source)
ReQry:
      If FindFlag Then
            Set rstCred = oV.getUnBookRst(True)
      Else
            Set rstCred = oV.getUnBookRst
      End If

   Else
      rstCred.Requery
   End If
   With rstCred
        i = Combo1.ListIndex
        Combo1.Clear
        If .EOF Then
           SetFormZero
           Exit Sub
        Else
           While Not .EOF
              Combo1.AddItem Right(![cCreID], 8)
              .MoveNext
           Wend
           If i > Combo1.ListCount - 1 Then i = Combo1.ListCount - 1
           blnCombo = True
           Combo1.ListIndex = i
           blnCombo = False
           Select Case iCredType
                Case 1: mStr = "[cCreID]='05" & Combo1.List(Combo1.ListIndex) & "'"
                Case 2: mStr = "[cCreID]='06" & Combo1.List(Combo1.ListIndex) & "'"
           End Select
           .MoveFirst
           .Find 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, Picture2.Left, Picture2.Top
        Case 1: DisplayCalendar edtHkrq, Me.hWnd, Picture2.Left + Frame1.Left, Picture2.Top + Frame1.Top
        Case 2:
            Set frmYqjx = New frmCred_cz1
            frmYqjx.optCaption = edtYqjx
            frmYqjx.Show vbModal
            edtYqjx.SetFocus
            If iArtype_Cred = 0 Then
               edtCad = ""
               edtCad.Locked = True
               RefCmd1(3).Enabled = False
            Else
               edtCad.Locked = False
               RefCmd1(3).Enabled = True
            End If
            Set frmYqjx = Nothing
    End Select
    
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(1).Picture = LoadResPicture(1108, vbResBitmap)
   Command1(2).Picture = LoadResPicture(129, vbResBitmap)
   lbldkd(1) = IIf((iCredType = 1), "银行名称", "单位名称")
   lbldkd(2) = IIf((iCredType = 1), "银行账号", "账户号")
   Me.Caption = IIf((iCredType = 1), "银行贷款", "内部贷款")
   lbldkd(23) = IIf((iCredType = 1), "银行贷款单", "内部贷款单")
   lbldkd(21) = "业务编号"
   lbldkd(22) = "日期"
   lbldkd(5) = "借款金额"
   lbldkd(3) = "币别"
   lbldkd(4) = "汇率"
   lbldkd(6) = "本位币金额"
   lbldkd(7) = "还款日期"
   lbldkd(8) = "利率代码"
   lbldkd(15) = "已还金额"
   lbldkd(11) = "担保金额"
   lbldkd(14) = "经 手 人"
   lbldkd(12) = "担保单位"
   lbldkd(9) = "结息日代码"
   lbldkd(13) = "摘 要"
   lbldkd(10) = "计息方式"
   lbldkd(24) = "审核："
   lbldkd(25) = "记账："
   lbldkd(26) = "制单："
   
End Sub

Private Sub InitForm()
    Dim rsTemp As New UfRecordset, sqlTemp As String
    
    If UnionFindflag Then
        FindFirst rstCred, "cCreID = '" & sqlUnionkey & " '"
    End If
    If Not rstCred.EOF Then
        GetRecord
    Else
        SetFormZero
    End If
'''    sqlTemp = "SELECT * FROM FD_Class WHERE [csign]='"
    Select Case iCredType
        Case 1:
            sqlTemp = sqlTemp & "05'"
            RefCmd1(0).RefUnitMode = RefBank
            RefCmd1(1).RefAccMode = RefOutsideAcc
            Me.HelpContextID = 88000026
        Case 2:
            sqlTemp = sqlTemp & "06'"
            RefCmd1(0).RefUnitMode = RefNotBank
            RefCmd1(1).RefAccMode = RefInsideAcc
            Me.HelpContextID = 88000028
    End Select
''''    Set rsTemp = dbsZJ.OpenRecordset(sqlTemp, dbOpenDynaset)
    lbldkd(27) = oV.voucherName
    
End Sub

'********************************************************************
'*函数说明: 取填充数据到窗体                                          *
'*参    数:                                                          *
'*                                                                   *
'*返回值  :                                                          *
'*********************************************************************
Private Sub GetRecord()
    blnGetRecord = True
'''    Gen_Key "nextPage"
'''   Gen_Key "lastPage"
      Dim sID As String
    With rstCred
''      sID = .Fields!cCreID
''      .Requery
''      .Find ""
'''.Resync
        edtYwbh = Right(![cCreID], Len(![cCreID]) - 2) '业务日期
        edtYwbh.Visible = False
        blnCombo = True
'        Combo1.Text = edtYwbh          'cuidong 2001.08.23
        MoveComboByText Combo1, edtYwbh 'cuidong 2001.08.23
        Combo1.Visible = True
        blnCombo = False
        edtRq = FormatDate(![dbill_date])
        edtYhzh = ![cAccID]
        edtYhmc = AccIDToUnitName(![cAccID])
        edtJkje = Format(![mMoney], "#0.00")
        edtLldm = ![cIntrID]
        edtHkrq = FormatDate(![Dret_date])
        edtDigest = IIf(IsNull(![cDigest]), "", ![cDigest])
        edtBib = AccToExch(![cAccID])
        edtHl = ![nFrat]
        edtBje = Format(![mMoney_F], "#0.00")
        edtEnter = IIf(IsNull(![center_name]), "", ![center_name])
        edtJsr = IIf(IsNull(![ctran_name]), "", ![ctran_name])
        edtYhje = FormatCur(GetMoneyed)
        edtDbje = IIf(IsNull(![mmoneying]), "", ![mmoneying])
        Label1(0) = IIf(IsNull(![cCheckCode]), "", ![cCheckCode])
        Label1(2) = IIf(IsNull(![cBookCode]), "", ![cBookCode])
        Label1(1) = ![cBillCode]
        edtCad = IIf(IsNull(![cCadID]), "", ![cCadID])
        edtYqjx = Getjxfs(![iartyp])
        iArtype_Cred = ![iartyp]
    End With
    blnGetRecord = False
    blnSavFlag = False
    blnAddFlag = False
    oV.SetButtonStatus Checkqx, blnSavFlag, blnAddFlag, Toolbar1, Combo1, mCopy.blnCopy, Label1(0)
    SetControlsStatus
    On Error Resume Next
    edtRq.SetFocus
    On Error GoTo 0
End Sub

Private Function GetMoneyed() As Currency
   Dim rsRet As adodb.Recordset, sqlRet As String
   
   sqlRet = "SELECT Sum([mmoney]) As mmoneyed FROM FD_Return WHERE [cCreID]='" & _
         IIf(iCredType = 1, "05", "06") & edtYwbh & "'"
'''''   Set rsRet = dbsZJ.OpenRecordset(sqlRet, dbOpenDynaset)
      Set rsRet = oV.getReadOnlyRst(sqlRet)
   GetMoneyed = IIf(IsNull(rsRet![mmoneyed]), 0, rsRet![mmoneyed])
   rsRet.Close
    
End Function

Private Sub edtBib_Change()
   ' 币别为空，汇率亦跟随
   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
        edtYwbh.Visible = True
       blnSavFlag = True
       oV.SetButtonStatus Checkqx, blnSavFlag, blnAddFlag, Toolbar1, Combo1, mCopy.blnCopy, Label1(0)
   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 edtCad_Change()