frmmain.frm

这是一个语音播放程序,对于编程人员很有帮助,使用vb开发的

        
    Set dsb = ds.CreateSoundBuffer(dsd, dscd.fxFormat)
    Exit Sub

errOut:
    MsgBox "Unable to initialize sound card for capture.  Exiting this application", vbOKOnly Or vbCritical
   
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    
    
    dscb.Stop
    dsb.Stop
    If m_notify_dsb <> 0 Then
        dx.DestroyEvent m_notify_dsb
    End If
    If m_notify_dscb <> 0 Then
        dx.DestroyEvent m_notify_dscb
    End If
        DoEvents
    Call CleanUp
     RemoveFromTray
    End
End Sub

Private Sub Form_Unload(Cancel As Integer)
   
End Sub

Private Sub lstPlayers_Click()
    PRI_FROM = eP.GetDPID(lstPlayers.ListIndex + 1)
    
End Sub

Private Sub lstPlayers_DblClick()
    If sound_pri_form <> player_id Then
        SOUND_PRI_FROM = eP.GetDPID(lstPlayers.ListIndex + 1)
        a = dp.GetPlayerFriendlyName(SOUND_PRI_FROM)
        Label1.Caption = "你现在在对" & a & "说话"
    End If
End Sub

Private Sub mnuCreateHost_Click()
    frmCreateHost.Show 1
End Sub

Private Sub mnuExit_Click()
    Call CleanUp
    End
End Sub

Private Sub mnuJoin_Click()
    Call JoinChat
End Sub







Private Sub mnusend_Click()
    If Len(txtMsg.Text) > 1000000 Then
        txtMsg = ""
    End If
    
    If Check1.Value = 0 Then
        txtMsg.Text = txtMsg.Text & vbCrLf & PlayerName & ">" & txtSend.Text
        txtMsg.SelStart = Len(txtMsg.Text & vbCrLf & PlayerName & ">" & txtSend.Text)
        send_msg LOBBY_MSG, txtSend.Text
    ElseIf Check1.Value = 1 Then
        txtMsg.Text = txtMsg.Text & vbCrLf & "**Private**" & PlayerName & ">" & txtSend.Text
        txtMsg.SelStart = Len(txtMsg.Text & vbCrLf & PlayerName & ">" & txtSend.Text)
        send_msg PRIVATE_MSG, txtSend.Text
    End If
    
    
    txtSend.SetFocus
    txtSend.Text = ""
End Sub

Private Sub Timer2_Timer()
    If TheData.hIcon = Image2.Picture Then
        SetTrayIcon Image1.Picture
    Else
        SetTrayIcon Image2.Picture
    End If
End Sub

Private Sub tmrMSG_Timer()
    ''''''' get messages
    
     Call get_msg
End Sub
Private Function WaveEx(Hz As Long, Channels As Integer, BITS As Integer) As WAVEFORMATEX

    WaveEx.nFormatTag = WAVE_FORMAT_PCM
    WaveEx.nChannels = Channels
    WaveEx.lSamplesPerSec = Hz
    WaveEx.nBitsPerSample = BITS
    WaveEx.nBlockAlign = Channels * BITS / 8
    WaveEx.lAvgBytesPerSec = WaveEx.lSamplesPerSec * WaveEx.nBlockAlign
    WaveEx.nSize = 0

End Function
Private Sub InitCapture()
    'set the capture buffer
    dsc.GetCaps cCaps
    
    If cCaps.lFormats And WAVE_FORMAT_2M08 Then
        CaptureWave = WaveEx(11025, 1, 8)
    ElseIf cCaps.lFormats And WAVE_FORMAT_1M08 Then
        CaptureWave = WaveEx(11025, 1, 8)
    Else
        MsgBox "Capture is not supported with your sound card!", vbApplicationModal
        End
    End If
    
    
    dscd.fxFormat = CaptureWave
    dscd.lBufferBytes = Buf_Size
    dscd.lFlags = DSCBCAPS_WAVEMAPPED
    
    
    Set dscb = dsc.CreateCaptureBuffer(dscd)

    
End Sub
Private Sub Command3_Click()
    If Receive_Channel = PRIVATE_SOUND Or (Receive_Channel = PUBLIC_SOUND And Public_Take = True) Then
        setnotify_dsb
        setnotify_dscb
        Command4.Enabled = True
        Command3.Enabled = False
        dscb.start DSCBSTART_DEFAULT
        dsb.Play DSBPLAY_DEFAULT
    ElseIf Receive_Channel = PUBLIC_SOUND And Public_Take = False Then
        On Error Resume Next
        Set dpM = dp.CreateMessage()
    
        dpM.WriteLong PUBLIC_REQUEST
        dp.Send player_id, DPID_ALLPLAYERS, DPSEND_GUARANTEED, dpM
        
        Public_Reply = 0
        Timer1.Enabled = True
        Public_Take = True
        Label1.Caption = "电脑在检查大厅频道是否空，请等5秒"
        Command3.Enabled = False
        
        While Public_Reply <= 5
            DoEvents
        Wend
        Timer1.Enabled = False
        
        
        If Public_Take = False Then
            Label1.Caption = "大厅频道已经被人占用，你只可以听此频道"
            setnotify_dsb
            Command4.Enabled = True
            
            dsb.Play DSBPLAY_DEFAULT
        Else
            Label1.Caption = "你成功的占据了大厅频道，快发表你的宣言吧！"
            setnotify_dsb
            setnotify_dscb
            Command4.Enabled = True
            Command3.Enabled = False
            dscb.start DSCBSTART_DEFAULT
            dsb.Play DSBPLAY_DEFAULT
        End If
    
    End If
End Sub
Private Sub Command4_Click()
        dscb.Stop
        dsb.Stop
        Public_Take = False
    Command4.Enabled = False
    Command3.Enabled = True
End Sub

Private Sub Timer1_Timer()
    Public_Reply = Public_Reply + 1
End Sub
Private Sub Option1_Click()
    Receive_Channel = PUBLIC_SOUND
End Sub

Private Sub Option2_Click()
    Receive_Channel = PRIVATE_SOUND
End Sub
Function setnotify_dsb()
        Dim psa_dsb(1) As DSBPOSITIONNOTIFY
        
        If m_notify_dsb <> 0 Then
            dx.DestroyEvent m_notify_dsb
        End If
        m_notify_dsb = dx.CreateEvent(Me)
        psa_dsb(0).hEventNotify = m_notify_dsb
        psa_dsb(0).lOffset = Buf_Size - 1
        dsb.SetNotificationPositions 1, psa_dsb()

End Function
Function setnotify_dscb()
        
        Dim psa_dscb(1) As DSBPOSITIONNOTIFY
    
        If m_notify_dscb <> 0 Then
            dx.DestroyEvent m_notify_dscb
        End If

        m_notify_dscb = dx.CreateEvent(Me)
        
        psa_dscb(0).hEventNotify = m_notify_dscb
        psa_dscb(0).lOffset = Buf_Size - 1
        dscb.SetNotificationPositions 1, psa_dscb()
   
End Function
Private Sub DirectXEvent_DXCallback(ByVal eventid As Long)
    If eventid = m_notify_dsb Then
        
        dsb.Stop
        
        While dsb_Ready = False
            DoEvents
        Wend
        
        dsb.WriteBuffer 0, Buf_Size, buffer1(0), DSCBLOCK_DEFAULT
        dsb.Play DSBPLAY_DEFAULT
        dsb_Ready = False
    
    ElseIf eventid = m_notify_dscb Then
        ConvertToSBuffer
        dscb.start DSCBSTART_DEFAULT
        On Error Resume Next
        Set dpM = dp.CreateMessage()
    
        dpM.WriteLong SOUND_DATA
    
        If Receive_Channel = PRIVATE_SOUND Then
            dpM.WriteLong PRIVATE_SOUND
        Else
            dpM.WriteLong PUBLIC_SOUND
        End If
        
            For i = 0 To UBound(ByteBuffer) - 1
                dpM.WriteByte ByteBuffer(i)
            Next
        
        If Receive_Channel = PRIVATE_SOUND Then
            dp.Send player_id, SOUND_PRI_FROM, DPSEND_GUARANTEED, dpM
        Else
            
            If Public_Take = True Then
                dp.Send player_id, DPID_ALLPLAYERS, DPSEND_GUARANTEED, dpM
            End If
        End If
    
    End If
    
End Sub
Private Sub ConvertToSBuffer()
    ReDim ByteBuffer(Buf_Size)
    dscb.ReadBuffer 0, Buf_Size, ByteBuffer(0), DSCBLOCK_DEFAULT
End Sub
' Enable the correct tray menu items.
Private Sub Form_Resize()
    Select Case WindowState
        Case vbMinimized
            mnuTrayMaximize.Enabled = True
            mnuTrayMinimize.Enabled = False
            mnuTrayMove.Enabled = False
            mnuTrayRestore.Enabled = True
            mnuTraySize.Enabled = False
        Case vbMaximized
            mnuTrayMaximize.Enabled = False
            mnuTrayMinimize.Enabled = True
            mnuTrayMove.Enabled = False
            mnuTrayRestore.Enabled = True
            mnuTraySize.Enabled = False
        Case vbNormal
            mnuTrayMaximize.Enabled = True
            mnuTrayMinimize.Enabled = True
            mnuTrayMove.Enabled = True
            mnuTrayRestore.Enabled = False
            mnuTraySize.Enabled = True
    End Select

    If WindowState <> vbMinimized Then _
        LastState = WindowState
End Sub
Private Sub mnuFileExit_Click()
    Unload Me
End Sub

Private Sub mnuTrayClose_Click()
    Unload Me
End Sub
Private Sub mnuTrayMaximize_Click()
    WindowState = vbMaximized
End Sub

Private Sub mnuTrayMinimize_Click()
    WindowState = vbMinimized
End Sub

Private Sub mnuTrayMove_Click()
    SendMessage hWnd, WM_SYSCOMMAND, SC_MOVE, 0&
End Sub

Private Sub mnuTrayRestore_Click()
    SendMessage hWnd, WM_SYSCOMMAND, SC_RESTORE, 0&
End Sub

Private Sub mnuTraySize_Click()
    SendMessage hWnd, WM_SYSCOMMAND, SC_SIZE, 0&
End Sub

Private Sub mnuChangeIcon_Click()
    If TheData.hIcon = imgIcon2.Picture Then
        SetTrayIcon imgIcon1.Picture
    Else
        SetTrayIcon imgIcon2.Picture
    End If
End Sub