تقييم الموضوع :
  • 0 أصوات - بمعدل 0
  • 1
  • 2
  • 3
  • 4
  • 5
[VB.NET] استفسار :- بخصوص ارسال Beep
#12
(29-07-18, 11:05 AM)dubai.eig كتب : لو في مجال نقوم بتغيير كود الاستاذ Done الي كتبت في رده فوق 
نقوم بتغييره لمكتبه 
SlimDX


الحمد لله.

تم تنفيذ هذا الطلب



اولا أضف المكتبة SlimDX التالية
.rar   SlimDXLibrary.rar (الحجم : 757.85 ك ب / التحميلات : 27)



ثانيا أضف الكلاس TonePlayer
كود :
Public Class TonePlayer
   Implements IDisposable

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

   Private m_isPlaying As Boolean

   Sub New()
       ' TODO: Complete member initialization
   End Sub

   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 SlimDX.Multimedia.WaveFormat
       Dim format As New SlimDX.Multimedia.WaveFormat
       format.FormatTag = SlimDX.Multimedia.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 SlimDX.XAudio2.XAudio2, ByVal masteringVoice As SlimDX.XAudio2.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 IO.MemoryStream(pcmBytes)
       pcmStream.Seek(0, IO.SeekOrigin.Begin)
       audioBuffer = New SlimDX.XAudio2.AudioBuffer
       audioBuffer.AudioData = pcmStream
       audioBuffer.AudioBytes = pcmBytes.Length
       audioBuffer.Flags = SlimDX.XAudio2.BufferFlags.EndOfStream
       audioBuffer.LoopBegin = 0
       audioBuffer.LoopLength = pcmBytes.Count \ format.BlockAlignment ' = num samples.
       audioBuffer.LoopCount = SlimDX.XAudio2.XAudio2.LoopInfinite
       sourceVoice = New SlimDX.XAudio2.SourceVoice(xaudio2, format)
       sourceVoice.SubmitSourceBuffer(audioBuffer)
   End Sub

   Private Function CreateSineData16Bit(ByVal format As SlimDX.Multimedia.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



ثالثا هذا كود الفورم
كود :
Public Class Form1

   Private octave As Double = 600.0 REM الموجة الصوتية
   Private xaudio2 As New SlimDX.XAudio2.XAudio2
   Private masteringVoice As New SlimDX.XAudio2.MasteringVoice(xaudio2)
   Private tones As New TonePlayer(xaudio2, masteringVoice, octave)

   Private Sub BtnRead_Click(sender As System.Object, e As System.EventArgs) Handles BtnRead.Click
       Dim s As String
       s = CStr(TextBox1.Text).ToLower
       For Each c As Char In s.ToCharArray
           cmorse(c)
       Next
   End Sub

   Function cmorse(c As Char) As String
       Dim sd As Integer = 240 REM الاشارة القصيرة
       Dim ld As Integer = sd * 3  REM الاشارة الطويلة
       Dim ret As String = String.Empty

       sd = 60000 / (NumericUpDown1.Value * 40)
       ld = sd * 3

       Dim codes(,) As String = {
           {" ", " "}, {"a", ".-"}, {"b", "-..."}, {"c", "-.-."}, {"d", "-.."},
           {"e", "."}, {"f", "..-."}, {"g", "--."}, {"h", "...."}, {"i", ".."},
           {"j", ".---"}, {"k", "-.-"}, {"l", ".-.."}, {"m", "--"}, {"n", "-."},
           {"o", "---"}, {"p", ".--."}, {"q", "--.-"}, {"r", ".-."}, {"s", "..."},
           {"t", "-"}, {"u", "..-"}, {"v", "...-"}, {"w", ".--"}, {"x", "-..-"},
           {"y", "-.--"}, {"z", "--.."}, {"1", ".----"}, {"2", "..---"},
           {"3", "...--"}, {"4", "....-"}, {"5", "....."}, {"6", "-...."},
           {"7", "--..."}, {"8", "---.."}, {"9", "----."}, {"0", "-----"},
           {".", ".-.-.-"}, {"?", "..--.."}, {",", "--..--"}, {"'", ".----."},
           {".", ".-.-.-"}, {",", "--..--"}, {"?", "..--.."}, {"/", "-..-."},
           {"=", "-...-"}, {"+", ".-.-."}, {"*", "...-."}}
       For i As Integer = 0 To codes.GetUpperBound(0)
           If codes(i, 0) = c Then ret = codes(i, 1) : Exit For
       Next
       If ret = " " Then
           Threading.Thread.Sleep(ld * 7)
           Return ret
       End If
       For i = 0 To ret.Length - 1
           If ret(i) = "." Then
               tones.Start()
               Threading.Thread.Sleep(sd)
               tones.Stop()
           Else
               tones.Start()
               Threading.Thread.Sleep(ld)
               tones.Stop()
           End If
           If i < ret.Length - 1 Then
               Threading.Thread.Sleep(sd)
           End If
       Next
       Threading.Thread.Sleep(ld)
       Return ret
   End Function



End Class
الرد }}}
تم الشكر بواسطة: 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 - بواسطة GameOver - 29-07-18, 08:19 PM
RE: استفسار :- بخصوص ارسال Beep - بواسطة alsouf - 31-07-18, 07:51 PM
RE: استفسار :- بخصوص ارسال Beep - بواسطة elgokr - 01-08-18, 01:34 AM


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


يقوم بقرائة الموضوع: بالاضافة الى ( 1 ) ضيف كريم