$TYPECHECK ON
' Author: David Burkley
'   Date: November of 2019
'
' This source code produces a visual representation of the
'  Pitch and Volume (aka Frequency and Amplitude respectively)
'  levels from an audio input device (e.g. a microphone).
'   footnote: humans can hear 20Hz to 20000Hz pitch/frequency
'
' The visual representation looks like an Oscilloscope displaying a waveform.
'  The higher or lower the wave is... the louder or softer the Volume is.
'  The closer or further away EACH wave is... the higher or lower the Pitch is.
'  If the waveform displays virtually straight across the middle
'   (along the yellow line) it means silence (or close to silence).
'
' When compiled and run on a Windows 7 64-bit computer
'  the display is flawless (BUT... uses a lot of CPU).
'  (see the commented out code, at the bottom of the FFTAudio sub)
'
' When compiled and run on a Windows Vista 32-bit computer
'  the display is "almost" flawless (BUT... uses a lot of CPU).
'
' When compiled and run on a Windows XP 32-bit computer
'  the display is just plain ugly (those old 32-bit DLLs are to blame?).
'
' Your system's "Sound" settings (for recording, NOT playback)
'  AND your microphone (and it's location) play a HUGE part in
'  what the displayed waveform looks like in the oscilloscope.
'
' This source code is hard-coded for "WAVE_FORMAT_1M16"
'  If you need to change this (for a VERY unusual circumstance)
'   you'll need to make adjustments in the...
'   Form_OnShow AND StartButton_OnClick subroutines.
'  But stick with one of the Mono 16-bit formats.
'   (only minor rewriting may need to be done)
'  Changing to ANY 8-bit format or ANY Stereo 8 or 16-bit format
'   means rewriting/adding a lot of code.
'
' Ideally... I should have written this source code to use 2 buffers.
'  To do this I would have launched a "separate thread" that does NOTHING
'  but write to 1 of the 2 buffers and signal that THAT is buffer ready.
'  (then immediately start writing to the other buffer)
'  (switching back and forth between the 2 buffers)
'  (the signal would be WHICH buffer is ready)
'  This "main thread" would then read and process THAT readied buffer and
'  wait for the separate thread to send a new signal.
'  Surprisingly... the reading and processing only take a fraction of a second.
'  Compared to... writing to a buffer may take a full second.
'  Doing it this way would give a VERY fluid waveform.
' As it's written below... the writing to the buffer part has to wait
'  for the reading and processing part to finish. Grant it... it's only
'  a fraction of a second, but it's losing that fraction of a second of fluidness.
'  The reason I wrote it this way was... because I wanted to keep it simple
'  and let you understand the basics. If you want to try the 2 buffer idea
' 
'
' To use...
'  1) Select an audio input Device from the combobox
'     (if you do NOT have one... you'll be informed)
'     (if you do have one (or more)... you might need to
'      plug in a "microphone-type" device before using)
'  2) Click the Start button
'     (if the peak levels are too low and(/or) too high...
'      use the scrollbar to Scale the waveform up or down)
'  3) Click the Stop button
'     (this will stop any inputting from the device
'      and you can select another device, if need be)
'
' What can this source code be used for?
'  Amusement?!?! (LOL... just kidding)
'  One thought that occured to me was...
'   if the peak levels are either higher/lower than a specified level...
'   a security cam can start recording and stop when things return to normal.
'  Another thought...
'   when saving audio input to a file...
'   you can adjust the volume up or down BEFORE writing it to the file.
'  Another thought, either...
'   a) adjust your system setting for audio recording, to optimally match
'      your audio input device's distance from the audio source.
'   b) to know whether or not you need to move your audio input device
'      further away or closer.
'  If you're feeling REAL ambitious...
'   you could add a gazillion more lines of coding and use it for voice recognition.
'   But be aware... background noise is extremely difficult to filter out.
'   (background noise is rarely (if ever) "exactly" the same each time)
'
' Well enough idle chit-chat. Enjoy!


$Option EXPLICIT
$Include "RapidQ.inc"

Type WAVEFORMATEX
    FormatTag      As Word
    Channels       As Word
    SamplesPerSec  As Long
    AvgBytesPerSec As Long
    BlockAlign     As Word
    BitsPerSample  As Word
    ExtraDataSize  As Word
End Type

Type WAVEHDR
    lpData          As Long
    dwBufferLength  As Long
    dwBytesRecorded As Long
    dwUser          As Long
    dwFlags         As Long
    dwLoops         As Long
    lpNext          As Long
    Reserved        As Long
End Type

Type WAVEINCAPS
    ManufacturerID As Word
    ProductID      As Word
    DriverVersion  As Long
    ProductName    As String * 32
    Formats        As Long
    Channels       As Word
    Reserved       As Word
End Type

Const MMSYSERR_NOERROR = &H0

Const WAVE_INVALIDFORMAT = &H0   ' invalid format
Const WAVE_FORMAT_1M08   = &H1   ' 11.025 kHz, Mono,   8-bit
Const WAVE_FORMAT_1S08   = &H2   ' 11.025 kHz, Stereo, 8-bit
Const WAVE_FORMAT_1M16   = &H4   ' 11.025 kHz, Mono,   16-bit
Const WAVE_FORMAT_1S16   = &H8   ' 11.025 kHz, Stereo, 16-bit
Const WAVE_FORMAT_2M08   = &H10  ' 22.05  kHz, Mono,   8-bit
Const WAVE_FORMAT_2S08   = &H20  ' 22.05  kHz, Stereo, 8-bit
Const WAVE_FORMAT_2M16   = &H40  ' 22.05  kHz, Mono,   16-bit
Const WAVE_FORMAT_2S16   = &H80  ' 22.05  kHz, Stereo, 16-bit
Const WAVE_FORMAT_4M08   = &H100 ' 44.1   kHz, Mono,   8-bit
Const WAVE_FORMAT_4S08   = &H200 ' 44.1   kHz, Stereo, 8-bit
Const WAVE_FORMAT_4M16   = &H400 ' 44.1   kHz, Mono,   16-bit
Const WAVE_FORMAT_4S16   = &H800 ' 44.1   kHz, Stereo, 16-bit

Const WAVE_FORMAT_PCM = 1

Const WHDR_DONE = &H1  '/* done bit */

Declare Function waveInGetNumDevs Lib "winmm.dll" Alias "waveInGetNumDevs" _
                 () As Long

Declare Function waveInGetDevCaps Lib "winmm.dll" Alias "waveInGetDevCapsA" _
                 (ByVal uDeviceID As Long, ByRef lpCaps As WAVEINCAPS, ByVal uSize As Long) As Long

Declare Function waveInOpen Lib "winmm.dll" Alias "waveInOpen" _
                 (ByVal lphWaveIn As Long, ByVal uDeviceID As Long, ByRef lpFormat As WAVEFORMATEX, _
                  ByVal dwCallback As Long, ByVal dwInstance As Long, ByVal dwFlags As Long) As Long

Declare Function waveInStart Lib "winmm.dll" Alias "waveInStart" _
                 (ByVal hWaveIn As Long) As Long

Declare Function waveInPrepareHeader Lib "winmm.dll" Alias "waveInPrepareHeader" _
                 (ByVal hWaveIn As Long, ByRef lpWaveInHdr As WAVEHDR, ByVal uSize As Long) As Long

Declare Function waveInAddBuffer Lib "winmm.dll" Alias "waveInAddBuffer" _
                 (ByVal hWaveIn As Long, ByRef lpWaveInHdr As WAVEHDR, ByVal uSize As Long) As Long

Declare Function waveInUnprepareHeader Lib "winmm.dll" Alias "waveInUnprepareHeader" _
                 (ByVal hWaveIn As Long, ByRef lpWaveInHdr As WAVEHDR, ByVal uSize As Long) As Long

Declare Function waveInReset Lib "winmm.dll" Alias "waveInReset" _
                 (ByVal hWaveIn As Long) As Long

Declare Function waveInClose Lib "winmm.dll" Alias "waveInClose" _
                 (ByVal hWaveIn As Long) As Long

Declare Sub Form_OnShow
Declare Sub Form_OnClose
Declare Sub Scope_OnPaint
Declare Sub Slider_OnChange
Declare Sub DevicesBox_OnChange
Declare Sub StartButton_OnClick
Declare Sub StopButton_OnClick

Declare Sub FFTAudio

Dim WaveFormat As WAVEFORMATEX
Dim WaveHeader As WAVEHDR
Dim Caps       As WAVEINCAPS

' as the name implies...
' a buffer to hold audio data
' that will be converted to
' a visual representation
'  Why 256 elements in size???
'   Because that's the width of the Scope.
'  Why a Short data type???
'   RapidQ Shorts are 2 bytes (16-bits)
'    and range from -32768 to 32767
Dim Buffer(256) As Short

' saves time because hitting up these
' variables is faster than other way
' (speed IS a factor in this kind of program)
' they are used "repeatedly" in this program
Dim CenterLine  As Long
Dim ScaleFactor As Long
Dim ScopeWidth  As Long
Dim ScopeHeight As Long
Dim DevHandle   As Long
Dim DeviceID    As Long
Dim WaveHdrSize As Long
Dim BufferSize  As Long

' used while developing
' (you could replace "lRet =" with "Call")
Dim lRet As Long

' used for drawing the waveform
' on a bitmap (defined below)
Dim x  As Long
Dim xx As Long
Dim y  As Long
Dim yy As Long

' used only in Form_OnShow
' (could be local instead of global)
Dim i As Long
Dim n As Long

' just some necessary flags
Dim v As Byte
Dim z As Byte

' take the data from the buffer (defined above)
' draw that data to a bitmap
' display the bitmap
' (repeat until the user clicks the Stop button)
Dim ScopeBuffer As QBitmap

Dim LabelFont As QFont
    LabelFont.Name = "Arial"
    LabelFont.Size = 9
    LabelFont.Bold = True
    LabelFont.Color = RGB(000,000,000)

Dim ButtonFont As QFont
    ButtonFont.Name = "Arial"
    ButtonFont.Size = 10
    ButtonFont.Bold = True
    ButtonFont.Color = RGB(000,000,000)

Create Form As QForm
  BorderStyle = bsDialog
  Width       = 292
  Height      = 462
  Left        = (Screen.Width \ 2) - (Form.Width \ 2)
  Top         = (Screen.Height \ 2) - (Form.Height \ 2)
  Caption     = " Audio Input Oscilloscope"
  OnShow      = Form_OnShow
  OnClose     = Form_OnClose
  Create DevicesLabel As QLabel
    AutoSize  = False
    Left      = 15
    Top       = 15
    Width     = (Form.ClientWidth - (DevicesLabel.Left * 2))
    Height    = 20
    Font      = LabelFont
    Caption   = "Available Input Devices"
  End Create
  Create DevicesBox As QComboBox
    TabOrder  = 0
    Style     = csDropDownList
    Left      = 15
    Top       = 34
    Width     = (Form.ClientWidth - (DevicesBox.Left * 2))
    Height    = 24
    Font.Size = 10
    Enabled   = False
    OnChange  = DevicesBox_OnChange
  End Create
  Create SliderLabel As QLabel
    AutoSize  = False
    Left      = 15
    Top       = 69
    Width     = (Form.ClientWidth - (SliderLabel.Left * 2))
    Height    = 20
    Font      = LabelFont
    Caption = "Scope Scale Factor"
  End Create
  Create Slider As QScrollBar
    TabOrder  = 3
    Left      = 15
    Top       = 90
    Width     = (Form.ClientWidth - (Slider.Left * 2))
    Height    = 19
    Min       = 0
    Max       = 49
    Position  = 25
    ShowHint  = True
    OnChange  = Slider_OnChange
  End Create
  Create StartButton As QButton
    TabOrder  = 1
    Left      = 15
    Top       = 125
    Width     = 120
    Height    = 25
    Font      = ButtonFont
    Caption   = "Start"
    Enabled   = False
    OnClick   = StartButton_OnClick
  End Create
  Create StopButton As QButton
    TabOrder  = 2
    Left      = (Form.ClientWidth \ 2) + 8
    Top       = 125
    Width     = 120
    Height    = 25
    Font      = ButtonFont
    Caption   = "Stop"
    Enabled   = False
    OnClick   = StopButton_OnClick
  End Create
  Create Scope As QCanvas
    Left      = 15
    Top       = 165
    Width     = 256 'NOTE: Width is the same as, the number of elements in the Buffer array
    Height    = 256
    OnPaint   = Scope_OnPaint
  End Create
End Create

Form.ShowModal

Sub Form_OnShow
    Slider_OnChange 'Need to initialize ScaleFactor variable
    
    ScopeWidth  = Scope.Width
    ScopeHeight = Scope.Height
    
    CenterLine  = (ScopeHeight / 2) - 1
    
    ScopeBuffer.Width  = ScopeWidth
    ScopeBuffer.Height = ScopeHeight
    
    ScopeBuffer.FillRect(0, 0, ScopeWidth, ScopeHeight, RGB(000,000,000))
    ScopeBuffer.Line(0, CenterLine, ScopeWidth, CenterLine, RGB(255,255,000))
    
    n = waveInGetNumDevs()
    
    If (n > 0) Then
      For i = 0 To (n - 1)
        lRet = waveInGetDevCaps(i, Caps, SizeOf(Caps))
        If Caps.Formats And WAVE_FORMAT_1M16 Then
          DevicesBox.AddItems(Rtrim$(Caps.ProductName))
        End If
      Next i
      If (DevicesBox.ItemCount > 0) Then
        DevicesBox.ItemIndex = 0
        DevicesBox.Enabled   = True
        StartButton.Enabled  = True
        Slider.Enabled       = True
        WaveHdrSize          = SizeOf(WaveHeader)
        BufferSize           = UBound(Buffer) * 2
      Else
        ShowMessage("          Message from Audio Input Oscilloscope" & Chr$(10) & _
                    "No Audio Input Devices found, support 16-bit Mono.")
      End If
    Else
      ShowMessage("Message from Audio Input Oscilloscope" & Chr$(10) & _
                  "       No Audio Input Devices Found!")
    End If
    z = True
End Sub

Sub Form_OnClose
    If (DevHandle <> 0) Or (v = True) Then
      StopButton_OnClick
    End If
    
    Application.Terminate
End Sub

Sub Form_OnResize
    If (z = True) Then
      Scope_OnPaint
      z = False
    End If
End Sub

Sub Scope_OnPaint
    ' Only using this sub to display the canvas (aka Scope) at start up.
    ' Using it otherwise seems to cause occasional flickering.
    ' The actual repeated drawing of the bitmap is done in the FFTAudio subroutine.
    If (z = True) Then Scope.Draw(0,0,ScopeBuffer.Bmp)
End Sub

Sub Slider_OnChange
    ScaleFactor = Slider.Position + 1
    Slider.Hint = "Scaled: "+Format$("%.2d", Slider.Position)+"%"
End Sub

Sub DevicesBox_OnChange
    DeviceID = DevicesBox.ItemIndex
End Sub

Sub StartButton_OnClick
    DevHandle = 0
    
    With WaveFormat
      .FormatTag      = WAVE_FORMAT_PCM
      .Channels       = 1
      .SamplesPerSec  = 11025
      .BitsPerSample  = 16
      .BlockAlign     = (.Channels * .BitsPerSample) \ 8
      .AvgBytesPerSec = .BlockAlign * .SamplesPerSec
      .ExtraDataSize  = 0
    End With
    
    lRet = waveInOpen(VarPtr(DevHandle), DeviceID, WaveFormat, 0, 0, 0)
    
    If (DevHandle <> 0) Then
      lRet = waveInStart(DevHandle)
      StopButton.Enabled  = True
      StartButton.Enabled = False
      DevicesBox.Enabled  = False
      FFTAudio
    Else
      ShowMessage("Selected device might" & Chr$(10) & _
                  "   already be in use.")
    End If
End Sub

Sub StopButton_OnClick
    lRet = waveInReset(DevHandle)
    lRet = waveInClose(DevHandle)
    
    DevHandle = 0
    
    StopButton.Enabled  = False
    StartButton.Enabled = True
    DevicesBox.Enabled  = True
End Sub

Sub FFTAudio
    v = True
    
    With WaveHeader
      .lpData = VarPtr(Buffer(0)) 'As long as YOU do not write code to change the array... it's memory location won't change
      .dwBufferLength = BufferSize
      .dwFlags = 0
    End With
    
V1: lRet = waveInPrepareHeader(DevHandle, WaveHeader, WaveHdrSize)
    lRet = waveInAddBuffer(DevHandle, WaveHeader, WaveHdrSize)
    
    Do
    Loop Until ((WaveHeader.dwFlags And WHDR_DONE) = WHDR_DONE) Or (DevHandle = 0)
    
    DoEvents 'Need to capture if the Stop button was clicked or Slider scrollbar has changed
    
    If DevHandle = 0 Then Goto V2
    
    lRet = waveInUnprepareHeader(DevHandle, WaveHeader, WaveHdrSize)
    
    y = CenterLine
    
    ScopeBuffer.FillRect(0, 0, ScopeWidth, ScopeHeight, RGB(000,000,000))
    ScopeBuffer.Line(0, CenterLine, ScopeWidth, CenterLine, RGB(255,255,000))
    
    For xx = 1 To ScopeWidth
      x = (xx - 1)
      yy = CenterLine + (Buffer(x) / ScaleFactor)
      ScopeBuffer.Line(x, y, xx, yy, RGB(000,255,000))
      y = yy
    Next xx
    
    Scope.Draw(0,0,ScopeBuffer.Bmp)
    
    DoEvents 'Need to capture if the Stop button was clicked or Slider scrollbar has changed
    
    WaveHeader.dwFlags = 0
    
    ' Uncomment if you want/need to reduce CPU usage
    '  (leave commmented out for Windows XP!!!)
    'Sleep(0.015625) ' 1/64th of a second
    
    If (DevHandle <> 0) Then Goto V1
    
V2: v = False
End Sub