银行贷款单.frm

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

      edtYqjx.SetFocus
   End If

End Sub

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

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

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
   Shift = Shift And 7
   Select Case KeyCode
      Case vbKeyF3
          If Shift = 0 And Not FindFlag And Toolbar1.Buttons("Check").Enabled Then
              Gen_Key "Check"
          End If
      Case vbKeyF4
          If Shift = vbAltMask Then
              Gen_Key "Exit"
          ElseIf Shift = 0 And Not FindFlag And Toolbar1.Buttons("CheckCancel").Enabled Then
              Gen_Key "CheckCancel"
          End If
      Case vbKeyF5
          If Shift = 0 And Not FindFlag And Toolbar1.Buttons("AddRecord").Enabled Then
              Gen_Key "AddRecord"
          End If
      Case vbKeyF6
          If Shift = 0 And Not FindFlag And Toolbar1.Buttons("SaveRecord").Enabled Then
              Gen_Key "SaveRecord"
          End If
      Case vbKeyF7
          If Shift = vbAltMask And Toolbar1.Buttons("PingZheng").Enabled Then
              Gen_Key "PingZheng"
          End If
      Case vbKeyC
          If Shift = vbCtrlMask And Not FindFlag And Toolbar1.Buttons("CopyRecord").Enabled And Toolbar1.Buttons("CopyRecord").ToolTipText = "Ctrl+C" Then
              Gen_Key "CopyRecord"
          End If
          KeyCode = 0
      Case vbKeyV
          If Shift = vbCtrlMask And Not FindFlag And Toolbar1.Buttons("CopyRecord").Enabled And Toolbar1.Buttons("CopyRecord").ToolTipText = "Ctrl+V" Then
              Gen_Key "CopyRecord"
          End If
          KeyCode = 0
      Case vbKeyY
          If Shift = vbCtrlMask And Not FindFlag And Toolbar1.Buttons("DeleteRecord").Enabled And Toolbar1.Buttons("DeleteRecord").ToolTipText = "Ctrl+Y" Then
              Gen_Key "DeleteRecord"
          End If
          KeyCode = 0
      Case vbKeyR
          If Shift = vbCtrlMask And Not FindFlag And Toolbar1.Buttons("DeleteRecord").Enabled And Toolbar1.Buttons("DeleteRecord").ToolTipText = "Ctrl+R" Then
              Gen_Key "DeleteRecord"
          End If
          KeyCode = 0
      Case vbKeyP
          If Shift = vbCtrlMask And Toolbar1.Buttons("Print").Enabled Then
              Gen_Key "Print"
          End If
          KeyCode = 0
      Case vbKeyS
          'cuidong 2001.01.15
          'If Shift = vbCtrlMask And Toolbar1.Buttons("Preview").Enabled Then
          '    Gen_Key "Preview"
          'End If
          KeyCode = 0
      Case vbKeyW
          If Shift = vbCtrlMask And Toolbar1.Buttons("Dataout").Enabled Then
              Gen_Key "Dataout"
          End If
          KeyCode = 0
      Case vbKeyPageUp
          If Shift = 0 And Toolbar1.Buttons("PriorPage").Enabled Then
              Gen_Key "PriorPage"
          ElseIf Shift = vbCtrlMask And Toolbar1.Buttons("FirstPage").Enabled Then
              Gen_Key "FirstPage"
          End If
      Case vbKeyPageDown
          If Shift = 0 And Toolbar1.Buttons("NextPage").Enabled Then
              Gen_Key "NextPage"
          ElseIf Shift = vbCtrlMask And Toolbar1.Buttons("LastPage").Enabled Then
              Gen_Key "LastPage"
          End If
   End Select
End Sub

Private Sub Form_Load()
    Dim sqlCred As String
    
    Screen.MousePointer = vbHourglass
    Me.Icon = LoadResPicture(109, vbResIcon)
    If FindFlag Then    '查询界面
''''       sqlCred = "SELECT * FROM FD_Cred WHERE [cCreID] LIKE " & _
''''               IIf((iCredType = 1), "'05%'", "'06%'")
''''       sqlCred = sqlCred & sqlFind
       Informtlb Me.Toolbar1, Me.ImageList1, True
       Checkqx = False
       initFind_Form
    Else
''''       sqlCred = "SELECT * FROM FD_Cred WHERE [cBookCode] IS NULL AND [cCreID] LIKE " & _
''''               IIf((iCredType = 1), "'05%'", "'06%'") & " ORDER BY [cCreID]"
       Checkqx = Informtlb(Me.Toolbar1, Me.ImageList1, True, IIf(iCredType = 1, 5, 8))
    End If
    LoadStaticRes
'''''    Set rstCred = dbsZJ.OpenRecordset(sqlCred, dbOpenDynaset)
      If FindFlag Then
            Set rstCred = oV.getUnBookRst(True)
      Else
            Set rstCred = oV.getUnBookRst
      End If
    While Not rstCred.EOF
      Combo1.AddItem Right(rstCred![cCreID], 8)
      rstCred.MoveNext
    Wend
    If rstCred.RecordCount > 0 Then rstCred.MoveFirst
    InitForm
    Screen.MousePointer = vbDefault
    
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If blnSavFlag Then
        Select Case PromptSav
            Case vbYes:
                JudgeSaves
                If VeriSuccess Then
                    If VerifySav Then
                        If Not CredSave Then Cancel = True
                    Else
                        Cancel = True
                    End If
                Else
                    Cancel = True
                End If
            Case vbNo:
            Case vbCancel
                Cancel = True
        End Select
    End If

End Sub

Private Sub Form_Unload(Cancel As Integer)
   rstCred.Close
   FindFlag = False
   blnSavFlag = False
   
End Sub

Private Sub JudgeSaves()
    If Not blnAddFlag Then
        If oV.IDExists(rstCred.Fields!cCreID) Then                 '当前记录存在
            If oV.isChecked(rstCred.Fields!cCreID) Then             '已审核
                VeriSuccess = False
            Else                                           '未审核
                'If Not JudgeLockOrNot(rstCred, 1) Then         '未锁定
                    VeriSuccess = True
                'End If
            End If
        Else                                               '当前记录不存在
            blnAddFlag = True
            VeriSuccess = True
        End If
    Else
        VeriSuccess = True
    End If

End Sub

Private Sub TurnPage(mPageType As Integer)
   If MoveRs(mPageType) Then
       GetRecord
   Else
       SetFormZero
   End If

End Sub

Private Sub frmYqjx_OK(Yqfs As Byte)
   iArtype_Cred = Yqfs
   edtYqjx = Getjxfs(iArtype_Cred)
   
End Sub

Private Sub RefCmd1_Initialize(Index As Integer)
   Select Case Index
      Case 0
         RefCmd1(Index).InitSys 0, dbsZJ
         RefCmd1(Index).InitSys 1, edtYhmc
      Case 1
         RefCmd1(Index).InitSys 0, dbsZJ
         RefCmd1(Index).InitSys 1, edtYhzh
         RefCmd1(Index).InitSys 2, edtYhmc
      Case 2
         RefCmd1(Index).InitSys 0, dbsZJ
         RefCmd1(Index).InitSys 1, edtLldm
      Case 3
         RefCmd1(Index).InitSys 0, dbsZJ
         RefCmd1(Index).InitSys 1, edtCad
   End Select
   
End Sub

Private Sub RefCmd1_RefCancel(Index As Integer)
   Select Case Index
      Case 0: edtYhmc.SetFocus
      Case 1: edtYhzh.SetFocus
      Case 2: edtLldm.SetFocus
      Case 3: edtCad.SetFocus
   End Select
   
End Sub

Private Sub RefCmd1_RefOK(Index As Integer, Code As String)
   Select Case Index
      Case 0: edtYhmc = Code: edtYhmc.SetFocus
      Case 1: edtYhzh = Code: edtYhzh.SetFocus
      Case 2: edtLldm = Code: edtLldm.SetFocus
      Case 3: edtCad = Code: edtCad.SetFocus
   End Select
   
End Sub

Private Sub SetFormZero()
   Combo1.Clear
   EmptyForm
   blnSavFlag = False
   blnAddFlag = False
   oV.SetButtonStatus Checkqx, blnSavFlag, blnAddFlag, Toolbar1, Combo1, mCopy_binCopy, Label1(0)
   SetControlsStatus
End Sub

Private Sub Gen_Key(TLB_Key As String)
    On Error Resume Next
    Dim i As Integer, id As Integer
       
    Select Case TLB_Key
        Case Is = "Print", "Preview", "Dataout"
            zjPrnViewOut Me, "yhdkdj", TLB_Key, IIf(iCredType = 1, 46, 139)
        Case "AddRecord":
            If blnSavFlag Then
                Select Case PromptSav
                    Case vbYes:
                        JudgeSaves
                        If VeriSuccess Then
                            If VerifySav Then
                                CredSave
                                CredAdd
                            End If
                        End If
                    Case vbNo:
                        CredAdd
                    Case vbCancel
                End Select
            Else
                CredAdd
            End If
        Case "SaveRecord":
            SaveRecords
        Case "DeleteRecord":
         If Toolbar1.Buttons("DeleteRecord").Caption = "恢复" Then
            If oV.IDExists(rstCred.Fields!cCreID) Then             '当前记录存在
               GetRecord
            Else
               If MoveRs(3) Then
                  GetRecord
               Else
                  SetFormZero
               End If
            End If
         Else
          If PromptDel = vbYes Then
            If Not blnAddFlag Then              '非新增单据
''''               If JudgeExistOrNot(rstCred, 0) Then            '当前记录存在
                  If oV.IDExists(rstCred.Fields!cCreID) Then
''''                  If Not JudgeLockOrNot(rstCred, 1) Then      '未锁定
'''                     rstCred.Delete
                        oV.Delete rstCred.Fields!cCreID
                        rstCred.Requery
'''                  Else
'''                     Exit Sub
'''                  End If
               End If
               MoveRs 3
               If rstCred.RecordCount > 0 Then
                   Dim ia As Integer
                   ia = Combo1.ListIndex
                   Combo1.RemoveItem Combo1.ListIndex
                   If ia > Combo1.ListCount - 1 Then ia = Combo1.ListCount - 1
                   Combo1.ListIndex = ia
               End If
            Else
               If oV.IDExists(rstCred.Fields!cCreID) Then            '当前记录存在
                  GetRecord
               Else
                  If Combo1.ListIndex = -1 Then Combo1_DropDown
                  edtYwbh = Combo1.List(Combo1.ListIndex)
                  If MoveRs(3) Then
                     GetRecord
                  End If
               End If
            End If
            If rstCred.RecordCount = 0 Then
               SetFormZero
            End If
          End If
         End If
        
        Case "CopyRecord"
            If Toolbar1.Buttons("CopyRecord").Caption = "复制" Then
               CopyInformation
            Else
               PasteInformation
            End If
        Case "FirstPage":
            ReQryCombo
            Combo1.ListIndex = 0
        Case "PriorPage":
            ReQryCombo
            Combo1.ListIndex = Combo1.ListIndex - 1
        Case "NextPage":
            ReQryCombo
            Combo1.ListIndex = Combo1.ListIndex + 1
        Case "LastPage":
            ReQryCombo
            Combo1.ListIndex = Combo1.ListCount - 1
        Case "Check":
            InitFrmCheck_xz True
            Select Case CheckStatus
                Case 0:     ' 审核
                     'if 审核=制单 Then Exit Sub
                     If zjLogInfo.cUserName = Label1(1) Then
                        Beep
                        MsgBox "审核与制单不能为同一人！", vbInformation, zjGl_Name
                        Exit Sub
                     End If
                     Check "One"
                Case 1:     ' 批审
                    Check "All"
                Case 2:     '
            End Select
        Case "CheckCancel":
            InitFrmCheck_xz False
            Select Case CheckStatus
                Case 0:     ' 取消审核
                    UnCheck "One"
                Case 1:     ' 批消
                    UnCheck "All"
                Case 2:     '
            End Select
        Case "PingZheng":
            With pzInfo
               .pDjrq = edtRq
               .pMoney = edtJkje
               .pYwID = rstCred![cCreID]
               .pZhID1 = edtYhzh
               .pZhID2 = pzZhID2
               .pDigest = edtDigest
               .pHl = edtHl
               .blnFind = FindFlag
            End With
            If ZjAccInfo.zjPrnCtrl Then Exit Sub
            ZjAccInfo.zjPrnCtrl = True
            DoVouch
            ZjAccInfo.zjPrnCtrl = False
            SetControlsStatus
            oV.SetButtonStatus Checkqx, blnSavFlag, blnAddFlag, Toolbar1, Combo1, mCopy_binCopy, Label1(0)
        Case "Help":
            SendKeys "{F1}"
        Case "Exit":
            Unload Me
    End Select

End Sub

Private Sub SaveRecords()
   JudgeSaves
   If VeriSuccess Then
       If VerifySav Then
           If CredSave Then
               GetRecord
           End If
       End If
       VeriSuccess = False
   Else
       GetRecord
   End If
   
'   If Not VerifySav Then Exit Sub
'
'   Dim tRst As SaveResultInfomation
'   tRst = CredSave
'   Select Case tRst.lngErrNumber
'      Case 0
'         Beep