ʰ

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

End Sub

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

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

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

Private Sub edtRq_Change()
   bRq = 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
End Sub

Private Sub edtRq_KeyDown(KeyCode As Integer, Shift As Integer)
   If KeyCode = vbKeyF2 Then
      Command1(0).Value = True
      edtRq.SetFocus
   End If
End Sub

Private Sub edtRq_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        SendKeys "{Tab}", False
        KeyAscii = 0
        Exit Sub
    End If
End Sub
' 日期
Private Sub edtRq_LostFocus()
   If edtRq <> "" And bRq Then
      bRq = False
      edtRq = ForDate(edtRq)
      If IsDate(edtRq) Then
         edtRq = FormatDate(edtRq)
         If CDate(edtRq) > zjLogInfo.curDate Then
            MsgBox "业务日期不能超过系统登录时间！", vbInformation, zjGl_Name
            SetTxtFocus edtRq
         End If
      Else
         MsgBox "日期非法，请检查！", vbInformation, zjGl_Name
         SetTxtFocus edtRq
      End If
   End If
End Sub

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

Private Sub edtZhh_Change()
   bZhh = 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 edtZhh <> "" Then
      strTemp = AccIDToUnitName(edtZhh)
      If strTemp <> "" Then
          edtEnter = strTemp
          edtBib = AccToExch(edtZhh)
      End If
   End If
End Sub

Private Sub edtZhh_KeyDown(KeyCode As Integer, Shift As Integer)
   If KeyCode = vbKeyF2 Then
      RefCmd1(1).RunReference
      edtZhh.SetFocus
   End If
End Sub

Private Sub edtZhh_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        SendKeys "{Tab}", False
        KeyAscii = 0
        Exit Sub
    End If
End Sub
' 账号
Private Sub edtZhh_LostFocus()
   Dim strTemp As String
   Dim iZhNy As Byte
   If edtZhh <> "" And bZhh Then
      bZhh = False
      strTemp = AccIDToUnitName(edtZhh)
      If strTemp = "" Then
          MsgBox "账户号不存在！", vbInformation, zjGl_Name
          SetTxtFocus edtZhh
          Exit Sub
      Else
          edtEnter = strTemp
          edtBib = AccToExch(edtZhh)
      End If
      iZhNy = GetZhNY(edtZhh)
      Select Case iReturnType
        Case 1, 3  '银行
           If iZhNy = 0 Then
              MsgBox "请输入外部账户！", vbInformation, zjGl_Name
              SetTxtFocus edtZhh
           End If
        Case 2, 4
           If iZhNy = 1 Then
              MsgBox "请输入内部账户！", vbInformation, zjGl_Name
              SetTxtFocus edtZhh
           End If
      End Select
   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 sqlReturn As String
    
    Screen.MousePointer = vbHourglass
    'zycAdd
    edtJbr.MaxLength = 8 'FD_CreAcrRcp.ctran_name'  length is 8
    
    Me.Icon = LoadResPicture(109, vbResIcon)
    sqlReturn = GetSqlReturn
    If FindFlag Then    '查询界面
        sqlReturn = sqlReturn & sqlFind
        Informtlb Me.Toolbar1, Me.ImageList1, True
        Checkqx = False
        initFind_Form
    Else
        Checkqx = Informtlb(Me.Toolbar1, Me.ImageList1, True, IIf(iReturnType = 1, 6, IIf(iReturnType, 9, IIf(iReturnType, 7, 10))))
    End If
    
    Set rstReturn = dbsZJ.OpenRecordset(sqlReturn, dbOpenDynaset)
    While Not rstReturn.EOF
      Combo1.AddItem right(rstReturn.Fields(0), 10)
      rstReturn.MoveNext
    Wend
    If rstReturn.RecordCount > 0 Then rstReturn.MoveFirst
    LoadStaticRes
    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 ReturnSave 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)
   FindFlag = False
   blnAddFlag = False
   rstReturn.oClose
End Sub

Private Sub JudgeSaves()
    If Not blnAddFlag Then
        If JudgeExistOrNot(rstReturn, 0) Then                '当前记录存在
            If JudgeCheckOrNot(rstReturn, 1) Then            '已审核
                VeriSuccess = False
            Else                                           '未审核
                'If Not JudgeLockOrNot(rstReturn, 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, edtEnter
      Case 1: edtZhh.SetFocus
         RefCmd1(Index).InitSys 0, dbsZJ
         RefCmd1(Index).InitSys 1, edtZhh
         RefCmd1(Index).InitSys 2, edtEnter
   End Select

End Sub

Private Sub RefCmd1_RefCancel(Index As Integer)
   Select Case Index
      Case 0: edtEnter.SetFocus
      Case 1: edtZhh.SetFocus
   End Select

End Sub

Private Sub RefCmd1_RefOK(Index As Integer, Code As String)
   Select Case Index
      Case 0: edtEnter = Code: edtEnter.SetFocus
      Case 1: edtZhh = Code: edtZhh.SetFocus
   End Select
   
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As ComctlLib.Button)
   Gen_Key Button.key
End Sub

Private Sub Gen_Key(TLB_Key As String)
    Dim i As Integer
    Dim id As Integer
    On Error Resume Next
    Select Case TLB_Key
        Case Is = "Print", "Preview", "Dataout"
            zjPrnViewOut Me, "yhdkhkdj", TLB_Key
        Case "AddRecord":
            If blnSavFlag Then
                Select Case PromptSav
                    Case vbYes:
                        JudgeSaves
                        If VeriSuccess Then
                            If VerifySav Then
                                ReturnSave
                                ReturnAdd
                            End If
                        End If
                    Case vbNo:
                        ReturnAdd
                    Case vbCancel
                End Select
            Else
                ReturnAdd
            End If
        Case "SaveRecord":
            JudgeSaves
            If VeriSuccess Then
                If VerifySav Then
                    If ReturnSave Then GetRecord
                End If
                VeriSuccess = False
            Else
                GetRecord
            End If
        Case "DeleteRecord":
         If Toolbar1.Buttons("DeleteRecord").Caption = "恢复" Then
            If JudgeExistOrNot(rstReturn, 0) 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(rstReturn, 0) Then            '当前记录存在
                  If Not JudgeLockOrNot(rstReturn, 1) Then      '未锁定
                     rstReturn.Delete
                  Else