CREATION DUN FICHIER.WAV EN VB.NET

'pour votre plaizier un des sub

Private Sub btnSinusStereo8_Click(ByVal sender As System.Object, _
                      ByVal e As System.EventArgs) Handles btnSinusStereo8.Click
  '
  Dim FreqL As Integer = 500   ' frequentie left =gauche
  Dim FreqR As Integer = 800   ' frequentie right = droite
  Dim SRate As Integer = 8000  ' sample frequence
  Dim Tsec As Integer = 1      ' laps de temps
  Dim BitR As Short = 8        ' resolution en  bits
  Dim MS As Short = 2          ' (1=mono, 2=stereo)

  '-----prepare headerfields --------
  F1 = "RIFF"
  F2 = F2                      ' not set yet 
  F3 = F3                      ' already set
  F4 = F4                      ' already set  
  F5 = 16                      ' fmtBlockLength
  F6 = 1                       ' 1=PCM classic, not compressed
  F7 = MS                      ' 1=mono, 2=stereo  
  F8 = SRate                   ' samplingRate(Frequency)
  F9 = MS * SRate * (BitR / 8) ' total number of bytes per sec
  F10 = MS * (BitR / 8)        ' BlockAlign
  F11 = BitR                   ' bits per sample ( resolution )
  F12 = "data"
  F13 = MS * (BitR / 8) * SRate * Tsec  ' dataBlock-length in bytes incl chr(0)
  F2 = F13 + 44 - 8            ' RiffBlock-length

  'Save de header
  FN = Application.StartupPath & "\SinusStereo8.wav"
  If Dir(FN, FileAttribute.Normal) <> "" Then Kill(FN)
  K1 = FreeFile()
  FileOpen(K1, FN, OpenMode.Binary)
  'header schrijven
  FilePut(K1, F1)    '  4 bytes
  FilePut(K1, F2)    '  4 b
  FilePut(K1, F3)    '  4 b
  FilePut(K1, F4)    '  4 b
  FilePut(K1, F5)    '  4 b
  FilePut(K1, F6)    '  2 b
  FilePut(K1, F7)    '  2 b
  FilePut(K1, F8)    '  4 b
  FilePut(K1, F9)    '  4 b
  FilePut(K1, F10)   '  2 b
  FilePut(K1, F11)   '  2 b
  FilePut(K1, F12)   '  4 b
  FilePut(K1, F13)   '  4 b 

  'save  data chunck
  ' 8 bits(= byte  0..255) le sinus = -127 .. +127, transformer en byte 0..255
  ' stereo  
  'taille du dataChunck F13, mais chaque echatillon compte un byte pour chaque canal
  'Je prefer compter en echantillon au lieu de octet.
  i2 = F8 * Tsec
  Dim Bt As Byte
  Const pi = 3.14
  Dim dL As Double = 2 * pi * FreqL / SRate
  Dim dR As Double = 2 * pi * FreqR / SRate
  Dim D1 As Double
  For i1 = 0 To i2 - 1
   D1 = 127 * Math.Sin(i1 * dL)
   Bt = CByte(D1 + 127)
   FilePut(K1, Bt)
   D1 = 127 * Math.Sin(i1 * dR)
   Bt = CByte(D1 + 127)
   FilePut(K1, Bt)
  Next
  FileClose(K1)
  MsgBox(FN & " is gesaved")
 End Sub



 Private Sub btnSilMono16_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnSilMono16.Click
  '
  Dim SRate As Integer = 8000  ' sample frequency
  Dim Tsec As Integer = 1      ' longueur du silence en secondes
  Dim BitR As Short = 16       ' resolution en  bits
  Dim MS As Short = 1          ' (1=mono, 2=stereo)
  Dim Bt As Byte

  '-----prepare headerfields --------
  F1 = "RIFF"
  F2 = F2                      ' not set yet 
  F3 = F3                      ' already set
  F4 = F4                      ' already set  
  F5 = 16                      ' fmtBlockLength
  F6 = 1                       ' 1=PCM classic, not compressed
  F7 = MS                      ' 1=mono, 2=stereo  
  F8 = SRate                   ' samplingRate(Frequency)
  F9 = MS * SRate * (BitR / 8) ' total number of bytes per sec
  F10 = MS * (BitR / 8)        ' BlockAlign
  F11 = BitR                   ' bits per sample ( resolution )
  F12 = "data"
  F13 = MS * (BitR / 8) * SRate * Tsec  ' dataBlock-length in bytes incl chr(0)
  F2 = F13 + 44 - 8            ' RiffBlock-length

  'Save de header
  FN = Application.StartupPath & "\SilStereo16.wav"
  If Dir(FN, FileAttribute.Normal) <> "" Then Kill(FN)
  K1 = FreeFile()
  FileOpen(K1, FN, OpenMode.Binary)
  'header schrijven
  FilePut(K1, F1)    '  4 bytes
  FilePut(K1, F2)    '  4 b
  FilePut(K1, F3)    '  4 b
  FilePut(K1, F4)    '  4 b
  FilePut(K1, F5)    '  4 b
  FilePut(K1, F6)    '  2 b
  FilePut(K1, F7)    '  2 b
  FilePut(K1, F8)    '  4 b
  FilePut(K1, F9)    '  4 b
  FilePut(K1, F10)   '  2 b
  FilePut(K1, F11)   '  2 b
  FilePut(K1, F12)   '  4 b
  FilePut(K1, F13)   '  4 b 

  'save nu de data chunck
  ' mono
  ' 16 bit  (= short -32768 <> +32767)
  ' nombres de short (16 bit) a ecrire = Srate * Tsec  
  i2 = Tsec * SRate
  'voire ici "entete.txt"
  Dim sh As Short ' 2 bytes 
  sh = 0
  For i1 = 0 To i2 - 1
   FilePut(K1, sh)
  Next
  FileClose(K1)
  MsgBox(FN & " is gesaved")
 End Sub