内部拆借单.frm

不处的管理软件包

        edtFkjb = IIf(IsNull(![cpay_name]), "", ![cpay_name])     ' 付款经办
        edtZxjb = IIf(IsNull(![cset_name]), "", ![cset_name])     ' 中心经办
        edtDigest = IIf(IsNull(![cDigest]), "", ![cDigest])         ' 摘要
        Label1(1) = IIf(IsNull(![cCheckCode]), "", ![cCheckCode])
        Label1(2) = IIf(IsNull(![cBookCode]), "", ![cBookCode])
        Label1(3) = ![cBillCode]
    End With
    blnGetRecord = False
    blnSavFlag = False
    blnAddFlag = False
    oV.SetButtonStatus Checkqx, blnSavFlag, blnAddFlag, Toolbar1, Combo1, mCopy.blnCopy, Label1(1)
    SetControlsStatus
    On Error Resume Next
    edtRq.SetFocus
    On Error GoTo 0
End Sub

'********************************************************************
'*函数说明: 设置控件状态                                              *
'*参    数:                                                          *
'*                                                                   *
'*返回值  :                                                          *
'*********************************************************************
Private Sub SetControlsStatus()
   Dim i As Integer
   Dim bVouched As Boolean
   
   edtBib.Locked = True
   edtBje.Locked = True
   If blnAddFlag Then
      edtYwbh.Locked = False
   Else
      edtYwbh.Locked = True
   End If
   bVouched = oV.hasMadePZ("07" & Combo1.List(Combo1.ListIndex))
   If (bVouched Or FindFlag Or Label1(1) <> "" Or rstLend.RecordCount = 0) And Not blnAddFlag Then
      edtRq.Locked = True
      edtCrbm.Locked = True
      edtCcbm.Locked = True
      edtSkzh.Locked = True
      edtFkzh.Locked = True
      edtJe.Locked = True
      edtHl.Locked = True
      edtHkrq.Locked = True
      edtLldm.Locked = True
      edtSkjb.Locked = True
      edtFkjb.Locked = True
      edtZxjb.Locked = True
      edtDigest.Locked = True
      For i = 0 To 1
         Command1(i).Enabled = False
      Next i
      For i = 0 To 4
         RefCmd1(i).Enabled = False
      Next i
   Else
      edtRq.Locked = False
      edtCrbm.Locked = False
      edtCcbm.Locked = False
      edtSkzh.Locked = False
      edtFkzh.Locked = False
      edtJe.Locked = False
      edtHl.Locked = IIf(ZjAccInfo.zjStandExch = edtBib, True, False)
      edtHkrq.Locked = False
      edtLldm.Locked = False
      edtSkjb.Locked = False
      edtFkjb.Locked = False
      edtZxjb.Locked = False
      edtDigest.Locked = False
      For i = 0 To 1
         Command1(i).Enabled = True
      Next i
      For i = 0 To 4
         RefCmd1(i).Enabled = True
      Next i
   End If

End Sub

'********************************************************************
'*函数说明: 删除记录                                                  *
'*参    数:                                                          *
'*                                                                   *
'*返回值  :                                                          *
'*********************************************************************
Private Sub LendDelete()
'''    rstLend.Delete
      oV.Delete rstLend.Fields!cRetID
      rstLend.Requery
    MoveRs 3
   
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 LendSave 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)
   rstLend.Close
   FindFlag = False
   blnSavFlag = False
   
End Sub

Private Sub JudgeSaves()
    If Not blnAddFlag Then
'        If JudgeExistOrNot(rstLend, 0) Then                '当前记录存在
        If oV.IDExists(rstLend!cUnwID) Then                 '当前记录存在
            If oV.isChecked(rstLend!cUnwID) Then            '已审核
                VeriSuccess = False
            Else                                           '未审核
                'If Not JudgeLockOrNot(rstLend, 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 RefCmd1_Initialize(Index As Integer)
   Select Case Index
      Case 0:
         RefCmd1(Index).InitSys 0, dbsZJ
         RefCmd1(Index).InitSys 1, edtCrbm
      Case 1:
         RefCmd1(Index).InitSys 0, dbsZJ
         RefCmd1(Index).InitSys 1, edtSkzh
         RefCmd1(Index).InitSys 2, edtCrbm
      Case 2:
         RefCmd1(Index).InitSys 0, dbsZJ
         RefCmd1(Index).InitSys 1, edtCcbm
      Case 3:
         RefCmd1(Index).InitSys 0, dbsZJ
         RefCmd1(Index).InitSys 1, edtFkzh
         RefCmd1(Index).InitSys 2, edtCcbm
      Case 4:
         RefCmd1(Index).InitSys 0, dbsZJ
         RefCmd1(Index).InitSys 1, edtLldm
   End Select

End Sub

Private Sub RefCmd1_RefCancel(Index As Integer)
   
   Select Case Index
      Case 0: edtCrbm.SetFocus
      Case 1: edtSkzh.SetFocus
      Case 2: edtCcbm.SetFocus
      Case 3: edtFkzh.SetFocus
      Case 4: edtLldm.SetFocus
   End Select

End Sub

Private Sub RefCmd1_RefOK(Index As Integer, Code As String)
   Select Case Index
      Case 0: edtCrbm = Code: edtCrbm.SetFocus
      Case 1: edtSkzh = Code: edtSkzh.SetFocus
      Case 2: edtCcbm = Code: edtCcbm.SetFocus
      Case 3: edtFkzh = Code: edtFkzh.SetFocus
      Case 4: edtLldm = Code: edtLldm.SetFocus
   End Select
   
End Sub

Private Sub SetFormZero()
   Combo1.clear
   EmptyForm
   blnSavFlag = False
   blnAddFlag = False
    oV.SetButtonStatus Checkqx, blnSavFlag, blnAddFlag, Toolbar1, Combo1, mCopy.blnCopy, Label1(1)
   SetControlsStatus
End Sub

Private Sub Gen_Key(TLB_Key As String)
    On Error Resume Next
    Dim i As Integer
    Dim id As Integer
    Select Case TLB_Key
        Case Is = "Print", "Preview", "Dataout"
            zjPrnViewOut Me, "nbcjdj", TLB_Key
        Case "AddRecord":
            If blnSavFlag Then
                Select Case PromptSav
                    Case vbYes:
                        JudgeSaves
                        If VeriSuccess Then
                            If VerifySav Then
                                LendSave
                                LendAdd
                            End If
                        End If
                    Case vbNo:
                        LendAdd
                    Case vbCancel
                End Select
            Else
                LendAdd
            End If
        Case "SaveRecord":
            JudgeSaves
            If VeriSuccess Then
                If VerifySav Then
                    If LendSave And blnAddFlag Then GetRecord
                End If
                '修改完刷新
                If Not blnAddFlag Then Combo1_Click
                
                VeriSuccess = False
            Else
                GetRecord
            End If
'''''            Combo1_Click
        Case "DeleteRecord":
         If Toolbar1.Buttons("DeleteRecord").Caption = "恢复" Then '恢复
            If oV.IDExists(rstLend!cUnwID) 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(rstLend, 0) Then              '当前记录存在
                  If oV.IDExists(rstLend.Fields!cUnwID) Then
''''                  If Not JudgeLockOrNot(rstLend, 1) Then      '未锁定
'''''''                     rstLend.Delete
                        oV.Delete rstLend.Fields!cUnwID
'''''''                  Else
'''''''                     Exit Sub
'''''''                  End If
               End If
               MoveRs 3
               If rstLend.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(rstLend!cUnwID) 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 rstLend.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(3) Then
                        Beep
                        MsgBox "审核与制单不能为同一人！", vbInformation
                        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 = edtJe
               .pYwID = rstLend![cUnwID]
               .pZhID1 = edtSkzh
               .pZhID2 = edtFkzh
               .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.blnCopy, Label1(1)
        Case "Help":
            SendKeys "{F1}"
        Case "Exit":
            Unload Me
    End Select

End Sub

'********************************************************************
'*函数说明: 审核记录                                                  *
'*参    数:                                                          *
'*                                                                   *
'*返回值  :                                                          *
'*********************************************************************
Private Sub Check(mCount As String)
    Dim id As Integer
    Dim mStr As String
    
    DoEvents
    Select Case mCount
        Case "One":
            If oV.IDExists(rstLend.Fields!cUnwID) Then     '当前记录存在
                If Not oV.isChecked(rstLend.Fields!cUnwID) Then      '未审核
''''                    If Not JudgeLockOrNot(rstLend, 1) Then              '未锁定
''''                        With rstLend
''''                            .edit
''''                            ![cCheckCode] = zjLogInfo.cUserName
''''                            .Update
''''                        End With
                        oV.editChecker zjLogInfo.cUserName, rstLend.Fields!cUnwID

''''                    End If
                Else
                     PromptChecked
                End If
                GetRecord
            Else
                If MoveRs(3) Then
                    GetRecord
                Else
                    SetFormZero
                End If
            End If
        Case "All":
            With rstLend
                If .RecordCount <> 0 Then
                    .MoveFirst
                    While Not .EOF
                        If Not oV.isChecked(rstLend.Fields!cUnwID) Then      '未审核
''''                            If Not J