منتدى فيجوال بيسك لكل العرب | منتدى المبرمجين العرب

(29-07-18, 03:09 PM)alsouf كتب : [ -> ]المثال يعمل بكل نجاح
تاكد من الصوت في جهازك

PHP كود :

Public Class Form1
    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 fr As Integer = 1800 REM الموجة الصوتية
        Dim sd As Integer = 240 REM الاشارة القصيرة
        Dim ld As Integer = sd * 3  REM الاشارة الطويلة
        Dim ret As String = String.Empty
        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
                Console.Beep(fr, sd)
            Else
                Console.Beep(fr, ld)
            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 


نعم عزيزي الصوت يعمل 

انا اضفت عليه خيار السرعه لان في العمل يعتمد على السرعه في الارسال



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

       

لو تلاحظ مثلا اذا كانت سرعه الارسال 18 او 20  يكون الصوت غير واضح ومتقطع

لاحظ الصوت العادي بسرعه 40

الصوت


وهنا صوت البرنامج بنفس السرعه

الصوت


بارك الله فيكم على مجهودكم وربي يبارك في وقتكم

(29-07-18, 11:05 AM)dubai.eig كتب : [ -> ]لو في مجال نقوم بتغيير كود الاستاذ Done الي كتبت في رده فوق 
نقوم بتغييره لمكتبه 
SlimDX

الحمد لله.

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



اولا أضف المكتبة SlimDX التالية[attachment=18967]



ثانيا أضف الكلاس TonePlayer



ثالثا هذا كود الفورم

(29-07-18, 08:19 PM)GameOver كتب : [ -> ]

(29-07-18, 11:05 AM)dubai.eig كتب : [ -> ]لو في مجال نقوم بتغيير كود الاستاذ Done الي كتبت في رده فوق 
نقوم بتغييره لمكتبه 
SlimDX

الحمد لله.

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



اولا أضف المكتبة SlimDX التالية



ثانيا أضف الكلاس 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

ما اعرف كيف اشكرك

بارك الله فيك وكثر الله من امثالك

وتسلم ايدك استاذي

فعلا ضبط الامر مع هذه المكتبه يا سلاااام  شكرا بارك الله فيك


واشكر جميع من شارك وعطاني من وقته في هذا الموضوع اشكركم جميعا 

---

الحمد لله.

لا انسى ان الكود كان من مشاركة الاخ [b]alsouf[/b] فله الفضل بعد الله في تمكني من اكمال الموضوع حسب طلبك

(31-07-18, 07:28 AM)GameOver كتب : [ -> ]لا انسى ان الكود كان من مشاركة الاخ [b]alsouf[/b] فله الفضل بعد الله في تمكني من اكمال الموضوع حسب طلبك

بارك الله فيك وفي الاخ alsouf  

ما قصرتوا 

الحمدلله رب العالمين ......... هذا بفضل الله
تحياتي لكل من ساهم في هذا الموضوع