FreeBasic

Простой пример, который показывает как графически отобразить звуковые данные , считанные в реальном времени при проигрывании какого-то звука в системе.

Платформа: Windows
Автор: D.J.Peters

#INCLIB "winmm"

' API section enums and types
Enum WAVE_FORMATS
  WAVE_FORMAT_1M08 =    1
  WAVE_FORMAT_1S08 =    2
  WAVE_FORMAT_1M16 =    4
  WAVE_FORMAT_1S16 =    8
  WAVE_FORMAT_2M08 =   16
  WAVE_FORMAT_2S08 =   32
  WAVE_FORMAT_2M16 =   64
  WAVE_FORMAT_2S16 =  128
  WAVE_FORMAT_4M08 =  256
  WAVE_FORMAT_4S08 =  512
  WAVE_FORMAT_4M16 = 1024
  WAVE_FORMAT_4S16 = 2048
End Enum

Type WAVEFORMATEX Field=1
        wFormatTag       As Short
        nChannels        As Short
        nSamplesPerSec   As Integer
        nAvgBytesPerSec  As Integer
        nBlockAlign      As Short
        wBitsPerSample   As Short
        cbSize           As Short
End Type

Type WAVEINCAPS Field=1
        Mid              As Ushort
        Pid              As Ushort
        DriverVersion    As Integer
        ProductName      As Zstring * 32
        Formats          As WAVE_FORMATS
        nChannels        As Short
        Reserved         As Short
End Type

Enum OPENFLAGS
  CALLBACK_NULL     = &H0      ' no callback (default)
  CALLBACK_TYPEMASK = &H70000  ' callback type mask
  CALLBACK_WINDOW   = &H10000  ' dwCallback is a HWND
  CALLBACK_TASK     = &H20000  ' dwCallback is a HTASK
  CALLBACK_FUNCTION = &H30000  ' dwCallback is a FARPROC

  WAVE_FORMAT_QUERY = &H1
  WAVE_ALLOWSYNC    = &H2
  WAVE_MAPPED       = &H4
  WAVE_FORMAT_DIRECT = &H8
  WAVE_FORMAT_DIRECT_QUERY = &H9 '(WAVE_FORMAT_QUERY Or WAVE_FORMAT_DIRECT)
End Enum

Union WAVEDATA
  lp8   As Ubyte  Ptr
  lp16  As Ushort Ptr
  lpAny As Any   Ptr
End Union
'  flags for Flags field of WAVEHDR
Enum WHDRFLAGS
  WHDR_DONE        = &H01 ' done bit
  WHDR_PREPARED    = &H02 ' set if this header has been prepared
  WHDR_BEGINLOOP   = &H04 ' loop start block
  WHDR_ENDLOOP     = &H08 ' loop end block
  WHDR_INQUEUE     = &H10 ' reserved for driver
  WHDR_VALID       = &H1F ' valid flags  (Internal)
End Enum
Type WAVEHDR Field=1
        lpData           As WAVEDATA
        BufferLength     As Integer
        BytesRecorded    As Integer
        UserData         As Integer
        Flags            As WHDRFLAGS
        Loops            As Integer
        lpNext           As WAVEHDR Ptr
        reserved         As Integer
End Type

Type SMPTETYPE Field = 1
  Hour             As Byte
  min              As Byte 
  sec              As Byte
  frame            As Byte 
  fps              As Byte 
  dummy            As Byte 
  pad(2)           As Byte
End Type  
        
Type MMTIME Field=1
  timeformat As Uinteger 
  Union  
    ms      As Uinteger     
    sample  As Uinteger 
    cb      As Uinteger
    ticks   As Uinteger
    smpte   As SMPTETYPE    
    songptr As Uinteger
  End Union   
End Type   


' API section declares
Declare Function waveInGetNumDevs Alias "waveInGetNumDevs" () As Integer
Declare Function waveInGetDevCaps Alias "waveInGetDevCapsA" ( _
Byval DriverId     As Integer, _
Byval lpCAPS       As WAVEINCAPS Ptr, _
Byval CapsSize     As Integer) As Integer

Declare Function waveInOpen Alias "waveInOpen" ( _
Byval lphDriver    As Integer Ptr, _
Byval DriverId     As Integer, _
Byval lpFormat     As WAVEFORMATEX Ptr, _
Byval Flags        As OPENFLAGS, _
Byval lpCall_HWnd  As Uinteger, _
Byval UserData     As Integer) As Integer

Declare Function waveInClose Alias "waveInClose" ( _
Byval hDriver      As Integer) As Integer

Declare Function waveInPrepareHeader Alias "waveInPrepareHeader" ( _
Byval hDriver      As Integer, _
Byval lpHdr        As WAVEHDR Ptr,_
Byval HdrSize      As Integer) As Integer

Declare Function waveInUnprepareHeader Alias "waveInUnprepareHeader" ( _
Byval hDriver      As Integer, _
Byval lpHdr        As WAVEHDR Ptr, _ 
Byval HdrSize      As Integer) As Integer

Declare Function waveInAddBuffer Alias "waveInAddBuffer" ( _
Byval hDriver      As Integer, _
Byval lpHdr        As WAVEHDR Ptr, _ 
Byval HdrSize      As Integer) As Integer

Declare Function waveInStart Alias "waveInStart" ( _
Byval hDriver      As Integer) As Integer
Declare Function waveInStop  Alias "waveInStop"  ( _
Byval hDriver      As Integer) As Integer
Declare Function waveInReset Alias "waveInReset" ( _
Byval hDriver      As Integer) As Integer

Declare Function waveInGetPosition Alias "waveInGetPosition" ( _
Byval hDriver      As Integer, _
Byval lpTime       As MMTIME Ptr, _
Byval TimeSize     As Integer) As Integer

'declare function waveInGetID alias "waveInGetID" (byval as HWAVEIN, byval as LPUINT) as MMRESULT
'declare function waveInMessage alias "waveInMessage" (byval as HWAVEIN, byval as UINT, byval as DWORD, byval as DWORD) as MMRESULT


' API helper section
Function InitWaveFormatEx( _
  Byref Format     As WAVEFORMATEX, _
  Byval smp_rate   As Integer, _
  Byval smp_bits   As Integer, _
  Byval nChannels  As Integer) As WAVE_FORMATS
  
  If smp_rate < 10026 Then
    smp_rate=10025
  Elseif smp_rate < 22051 Then
    smp_rate=22050
  Elseif smp_rate < 44101 Then
    smp_rate=44100
  Elseif smp_rate > 44100 Then  
    smp_rate=44100
  End If
  
  If smp_bits < 9 Then
    smp_bits=8
  Elseif smp_bits < 16 Then  
    smp_bits=16
  End If  
  
  If nChannels<2 Then
    nChannels=1
  Elseif nChannels>2 Then
    nChannels=2
  End If
    
  With Format
    .wFormatTag       =1  'PCM
          .nChannels        =nChannels
          .nSamplesPerSec   =smp_rate
    .wBitsPerSample   =smp_bits
    .nBlockAlign      =(smp_bits\8) * nChannels
          .nAvgBytesPerSec  =(smp_bits\8) * nChannels * smp_rate
          '.cbSize           =sizeof(WAVEFORMATEX)
  End With
  
  Select Case smp_rate
    Case 10025
      Select Case smp_bits
        Case 8
          Select Case nChannels
            Case 1:Return WAVE_FORMAT_1M08
            Case 2:Return WAVE_FORMAT_1S08
          End Select    
        Case 16
          Select Case nChannels
            Case 1:Return WAVE_FORMAT_1M16
            Case 2:Return WAVE_FORMAT_1S16
          End Select
      End Select  
    Case 22050
      Select Case smp_bits
        Case 8
          Select Case nChannels
            Case 1:Return WAVE_FORMAT_2M08
            Case 2:Return WAVE_FORMAT_2S08
          End Select    
        Case 16
          Select Case nChannels
            Case 1:Return WAVE_FORMAT_2M16
            Case 2:Return WAVE_FORMAT_2S16
          End Select
      End Select  
    Case 44100
      Select Case smp_bits
        Case 8
          Select Case nChannels
            Case 1:Return WAVE_FORMAT_4M08
            Case 2:Return WAVE_FORMAT_4S08
          End Select    
        Case 16
          Select Case nChannels
            Case 1:Return WAVE_FORMAT_4M16
            Case 2:Return WAVE_FORMAT_4S16
          End Select
      End Select  
  End Select  
End Function


'
' main
'

#DEFINE nSamples 512
Dim As MMTIME       Position
Dim As WAVEFORMATEX PCMFormat 
Dim As Integer      nInDrivers,MyFormat

MyFormat=InitWaveFormatEx(PCMFormat,44100,8,1)'change it

nInDrivers=waveInGetNumDevs()
If nInDrivers<1 Then
  Print "ERROR: can't get any record device!"
  Sleep:End 1
End If

Dim As Integer i,Id=-1
Dim As WAVEINCAPS InCaps

'get first device with our format
For i=0 To nInDrivers-1
  waveInGetDevCaps i,@InCaps,Sizeof(WAVEINCAPS)
  If (InCaps.Formats And MyFormat)=MyFormat Then
    Print "i use " & InCaps.ProductName
    Id=i:Exit For
  End If
Next
If Id=-1 Then
  Print "ERROR: no driver with this format aviable!"
  Sleep:End 1
End If

Dim As Integer hDriver
Dim As WAVEHDR RecBuffer(2)
'open the driver with enumarted Id
If waveInOpen ( @hDriver,Id,@PCMFormat,CALLBACK_NULL,0,0)<>0 Then
  Print "ERROR: can't open record driver!"
  Sleep:End 1
End If

'prepare two recoding buffers
For i=0 To 1
  With RecBuffer(i)
    .Flags=0
    .BufferLength=PCMFormat.nBlockAlign*nSamples
    .lpData.lpAny=callocate(.BufferLength)  
  End With  
  If waveInPrepareHeader(hDriver,@RecBuffer(i),Sizeof(WAVEHDR))<>0 Then
    Print "ERROR: can't prepare record buffer(" & Str(i) & ")!"
    Deallocate RecBuffer(0).lpData.lpAny
    Deallocate RecBuffer(1).lpData.lpAny
    waveInClose hDriver
    Sleep:End 1
  End If
  If waveInAddBuffer(hDriver,@RecBuffer(i),Sizeof(WAVEHDR))<>0 Then
    Print "ERROR: can't add record buffer(" & Str(i) & ")!"
    waveInUnPrepareHeader hDriver,@RECBuffer(0),Sizeof(WAVEHDR)
    waveInUnPrepareHeader hDriver,@RECBuffer(1),Sizeof(WAVEHDR)
    Deallocate RecBuffer(0).lpData.lpAny
    Deallocate RecBuffer(1).lpData.lpAny
    waveInClose hDriver
    Sleep:End 1
  End If
Next  

'start recording
If waveInStart(hDriver)<>0 Then
  Print "ERROR: can't start recording!"
  For i=0 To 1
    waveInUnPrepareHeader hDriver,@RECBuffer(i),Sizeof(WAVEHDR)
    Deallocate RecBuffer(i).lpData.lpAny
  Next  
  waveInClose hDriver
  Sleep:End 1
End If

'0 is recording 1=ploting
Dim As Integer record,work=1
Screenres 640,480

While Len(Inkey)=0
  Line(0,0)-Step(nSamples,256),1,BF
  Pset (0,128),2
  For i=0 To nSamples-2
    Line -(i,RecBuffer(work).lpData.lp8[i]),2 'lp16[i]*scale
  Next  
  While (RecBuffer(record).Flags And WHDR_Done)=0
    Sleep 1
  Wend
  RecBuffer(record).Flags=WHDR_PREPARED
  Swap record,work
  If waveInAddBuffer(hDriver,@RecBuffer(record),Sizeof(WAVEHDR))<>0 Then
    Print "ERROR: can't add record buffer!"
  End If  
Wend

If hDriver<>0 Then
  waveInStop  hDriver
  For i=0 To 1
    waveInUnPrepareHeader hDriver,@RECBuffer(i),Sizeof(WAVEHDR)
    Deallocate RecBuffer(i).lpData.lpAny
  Next
  waveInClose hDriver
End If