(28-07-18, 08:33 PM)alsouf كتب : شفرة 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
تسلم استاذي الكود شغال تمام
بس اللي اريده مختلف قليل
لو في مجال نقوم بتغيير كود الاستاذ Done الي كتبت في رده فوق
نقوم بتغييره لمكتبه
SlimDX
كود :
Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
Dim s As String = "dubai.eig"
For Each c As Char In s.ToCharArray
cmorse(c)
Next
End Sub
Function cmorse(c As Char) As String
c = c.ToString.ToLower
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(29-07-18, 10:15 AM)GameOver كتب : تأكد من أن صوت الجهاز ليس الصامت Mute
أو أن الصوت منخفض جدا بحيث لا تسمعه
لان كل الحلول الي وضعوها الاخوة في الموضوع تعمل لدي بصوت واضح
نعم صحيح كلامك الاكواد شغاله
بارك الله فيك