voucher.cls

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

        If CurRecord = 0 Then
            tlb.Buttons("FirstPage").Enabled = False
            tlb.Buttons("PriorPage").Enabled = False
        Else
            tlb.Buttons("FirstPage").Enabled = True
            tlb.Buttons("PriorPage").Enabled = True
        End If
        If CurRecord < mRecords - 1 Then
            tlb.Buttons("NextPage").Enabled = True
            tlb.Buttons("LastPage").Enabled = True
        Else
            tlb.Buttons("NextPage").Enabled = False
            tlb.Buttons("LastPage").Enabled = False
        End If
    End If
End Sub

'********************************************************************
'*函数说明: 设置Button状态                                           *
'*参    数:                                                          *
'*                                                                   *
'*返回值  :                                                          *
'*********************************************************************
Public Sub SetButtonStatus(Checkqx As Boolean, blnSavFlag As Boolean, blnAddFlag As Boolean, Toolbar1 As ToolBar, Cbo As ComboBox, mCopy_blnCopy As Boolean, Lable1 As label, Optional bUnionFind As Boolean = False, Optional sUnionKey As String = "")
   Dim i As Integer
   Dim blnSav As Boolean
   Dim blnAdd As Boolean
   Dim iRecordCount As Integer
   Dim iRecordPosition As Integer
   
   blnSav = blnSavFlag
   blnAdd = blnAddFlag
'''   iRecordCount = rstCred.RecordCount
'''   iRecordPosition = rstCred.AbsolutePosition
   iRecordCount = Cbo.ListCount
   iRecordPosition = Cbo.ListIndex

   With Toolbar1
      If iRecordCount = 0 Then   '无记录
         For i = 1 To 17
            .Buttons(i).Enabled = False
         Next i
         .Buttons(5).Enabled = True
         If blnAdd Then
            .Buttons("SaveRecord").Enabled = True
            .Buttons("DeleteRecord").Enabled = True
            .Buttons("DeleteRecord").Caption = "删除"
            .Buttons("DeleteRecord").Image = "DeleteRecord"
            .Buttons("CopyRecord").Enabled = mCopy_blnCopy
            .Buttons("CopyRecord").Caption = "粘贴"
            .Buttons("CopyRecord").Image = "PasteRecord"
         End If
      Else                       '有记录
         If blnSav Then
            .Buttons("Print").Enabled = False
            .Buttons("Preview").Enabled = False
            .Buttons("Dataout").Enabled = False
            .Buttons("SaveRecord").Enabled = True
            .Buttons("DeleteRecord").Enabled = True
            If blnAdd Then
               .Buttons("DeleteRecord").Enabled = True
               .Buttons("DeleteRecord").Caption = "删除"
               .Buttons("DeleteRecord").Image = "DeleteRecord"
               .Buttons("DeleteRecord").ToolTipText = "Ctrl+Y"
               .Buttons("CopyRecord").Enabled = mCopy_blnCopy
               .Buttons("CopyRecord").Caption = "粘贴"
               .Buttons("CopyRecord").Image = "PasteRecord"
               .Buttons("CopyRecord").ToolTipText = "Ctrl+V"
            Else
               .Buttons("DeleteRecord").Enabled = True
               .Buttons("DeleteRecord").Image = "RestoreRecord"
               .Buttons("DeleteRecord").Caption = "恢复"
               .Buttons("DeleteRecord").ToolTipText = "Ctrl+R"
               .Buttons("CopyRecord").Enabled = False
               .Buttons("CopyRecord").Image = "CopyRecord"
               .Buttons("CopyRecord").Caption = "复制"
               .Buttons("CopyRecord").ToolTipText = "Ctrl+C"
            End If
            .Buttons("FirstPage").Enabled = False
            .Buttons("PriorPage").Enabled = False
            .Buttons("NextPage").Enabled = False
            .Buttons("LastPage").Enabled = False
            If Checkqx Then
                .Buttons("Check").Enabled = False
                .Buttons("CheckCancel").Enabled = False
            End If
            .Buttons("PingZheng").Enabled = False
         Else
            .Buttons("Print").Enabled = True
            .Buttons("Preview").Enabled = True
            .Buttons("Dataout").Enabled = True
            .Buttons("SaveRecord").Enabled = False
'''            .Buttons("DeleteRecord").Enabled = IIf(Label1(0) = "" And Not oV.hasMadePZ(msVchID & Cbo.List(Cbo.ListIndex)), True, False)
            Dim bhasMadePZ As Boolean
            If bUnionFind Then
                  bhasMadePZ = oV.hasMadePZ(sUnionKey)
            Else
                  bhasMadePZ = oV.hasMadePZ(msVchID + Cbo.List(Cbo.ListIndex))
            End If
            .Buttons("DeleteRecord").Enabled = IIf(Lable1.Caption = "" And Not bhasMadePZ, True, False)

            If .Buttons("DeleteRecord").Image <> "DeleteRecord" Then
               .Buttons("DeleteRecord").Caption = "删除"
               .Buttons("DeleteRecord").Image = "DeleteRecord"
               .Buttons("DeleteRecord").ToolTipText = "Ctrl+Y"
            End If
            .Buttons("CopyRecord").Enabled = True
            If .Buttons("CopyRecord").Image <> "CopyRecord" Then
               .Buttons("CopyRecord").Image = "CopyRecord"
               .Buttons("CopyRecord").Caption = "复制"
               .Buttons("CopyRecord").ToolTipText = "Ctrl+C"
            End If
            If iRecordPosition = 0 Then
               .Buttons("FirstPage").Enabled = False
               .Buttons("PriorPage").Enabled = False
               .Buttons("NextPage").Enabled = True
               .Buttons("LastPage").Enabled = True
            End If
            If iRecordPosition = iRecordCount - 1 Then
               If iRecordPosition > 0 Then
                  .Buttons("FirstPage").Enabled = True
                  .Buttons("PriorPage").Enabled = True
               End If
               .Buttons("NextPage").Enabled = False
               .Buttons("LastPage").Enabled = False
            End If
            If iRecordPosition > 0 And iRecordPosition < iRecordCount - 1 Then
               .Buttons("FirstPage").Enabled = True
               .Buttons("PriorPage").Enabled = True
               .Buttons("NextPage").Enabled = True
               .Buttons("LastPage").Enabled = True
            End If
            If Checkqx Then
                .Buttons("Check").Enabled = True
                .Buttons("CheckCancel").Enabled = True
            End If
            .Buttons("PingZheng").Enabled = True
         End If
      End If
   End With
End Sub

Public Function getReadOnlyRst(sSQL As String) As adodb.Recordset
      Dim rstT As New adodb.Recordset
'''      Dim sSQL As String
''''      If TableName = "" Then
''''            sSQL = " Select * from " + mTblName + Where
''''      Else
''''            sSQL = " Select * from " + TableName + Where
''''      End If
      rstT.Open sSQL, mCn, adOpenStatic, adLockReadOnly, adCmdText
      Set getReadOnlyRst = rstT
End Function
Public Function getMaxID(Optional ByVal sType As String) As String
    Dim rsTemp As New adodb.Recordset, i As Long
    Dim sQ As String
    Dim sID As String
    
    Dim sID_From As String  'cuidong 2001.04.16
    Dim sID_To As String    'cuidong 2001.04.16
    
    
    sQ = "Select Max(" + mIDFldName + ") as MaxID from " + mTblName _
      + " where " + mIDFldName + " Like '" + msVchID + "%'"
      rsTemp.Open sQ, mCn, adOpenForwardOnly, adLockReadOnly, adCmdText
    With rsTemp
            If .EOF Then
               sID = "00000001"
            ElseIf IsNull(.Fields(0)) Then
               sID = "00000001"
            Else
                sID = Right(str(100000001 + Right(.Fields(0), 8)), 8)
            End If
        If sID = "00000000" Then
            sQ = "Select " + mIDFldName + "  from " + mTblName _
                  + " where " + mIDFldName + " Like '" + msVchID + "%'"
            rsTemp.Close
             rsTemp.Open sQ, mCn, adOpenStatic, adLockReadOnly, adCmdText
            For i = 1 To 99999998
                sID = Right(str(100000000 + i), 8)
                .Find mIDFldName + " = '" + msVchID + sID + "'"
                If .EOF Then
                    Exit Function
                End If
            Next
        End If
        
        'cuidong 2001.04.16
        '----------------------------------------------
        '得到一个没有冲突的编号
        sID_From = sID
        sID_To = sID_From
        Do While oV.hasMadePZ(sType & sID)
           sID = Right(str(100000001 + Val(sID)), 8)
           sID_To = sID
        Loop
        If Not sID_From = sID Then
           '有冲突
           If sID_From = sID_To Then
              '只有一个
              MsgBox "编号‘" & sID & "’与某些凭证冲突，本单据将使用‘" & sID & "’。", vbInformation, zjGl_Name
           Else
              '连续多个
              MsgBox "编号‘" & sID_From & "’-‘" & sID_To & "’与某些凭证冲突，本单据将使用‘" & sID & "’。", vbInformation, zjGl_Name
           End If
        End If
        '----------------------------------------------
        getMaxID = sID
    End With
End Function
Public Function getUnBookRst(Optional bFindflag As Boolean = False) As adodb.Recordset
      Dim rstT As New adodb.Recordset
      Dim sSQL As String
'''''      Dim Rst As New ADODB.Recordset
      If bFindflag Then
            sSQL = "Select * from " + mTblName + "  where " + mIDFldName + "  LIKE  '" + msVchID + "%' "
      Else
            sSQL = "Select * from " + mTblName + "  where " + mIDFldName + "  LIKE  '" + msVchID + "%'  And CbookCode IS NULL order by " + mIDFldName
      End If
      With rstT
            .CursorType = adOpenDynamic
            .LockType = adLockReadOnly
            .CursorLocation = adUseClient
            .Open sSQL, mCn, , , adCmdText
      End With
      Set getUnBookRst = rstT.Clone
      rstT.Close
      Set rstT = Nothing
End Function

'*********************************************************************
'*函数说明: 判断某张单据是否生成凭证                                    *
'*参    数: cDjID         单据编码                                     *
'*                                                                    *
'*返回值  : True - 已生成凭证                                          *
'*********************************************************************
Public Function hasMadePZ(vchID As String) As Boolean
   Dim sqlVouch As String
   'Dim rsVouch As New adodb.Recordset
   Dim rsVouch As UfRecordset
   
   sqlVouch = "Select * from FD_Vouch where cBus_id = '" + vchID + "'"
   Set rsVouch = dbsZJ.OpenRecordset(sqlVouch)
   With rsVouch
'      RsVouch.Open sqlVouch, mCn, adOpenForwardOnly, adLockReadOnly, adCmdText
      If .EOF Then
         hasMadePZ = False
      Else
         hasMadePZ = True
      End If
'      .Close
      .oClose
   End With
End Function

Public Function IDExists(sIDCode As String) As Boolean
      Dim Rs As New adodb.Recordset
      Dim sQ As String
      sQ = "Select * from " + mTblName _
      + " where " + mIDFldName + " = '" + sIDCode + "'"
      With Rs
            .Open sQ, mCn, adOpenForwardOnly, adLockReadOnly, adCmdText
            If .EOF Then
                  IDExists = False
            Else
                  IDExists = True
            End If
      End With
End Function

'cuidong 2001.08.22
'验证单据编号，如果存在，跳转至下一编号，1000个编号以后，返回False
Public Function ValidateBillID(ByRef sID As String) As Boolean
    Dim sID_From As String
    Dim sID_To As String
    Dim iLoopCount  As Long
    
    ValidateBillID = False
    
    sID_From = sID
    sID_To = sID
    iLoopCount = 0
    
    Do While IDExists(sID_To)
       '得到一个没有冲突的编号
       sID_To = Left$(sID_To, 2) & Right(str(100000001 + Val(Right(sID_To, 8))), 8)
       iLoopCount = iLoopCount + 1
       If iLoopCount > 1000 Then Exit Function
    Loop
    
    If Not sID_From = sID_To Then
       '有冲突
       'MsgBox "编号‘" & Right(sID_From, 8) & "’已存在，本单据将使用‘" & Right(sID_To, 8) & "’。", vbInformation, zjGl_Name
    End If
    
    sID = sID_To
    ValidateBillID = True
    
End Function

Public Function voucherName() As String
      Dim Rs As New adodb.Recordset
      Dim sQ As String
      sQ = "SELECT * FROM FD_Class WHERE [csign]='" + msVchID + "'"
      With Rs
            .Open sQ, mCn, adOpenForwardOnly, adLockReadOnly, adCmdText
            If .EOF Then
                 MsgBox "Bad"
            Else
                  voucherName = .Fields!ctext
            End If
      End With
End Function

Public Function Name2Code(vchName As String) As String
      Dim Rs As New adodb.Recordset
      Dim sQ As String
      sQ = "SELECT * FROM FD_Class WHERE [ctext]='" + vchName + "'"
      With Rs
            .Open sQ, mCn, adOpenForwardOnly, adLockReadOnly, adCmdText
            If .EOF Then
                 MsgBox "Bad"
            Else
                  Name2Code = .Fields!cSign
            End If
      End With
End Function


' 函数 MoveCob： 翻页时，Requery cbo1, 返回 False 时，当前无记录
Public Function MoveCob(Rst As adodb.Recordset, Cbo1 As ComboBox, blnCombo As Boolean) As Boolean
   Dim mStr As String
   Dim i As Integer
   MoveCob = False
   Do While True
''''      Select Case iCredType
''''          Case 1: mStr = "[cCreID]='05" & cbo1.List(cbo1.ListIndex) & "'"
''''          Case 2: mStr = "[cCreID]='06" & cbo1.List(cbo1.ListIndex) & "'"
''''      End Select
      mStr = mIDFldName + " = '06" + Cbo1.List(Cbo1.ListIndex) + "'"
      Rst.Requery
      With Rst
          If .EOF Then
            Exit Function
          Else
            .MoveLast
            .MoveFirst
          End If
          .Find mStr
          If .EOF Then
              If .EOF Then
                  .MoveLast
              End If
              i = Cbo1.ListIndex
              If i = -1 Then
                        Rst.Requery
                  MoveCob = False
                  Exit Function
              End If
              Cbo1.RemoveItem Cbo1.ListIndex
              If i > Cbo1.ListCount - 1 Then i = Cbo1.ListCount - 1
              blnCombo = True
              Cbo1.ListIndex = i
              blnCombo = False
          Else
            Exit Do
          End If
      End With
   Loop
   MoveCob = True
End Function