home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 6_2008-2009.ISO / data / zips / Wave_Gener2149494112009.psc / Demo / WG_Player.cls < prev   
Text File  |  2009-04-11  |  3KB  |  104 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "Player"
  6. Attribute VB_GlobalNameSpace = False
  7. Attribute VB_Creatable = True
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = False
  10. Option Explicit
  11. ' Sound player
  12. ' This player is hard coded to build a buffer for 4 seconds of
  13. ' 8-bit stereo sound, sampled at a rate of 11025 samples per second.
  14. ' *.WAV files have header bytes and data bytes, because the buffer
  15. ' is always a constant size, the header can be initialized once
  16. ' (in Class_Initialize) with only the data being adjusted by the
  17. ' program.
  18.  
  19. Private Declare Function Play Lib "winmm.dll" _
  20.         Alias "PlaySoundA" _
  21.         (ByVal lpSound As Long, ByVal hModule As Long, _
  22.         ByVal dwFlags As Long) As Long
  23.  
  24. Private Const SND_ASYNC As Long = &H1
  25. Private Const SND_NODEFAULT As Long = &H2
  26. Private Const SND_MEMORY As Long = &H4
  27.  
  28. Private Type MYWAVEFORMAT
  29.    RIFFTag As String * 2
  30.    FileSize As Long
  31.    WAVETag As String * 2
  32.    fmtTag As String * 2
  33.    HeaderLength As Long
  34.    Compresssion As Integer
  35.    Channels As Integer
  36.    SamplesPerSec As Long
  37.    BytesPerSec As Long
  38.    BlockAlign As Integer
  39.    BitsPerSample As Integer
  40.    DATATag As String * 2
  41.    DataLength As Long
  42. End Type
  43. Private Type MYWAVEHEADER
  44.    Data(1 To 44) As Byte
  45. End Type
  46.  
  47. Private Wave(1 To 880200) As Byte
  48.  
  49. Private SND As MYWAVEFORMAT
  50.  
  51. Public Sub PlaySound()
  52.    ' Save wave to disk
  53. '  Open "C:\Temp\MyWave.wav" For Binary As 1
  54. '  Put #1, 1, Wave
  55. '  Close 1
  56.   Play VarPtr(Wave(1)), 0, SND_MEMORY Or SND_ASYNC Or SND_NODEFAULT
  57. End Sub
  58.  
  59. Public Sub StopSound()
  60.   Play 0, 0, 0
  61. End Sub
  62.  
  63. Public Sub ClearData()
  64. Dim i As Long
  65.   ' 1 to 44 are header bytes, 45 to end are data bytes
  66.   For i = 45 To 880200
  67.     Wave(i) = 128
  68.   Next
  69. End Sub
  70.  
  71. Public Property Let Data(ByVal Index As Long, ByVal RHS As Byte)
  72.  ' Avoid overwriting header
  73.  If (Index >= 0) And (Index < 880150) Then
  74.     Wave(Index + 45) = RHS
  75.  End If
  76. End Property
  77.  
  78. Private Sub Class_Initialize()
  79. Dim hdr As MYWAVEHEADER
  80. Dim idx As Long
  81.   ' See top of code module
  82.   With SND
  83.     .RIFFTag = StrConv("RIFF", vbFromUnicode)
  84.     .FileSize = 880192
  85.     .WAVETag = StrConv("WAVE", vbFromUnicode)
  86.     .fmtTag = StrConv("fmt ", vbFromUnicode)
  87.     .HeaderLength = 16
  88.     .Compresssion = 1
  89.     .Channels = 2
  90.     .SamplesPerSec = 110025
  91.     .BytesPerSec = 220050
  92.     .BlockAlign = 2
  93.     .BitsPerSample = 8
  94.     .DATATag = StrConv("data", vbFromUnicode)
  95.     .DataLength = 880156
  96.   End With
  97.   ' Move header to byte array
  98.   LSet hdr = SND
  99.   ' Move header bytes to buffer
  100.   For idx = 1 To 44
  101.     Wave(idx) = hdr.Data(idx)
  102.   Next
  103. End Sub
  104.