clssounddrive.cls

排队分诊管理系统源代码！该代码使用VB6开发环境

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsSoundDrive"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Dim m_tagErrInfo                As TYPE_ERRORINFO      ' 错误信息

Private Type CustSound
    'customer code
    iCustCode                   As Integer
    'windows code
    iWinCode                    As Integer
    'sound time
    iTime                       As Integer
    'sound status; 0 - wait; 1 - Sound Playing; 2 - Sound Played,Removed
    iStatus                     As Byte
End Type

'///////////////////////////////////////////////////////////////////////////////////////////
'/ SoundPlay Function
'///////////////////////////////////////////////////////////////////////////////////////////
'驱动提示声音
Public Function DriveSound(ByVal iWinID As Integer, ByVal iCustID As Integer) As Boolean
    On Error GoTo ERROR_EXIT
    
    '判断传入的参数
    If iCustID < 1 Or iCustID > 9999 Then
        DriveSound = False
        Exit Function
    End If
    If iWinID < 1 Or iWinID > 99 Then
        DriveSound = False
        Exit Function
    End If
    
    '插入客户播音信息到队列中
    If ModifyCustInfo(True, iWinID, iCustID) = False Then GoTo ERROR_EXIT
    
    '播放语音
    If UBound(m_CustInfo) > 0 Then
        PlaySound
    End If
    
    DriveSound = True
    Exit Function
ERROR_EXIT:
    m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
    m_tagErrInfo.strErrFile = "DriveSound"
    m_tagErrInfo.strErrFunc = "clsSoundDrive"
    m_tagErrInfo.nErrNum = Err.Number
    m_tagErrInfo.strErrDesc = Error(Err.Number)
    If Err.Number <> 0 Then Err.Clear
    modErrorInfo.WriteErrLog m_tagErrInfo
    
    DriveSound = False
End Function

Private Sub Class_Initialize()
    On Error Resume Next
    Set mSound = New SoundPlay.clsSound
    '语音设定,是否播放前导音
    mSound.TipSound = my_sound_set.sound_tip_set
    ReDim m_CustInfo(0)
End Sub

Private Sub Class_Terminate()
    On Error Resume Next
    Set mSound = Nothing
End Sub

Private Sub mSound_OpenSound(ByVal bOpen As Boolean)
    On Error Resume Next
    m_bSoundBusy = bOpen
    
    If m_bSoundBusy = False Then
        '修改排队队列,将队列的最前一个移去
        ModifyCustInfo False
        '当结束播音时,判断是否进行下次播音
        If UBound(m_CustInfo) > 0 Then
            PlaySound
        End If
    End If
End Sub

'////////////////////////////////////////////////////////////////////////////////////////////
'修改排队队列, bMode = True 为插入队列, bMode = False 为删除队列
Private Function ModifyCustInfo(Optional ByVal bMode As Boolean = True, _
            Optional ByVal iWindowID As Integer = 0, Optional iCustID As Integer = 0) As Boolean
    On Error GoTo ERROR_EXIT
    Dim iWin As Integer, iCust As Integer, iTime As Integer
    Dim i As Integer, bDel As Boolean
    
    '静止播放语音时退出
    If my_sound_set.sound_use_set = False Then
        ModifyCustInfo = True
        Exit Function
    End If
    
    If bMode = True Then
        '插入队列
        '检查参数信息
        If iCustID < 1 Or iCustID > 9999 Then
            ModifyCustInfo = False
            Exit Function
        End If
        If iWindowID < 1 Or iWindowID > 99 Then
            ModifyCustInfo = False
            Exit Function
        End If
        
        i = UBound(m_CustInfo) + 1
        ReDim Preserve m_CustInfo(i)
        m_CustInfo(i).iCustCode = iCustID
        m_CustInfo(i).iStatus = 0
        m_CustInfo(i).iTime = my_sound_set.sound_time
        m_CustInfo(i).iWinCode = iWindowID
    Else
        '删除队列
        If m_CustInfo(1).iTime <= 1 Then
            bDel = True
        Else
            bDel = False
        End If
        '多次重复播音时将声音放到队列的尾部
        If bDel = False Then
            iWin = m_CustInfo(1).iWinCode
            iCust = m_CustInfo(1).iCustCode
            iTime = m_CustInfo(1).iTime - 1
        End If
        '修改队列
        If UBound(m_CustInfo) = 1 Then
            If bDel = False Then
                m_CustInfo(1).iCustCode = iCust
                m_CustInfo(1).iStatus = 0
                m_CustInfo(1).iTime = iTime
                m_CustInfo(1).iWinCode = iWin
            Else
                ReDim Preserve m_CustInfo(0)
            End If
        ElseIf UBound(m_CustInfo) > 1 Then
            For i = 1 To UBound(m_CustInfo) - 1
                m_CustInfo(i).iCustCode = m_CustInfo(i + 1).iCustCode
                m_CustInfo(i).iStatus = m_CustInfo(i + 1).iStatus
                m_CustInfo(i).iTime = m_CustInfo(i + 1).iTime
                m_CustInfo(i).iWinCode = m_CustInfo(i + 1).iWinCode
            Next i
            
            i = UBound(m_CustInfo)
            
            If bDel = False Then
                m_CustInfo(i).iCustCode = iCust
                m_CustInfo(i).iStatus = 0
                m_CustInfo(i).iTime = iTime
                m_CustInfo(i).iWinCode = iWin
            Else
                ReDim Preserve m_CustInfo(i - 1)
            End If
        End If
    End If
    
    ModifyCustInfo = True
    Exit Function
ERROR_EXIT:
    m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
    m_tagErrInfo.strErrFile = "ModifyCustInfo"
    m_tagErrInfo.strErrFunc = "clsSoundDrive"
    m_tagErrInfo.nErrNum = Err.Number
    m_tagErrInfo.strErrDesc = Error(Err.Number)
    If Err.Number <> 0 Then Err.Clear
    modErrorInfo.WriteErrLog m_tagErrInfo
    
    ModifyCustInfo = False
End Function

'////////////////////////////////////////////////////////////////////////////////////////////
'播放声音
Private Sub PlaySound()
    On Error Resume Next
    If my_sound_set.sound_use_set = False Then Exit Sub
    mSound.CustCode = m_CustInfo(1).iCustCode
    mSound.WindowCode = m_CustInfo(1).iWinCode
    If mSound.InitInfo = True Then Call mSound.SoundPlay
End Sub

Public Property Get SoundBusy() As Boolean
    On Error Resume Next
    SoundBusy = m_bSoundBusy
End Property