nersound.ctl

基于MSCOMM的炉温控制系统上位机程序

VERSION 5.00
Begin VB.UserControl IcMisSound 
   BorderStyle     =   1  'Fixed Single
   ClientHeight    =   2280
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   3330
   InvisibleAtRuntime=   -1  'True
   Picture         =   "NerSound.ctx":0000
   ScaleHeight     =   2280
   ScaleWidth      =   3330
   ToolboxBitmap   =   "NerSound.ctx":0C44
   Begin VB.Timer Timer1 
      Left            =   600
      Top             =   120
   End
End
Attribute VB_Name = "IcMisSound"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Dim TestSndFlag As Boolean '是否属于测试状态
Dim TestIndex As Integer
Dim nSndID As Integer
Dim nEnabled As Boolean
Dim SndFreeFlag As Boolean

'定义事件
Public Event BeginPlaySnd(ByVal SndStr As String, ByVal SndTime As Single)
Public Event EndOfPlay()

'定义属性
'当前音元ID SndID nSndID
'当前音元文本内容 SndTxt
'当前音元起始播放时间 SndBeginTime
'当前音元结束播放时间 SndEndTime
'当前音元起始偏移量 SndBOffset
'当前音元数据长度 SndDataSize
'语音库数据总长度 TotalDataSize
'语音库播放总时间 TotalPlayTime
'语音库数据格式说明 WavFormat （最前是格式整型识别码，空格，字串说明）
'语音库播放数据传输率 PlayRate
'控件占用情况 SndFree
'控件使能 Enabled

'定义属性
'当前音元ID
Public Property Let SndID(Index As Integer)
    nSndID = Index
End Property

Public Property Get SndID() As Integer
    SndID = nSndID
End Property

'当前音元文本内容
Public Property Get SndTxt() As String
    SndTxt = SndElement(nSndID).Text
End Property

'当前音元起始播放时间
Public Property Get SndBeginTime() As Single
    SndBeginTime = SndElement(nSndID).BeginTime
End Property

'当前音元结束播放时间
Public Property Get SndEndTime() As Single
    SndEndTime = SndElement(nSndID).EndTime
End Property

'当前音元起始偏移量
Public Property Get SndBOffset() As Long
    SndBOffset = SndElement(nSndID).BeginOffset
End Property

'当前音元数据长度
Public Property Get SndDataSize() As Long
    SndDataSize = SndElement(nSndID).DataSize
End Property

'语音库数据总长度
Public Property Get TotalDataSize() As Integer
    TotalDataSize = SndTotalBytes
End Property

'语音库播放总时间
Public Property Get TotalPlayTime() As Single
    TotalPlayTime = SndTotalTime
End Property

'语音库数据格式说明
Public Property Get WavFormat() As String
    WavFormat = Wavfmt & "Wav??"
End Property

'语音库播放数据传输率
Public Property Get PlayRate() As Long
    PlayRate = SndDataRate
End Property
'控件占用情况
Public Property Get SndFree() As Boolean
    SndFree = SndFreeFlag
End Property


'控件使能
Public Property Get Enabled() As Boolean
    Enabled = nEnabled
End Property

Public Property Let Enabled(ByVal BooleanVal As Boolean)
    nEnabled = BooleanVal
    Call StopSnd
End Property

'定义方法
Public Sub TestSnd()
    '测试语音元素
    TestSndFlag = True
    SndFreeFlag = False
    TestIndex = UBound(SndElement)
    Call TestSound
End Sub

Public Sub PauseSnd()
    '暂定播放语音队列
    Timer1.Enabled = False
End Sub

Public Sub ContinueSnd()
    '继续播放语音队列
    Timer1.Enabled = True
End Sub

Public Sub StopSnd()
    '停止播放语音
    TestSndFlag = False
    SndFreeFlag = True
    Call EndPlaySound
End Sub

Public Sub PlaySnd(ByVal IDArray As String)
    '允许播放语音
    Dim TmpStrArray() As String
    Dim i%, Index%
    Dim SDataSize As Long
    Dim TmpSnd As SndTable
    
    If Not nEnabled Then Exit Sub '如果消音状态，则退出播放
    If Not SndFreeFlag Then '如果正在播放别的，那么终止播放
        Call EndPlaySound
    End If
    TestSndFlag = False
    SndFreeFlag = False
    TmpStrArray = Split(IDArray, ",")
    SDataSize = SndHeaderSize
    TmpSnd.DataSize = 0
    TmpSnd.BeginOffset = SndHeaderSize
    TmpSnd.BeginTime = 0
    TmpSnd.EndTime = 0
    TmpSnd.Text = ""
    For i = LBound(TmpStrArray) To UBound(TmpStrArray)
        Index = val(TmpStrArray(i))
        TmpSnd.Text = TmpSnd.Text & SndElement(Index).Text '生成播放的语音文本内容
        SDataSize = SDataSize + SndElement(Index).DataSize  '计算需要的内存大小
        ReDim Preserve SndBuffer(0 To SDataSize - 1) '开辟一块内存
        Call CopyMemory(SndBuffer(0), SndRes(0), SndHeaderSize) '制造内存文件头
        Call CopyMemory(SndBuffer(SndHeaderSize - 4), SDataSize - SndHeaderSize, 4) '修改内存文件的语音数据长度
        Call CopyMemory(SndBuffer(SDataSize - SndElement(Index).DataSize), SndRes(SndElement(Index).BeginOffset), SndElement(Index).DataSize)  '取得语音数据
    Next i
    TmpSnd.DataSize = SDataSize - SndHeaderSize '计算合成语音的数据长度
    TmpSnd.EndTime = TmpSnd.DataSize / SndDataRate '计算合成语音的播放时间
    Call sndPlaySound(SndBuffer(0), SND_ASYNC Or SND_NODEFAULT Or SND_MEMORY)  '异步播放内存语音文件
    RaiseEvent BeginPlaySnd(TmpSnd.Text, TmpSnd.EndTime)
    Timer1.Interval = TmpSnd.EndTime * 1000
    Timer1.Enabled = True '播放定时开始，触发时将继续调用本过程
    'Erase SndBuffer '删除此内存文件
End Sub

Public Sub TestSoundByIndex(Index As Integer)
    Dim SDataSize As Long
    If Not nEnabled Then Exit Sub '如果消音状态，则退出播放
    Call SndInitial '重新初始化语音表，便于调试
    SDataSize = SndHeaderSize + SndElement(Index).DataSize '计算需要的内存大小
    ReDim SndBuffer(0 To SDataSize - 1) '开辟一块内存
    Call CopyMemory(SndBuffer(0), SndRes(0), SndHeaderSize) '制造内存文件头
    Call CopyMemory(SndBuffer(SndHeaderSize - 4), SndElement(Index).DataSize, 4) '修改内存文件的语音数据长度
    Call CopyMemory(SndBuffer(SndHeaderSize), SndRes(SndElement(Index).BeginOffset), SndElement(Index).DataSize) '取得语音数据
    Call sndPlaySound(SndBuffer(0), SND_ASYNC Or SND_NODEFAULT Or SND_MEMORY) '异步播放内存语音文件
    Erase SndBuffer '删除此内存文件
End Sub

Private Sub TestSound()
    Dim SDataSize As Long, i As Integer, TmpTime As Single
    If Not nEnabled Then Exit Sub '如果消音状态，则退出播放
    If TestIndex < LBound(SndElement) Then '如果测试完毕，则，退出测试
        TestSndFlag = False
        SndFreeFlag = True
        Timer1.Enabled = False
        Exit Sub
    End If
    SDataSize = SndHeaderSize + SndElement(TestIndex).DataSize '计算需要的内存大小
    ReDim SndBuffer(0 To SDataSize - 1) '开辟一块内存
    Call CopyMemory(SndBuffer(0), SndRes(0), SndHeaderSize) '制造内存文件头
    Call CopyMemory(SndBuffer(SndHeaderSize - 4), SndElement(TestIndex).DataSize, 4) '修改内存文件的语音数据长度
    Call CopyMemory(SndBuffer(SndHeaderSize), SndRes(SndElement(TestIndex).BeginOffset), SndElement(TestIndex).DataSize) '取得语音数据
    Call sndPlaySound(SndBuffer(0), SND_ASYNC Or SND_NODEFAULT Or SND_MEMORY) '异步播放内存语音文件
    TmpTime = (SndElement(TestIndex).EndTime - SndElement(TestIndex).BeginTime)  '+ 500 '根据语音长度设置定时器
    RaiseEvent BeginPlaySnd(SndElement(TestIndex).Text, TmpTime)
    TestIndex = TestIndex - 1
    Timer1.Interval = TmpTime * 1000
    Timer1.Enabled = True '播放定时开始，触发时将继续调用本过程
    Erase SndBuffer '删除此内存文件
End Sub

Private Sub Timer1_Timer()
    '分不同情况定时器调用不同功能模块
    '如果处于测试阶段，则：
    If TestSndFlag Then
        Call TestSound
    Else
        SndFreeFlag = True
        RaiseEvent EndOfPlay
        Timer1.Enabled = False
    End If
End Sub

Private Sub UserControl_Initialize()
    TestSndFlag = False
    SndFreeFlag = True
    nEnabled = True
    Call SndInitial
End Sub

Private Sub UserControl_Resize()
    UserControl.Height = 525
    UserControl.Width = 510
End Sub