المشاركات : 536
المواضيع 182
الإنتساب : Mar 2016
السمعة :
19
الشكر: 652
تم شكره 264 مرات في 171 مشاركات
(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
نعم عزيزي الصوت يعمل
انا اضفت عليه خيار السرعه لان في العمل يعتمد على السرعه في الارسال
كود :
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 = 700 REM الموجة الصوتية
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
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
الصوت
وهنا صوت البرنامج بنفس السرعه
الصوت
بارك الله فيكم على مجهودكم وربي يبارك في وقتكم
المشاركات : 50
المواضيع 0
الإنتساب : Jul 2018
السمعة :
9
الشكر: 0
تم شكره 85 مرات في 42 مشاركات
(29-07-18, 11:05 AM)dubai.eig كتب : لو في مجال نقوم بتغيير كود الاستاذ Done الي كتبت في رده فوق
نقوم بتغييره لمكتبه
SlimDX
الحمد لله.
تم تنفيذ هذا الطلب
اولا أضف المكتبة SlimDX التالية
SlimDXLibrary.rar (الحجم : 757.85 ك ب / التحميلات : 15)
ثانيا أضف الكلاس 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
المشاركات : 536
المواضيع 182
الإنتساب : Mar 2016
السمعة :
19
الشكر: 652
تم شكره 264 مرات في 171 مشاركات
29-07-18, 11:26 PM
(آخر تعديل لهذه المشاركة : 29-07-18, 11:30 PM {2} بواسطة dubai.eig.)
(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
ما اعرف كيف اشكرك
بارك الله فيك وكثر الله من امثالك
وتسلم ايدك استاذي
فعلا ضبط الامر مع هذه المكتبه يا سلاااام شكرا بارك الله فيك
واشكر جميع من شارك وعطاني من وقته في هذا الموضوع اشكركم جميعا
المشاركات : 50
المواضيع 0
الإنتساب : Jul 2018
السمعة :
9
الشكر: 0
تم شكره 85 مرات في 42 مشاركات
المشاركات : 50
المواضيع 0
الإنتساب : Jul 2018
السمعة :
9
الشكر: 0
تم شكره 85 مرات في 42 مشاركات
31-07-18, 07:28 AM
(آخر تعديل لهذه المشاركة : 31-07-18, 07:30 AM {2} بواسطة GameOver.)
لا انسى ان الكود كان من مشاركة الاخ [b]alsouf[/b] فله الفضل بعد الله في تمكني من اكمال الموضوع حسب طلبك
المشاركات : 536
المواضيع 182
الإنتساب : Mar 2016
السمعة :
19
الشكر: 652
تم شكره 264 مرات في 171 مشاركات
(31-07-18, 07:28 AM)GameOver كتب : لا انسى ان الكود كان من مشاركة الاخ [b]alsouf[/b] فله الفضل بعد الله في تمكني من اكمال الموضوع حسب طلبك
بارك الله فيك وفي الاخ alsouf
ما قصرتوا
المشاركات : 191
المواضيع 8
الإنتساب : Feb 2015
السمعة :
8
الشكر: 243
تم شكره 242 مرات في 129 مشاركات
الحمدلله رب العالمين ......... هذا بفضل الله
تحياتي لكل من ساهم في هذا الموضوع
هَٰٓؤُلَآءِ قَوْمُنَا ٱتَّخَذُوا۟ مِن دُونِهِۦٓ ءَالِهَةً لَّوْلَا يَأْتُونَ عَلَيْهِم بِسُلْطَٰنٍۭ بَيِّنٍ فَمَنْ أَظْلَمُ مِمَّنِ ٱفْتَرَىٰ عَلَى ٱللَّهِ كَذِبًا
المشاركات : 3,815
المواضيع 36
الإنتساب : Mar 2014
السمعة :
724
الشكر: 7238
تم شكره 6709 مرات في 3265 مشاركات
احسنتم اخوتى الافضل رداً
فيزيد الله خير الاجر وحقق الله لكم جميعاً
مما تشتهو من خير فى الدنيا والاخرى
وبارك الله لكم فيما تفعلون من علم وخير صالح
تحياتى لكم جميعاً
وتمنياتى للجميع التوفيق
|