تقييم الموضوع :
  • 0 أصوات - بمعدل 0
  • 1
  • 2
  • 3
  • 4
  • 5
[VB.NET] استفسار :- بخصوص ارسال Beep
#7
شفرة vb.net
انسخ الشفرة التالية لكلاس التطبيقform1
كود :
Option Strict On
Option Explicit On
Imports SlimDX
Imports SlimDX.XAudio2
Imports SlimDX.Multimedia
Public Class Form1
    Private Const numTones As Integer = 7
    Private Shared s_rand As New Random
    Private xaudio2 As XAudio2
    Private masteringVoice As MasteringVoice
    Private tones(numTones - 1) As TonePlayer
    Private octave() As Double = {220.0, 246.94, 261.63, 293.66, 329.63, 349.23, 392.0}
    Sub New()
        ' This call is required by the Windows Form Designer.
        InitializeComponent()
        ' Add any initialization after the InitializeComponent() call.
        xaudio2 = New XAudio2
        masteringVoice = New MasteringVoice(xaudio2)
        For i As Integer = 0 To numTones - 1
            Dim cb As New CheckBox With {.Left = 5, .Top = 5 + (i * 30)}
            cb.Tag = i
            cb.Text = octave(i).ToString("n2")
            Me.Controls.Add(cb)
            AddHandler cb.CheckedChanged, AddressOf Check_Changed
            tones(i) = New TonePlayer(xaudio2, masteringVoice, octave(i))
        Next
    End Sub

    Private Sub Form1_FormClosing(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
        For Each tone As TonePlayer In tones
            tone.Dispose()
        Next
        If masteringVoice IsNot Nothing Then masteringVoice.Dispose()
        If xaudio2 IsNot Nothing Then xaudio2.Dispose()
    End Sub

    Private Sub Check_Changed(ByVal sender As Object, ByVal e As EventArgs)
        Dim cb As CheckBox = DirectCast(sender, CheckBox)
        Dim index As Integer = DirectCast(cb.Tag, Integer)
        Dim tone As TonePlayer = tones(index)
        If cb.Checked Then
            tone.Start()
        Else
            tone.Stop()
        End If
    End Sub
End Class

-----------------------------------------------------
اضف كلاس جديد للمشروع و انسخ الشفرة التالية:
كود :
Imports SlimDX
Imports SlimDX.XAudio2
Imports SlimDX.Multimedia
Imports System.IO

Public Class TonePlayer
    Implements IDisposable

    Const twoPi As Double = Math.PI * 2
    Private xaudio2 As XAudio2
    Private masteringVoice As MasteringVoice
    Private pcmStream As MemoryStream
    Private audioBuffer As AudioBuffer
    Private sourceVoice As SourceVoice
    Private Shared format As WaveFormat

    Private m_isPlaying As Boolean
    Public ReadOnly Property IsPlaying() As Boolean
        Get
            Return m_isPlaying
        End Get
    End Property

    Shared Sub New()
        format = CreateWaveFormat(44100, 1, 16) ' 44.1k samples per second, mono, 16 bits per sample.
    End Sub

    Private Shared Function CreateWaveFormat(ByVal samplesPerSecond As Integer, ByVal channels As Short, ByVal bitsPerSample As Short) As WaveFormat
        Dim format As New WaveFormat
        format.FormatTag = WaveFormatTag.Pcm
        format.BitsPerSample = bitsPerSample
        format.Channels = channels
        format.SamplesPerSecond = samplesPerSecond
        format.BlockAlignment = format.Channels * format.BitsPerSample \ 8S
        format.AverageBytesPerSecond = format.SamplesPerSecond * format.BlockAlignment
        Return format
    End Function

    Public Sub New(ByVal xaudio2 As XAudio2, ByVal masteringVoice As MasteringVoice, ByVal frequency As Double)
        Me.xaudio2 = xaudio2
        Me.masteringVoice = masteringVoice
        InitializeSourceVoice(frequency)
    End Sub

    Private Sub InitializeSourceVoice(ByVal frequency As Double)
        Dim pcmBytes() As Byte = CreateSineData16Bit(format, frequency)
        pcmStream = New MemoryStream(pcmBytes)
        pcmStream.Seek(0, SeekOrigin.Begin)
        audioBuffer = New AudioBuffer
        audioBuffer.AudioData = pcmStream
        audioBuffer.AudioBytes = pcmBytes.Length
        audioBuffer.Flags = BufferFlags.EndOfStream
        audioBuffer.LoopBegin = 0
        audioBuffer.LoopLength = pcmBytes.Count \ format.BlockAlignment ' = num samples.
        audioBuffer.LoopCount = xaudio2.LoopInfinite
        sourceVoice = New SourceVoice(xaudio2, format)
        sourceVoice.SubmitSourceBuffer(audioBuffer)
    End Sub

    Private Function CreateSineData16Bit(ByVal format As WaveFormat, ByVal frequency As Double) As Byte()
        Dim samplesPerCycle As Integer = format.SamplesPerSecond \ frequency
        Dim buffer(format.BlockAlignment * samplesPerCycle - 1) As Byte ' 1 sine wave cycle only! might be too small
        Dim theta As Double = 0
        Dim thetaStep As Double = (frequency * twoPi) / format.SamplesPerSecond
        For i As Integer = 0 To buffer.Length - 1 Step format.BlockAlignment
            Dim value As Short = CType(Short.MaxValue * Math.Sin(theta), Short)
            theta += thetaStep
            Dim bytes() As Byte = BitConverter.GetBytes(value)
            For channel As Integer = 0 To format.Channels - 1
                System.Buffer.BlockCopy(bytes, 0, buffer, (channel * 2) + i, bytes.Count)
            Next
        Next
        Return buffer
    End Function

    Public Sub Start()
        If IsPlaying Then Exit Sub
        sourceVoice.Start()
        m_isPlaying = True
    End Sub

    Public Sub [Stop]()
        If IsPlaying = False Then Exit Sub
        sourceVoice.Stop()
        m_isPlaying = False
    End Sub

    Private disposedValue As Boolean = False        ' To detect redundant calls

    ' IDisposable
    Protected Overridable Sub Dispose(ByVal disposing As Boolean)
        If Not Me.disposedValue Then
            If disposing Then
                ' TODO: free other state (managed objects).
                If sourceVoice IsNot Nothing Then sourceVoice.Dispose()
                If audioBuffer IsNot Nothing Then audioBuffer.Dispose()
                If pcmStream IsNot Nothing Then pcmStream.Dispose()
            End If

            ' TODO: free your own state (unmanaged objects).
            ' TODO: set large fields to null.
        End If
        Me.disposedValue = True
    End Sub

#Region " IDisposable Support "
    ' This code added by Visual Basic to correctly implement the disposable pattern.
    Public Sub Dispose() Implements IDisposable.Dispose
        ' Do not change this code.  Put cleanup code in Dispose(ByVal disposing As Boolean) above.
        Dispose(True)
        GC.SuppressFinalize(Me)
    End Sub
#End Region
End Class

سمي الكلاس المضاف
Toneplayer

---------------------------------------
اضف ملف مكتبة الربط الدينامكي
Imports SlimDX
-------------------------------
تجده في المرفقات

ثبت حزمة
diretx
تجدها هنا
http://www.mediafire.com/file/jbf8f407qs...9.msi/file


الملفات المرفقة
.zip   slimdx.zip (الحجم : 988.07 ك ب / التحميلات : 15)
هَٰٓؤُلَآءِ قَوْمُنَا ٱتَّخَذُوا۟ مِن دُونِهِۦٓ ءَالِهَةً لَّوْلَا يَأْتُونَ عَلَيْهِم بِسُلْطَٰنٍۭ بَيِّنٍ فَمَنْ أَظْلَمُ مِمَّنِ ٱفْتَرَىٰ عَلَى ٱللَّهِ كَذِبًا
الرد }}}
تم الشكر بواسطة: dubai.eig , elgokr


الردود في هذا الموضوع
استفسار :- بخصوص ارسال Beep - بواسطة dubai.eig - 26-07-18, 01:10 PM
RE: استفسار :- بخصوص ارسال Beep - بواسطة Done - 26-07-18, 07:10 PM
RE: استفسار :- بخصوص ارسال Beep - بواسطة elgokr - 27-07-18, 04:28 AM
RE: استفسار :- بخصوص ارسال Beep - بواسطة alsouf - 28-07-18, 08:33 PM
RE: استفسار :- بخصوص ارسال Beep - بواسطة alsouf - 29-07-18, 03:09 PM
RE: استفسار :- بخصوص ارسال Beep - بواسطة alsouf - 31-07-18, 07:51 PM
RE: استفسار :- بخصوص ارسال Beep - بواسطة elgokr - 01-08-18, 01:34 AM


التنقل السريع :


يقوم بقرائة الموضوع: