2010-05-30 09:36

'I did not write this code.
'It a slightly improved version of
'Slavko's code from message #33719.

     $OPTION EXPLICIT
     $INCLUDE "RapidQ.inc"

     TYPE WAVEFORMATEX
      wFormatTag AS WORD
      nChannels AS WORD
      nSamplesPerSec AS LONG
      nAvgBytesPerSec AS LONG
      nBlockAlign AS WORD
      wBitsPerSample AS WORD
      cbSize 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

     CONST BufLen = 22050

     DEFSTR TmpStr

     DEFINT i

     DEFLNG WaveHandle

     DEFDBL Shift = 0.15
     DEFDBL ShiftStep = 0.000001
     DEFDBL frq

     DIM Mem1 AS QMEMORYSTREAM
     DIM Mem2 AS QMEMORYSTREAM

     FOR i = 1 TO BufLen
      Mem1.WriteNum(SIN(i) * 20000, 2)
     NEXT

     FOR i = 1 TO BufLen
      Mem2.WriteNum(SIN(i) * 20000, 2)
     NEXT

' To reduce annoying ticking sounds...  set nChannels to 1.
' Special Note: CPU usage will still cause ticking sounds... if it's maxed out.
'
' nChannels can be: 1, 2
' nSamplesPerSec can be: 8000, 11025, 16000, 22050, 24000, 32000, 44100, 48000
' wBitsPerSample can be: 8, 16
' nAvgBytesPerSec: (nChannels * nSamplesPerSec * wBitsPerSample / 8)
' nBlockAlign: (nChannels * wBitsPerSample / 8)
'
' To change the sound... change the frequency
' To change the volume... change it using the API... waveOutSetVolume
' On my computer... this program (with these settings) uses 50%(+/-) of the CPU.
     DIM WaveFmt AS WAVEFORMATEX
     WaveFmt.wFormatTag      = 1
     WaveFmt.nChannels       = 1
     WaveFmt.nSamplesPerSec  = 24000
     WaveFmt.nAvgBytesPerSec = 48000
     WaveFmt.nBlockAlign     = 2
     WaveFmt.wBitsPerSample  = 16
     WaveFmt.cbSize          = SIZEOF(WaveFmt)

     DIM WaveHeader1 AS WAVEHDR
     WaveHeader1.LpData         = Mem1.Pointer
     WaveHeader1.dwBufferLength = BufLen * 2
     WaveHeader1.dwFlags        = &H4 OR 1
     WaveHeader1.dwLoops        = 0

     DIM WaveHeader2 AS WAVEHDR
     WaveHeader2.LpData         = Mem2.Pointer
     WaveHeader2.dwBufferLength = BufLen * 2
     WaveHeader2.dwFlags        = 1
     WaveHeader2.dwLoops        = 0

     DECLARE FUNCTION waveOutOpen LIB "winmm.dll" ALIAS "waveOutOpen" _
      (ByRef phwo AS LONG, uDeviceID AS LONG, pwfx AS WAVEFORMATEX, _
      dwCallback AS LONG, dwInstance AS LONG, FwdOpen AS LONG) AS LONG

     DECLARE FUNCTION waveOutPrepareHeader LIB "winmm.dll" ALIAS "waveOutPrepareHeader" _
      (hWaveOut AS LONG, lpWaveOutHdr AS WAVEHDR, uSize AS LONG) AS LONG

     DECLARE FUNCTION waveOutWrite LIB "winmm.dll" ALIAS "waveOutWrite" _
      (hWaveOut AS LONG, lpWaveOutHdr AS WAVEHDR, uSize AS LONG) AS LONG

     DECLARE FUNCTION waveOutUnprepareHeader LIB "winmm.dll" ALIAS "waveOutUnprepareHeader" _
      (hWaveOut AS LONG, lpWaveOutHdr AS WAVEHDR, uSize AS LONG) AS LONG

     DECLARE FUNCTION waveOutClose LIB "winmm.dll" ALIAS "waveOutClose" _
      (hWaveOut AS LONG) AS LONG

     DECLARE SUB FormWndProc(hWnd AS SHORT, uMsg AS SHORT, wParam AS SHORT, lParam AS SHORT)

     DECLARE SUB UpdateMem1
     DECLARE SUB UpdateMem2

     DECLARE SUB Form_OnShow
     DECLARE SUB Form_OnClose

     DECLARE SUB SoundOpen
     DECLARE SUB SoundClose

     CREATE Form AS QFORM
      Width = 320
      Height = 240
      Left = (Screen.Width\2)-(Form.Width\2)
      Top = (Screen.Height\2)-(Form.Height\2)
      WndProc = FormWndProc
      OnClose = Form_OnClose
      OnShow = Form_OnShow
     END CREATE

     Form.SHOWMODAL

     SUB FormWndProc(hWnd AS SHORT, uMsg AS SHORT, wParam AS SHORT, lParam AS SHORT)
      IF (uMsg = &H3BD) OR (uMsg = &H3BB) THEN
       IF (WaveHeader1.dwFlags AND &H1) THEN
        UpdateMem1
        waveOutPrepareHeader(WaveHandle, WaveHeader1, SIZEOF(WaveHeader1))
        waveOutWrite(WaveHandle, WaveHeader1, SIZEOF(WaveHeader1))
       END IF
       IF (WaveHeader2.dwFlags AND &H1) THEN
        UpdateMem2
        waveOutPrepareHeader(WaveHandle, WaveHeader2, SIZEOF(WaveHeader2))
        waveOutWrite(WaveHandle, WaveHeader2, SIZEOF(WaveHeader2))
       END IF
      END IF
     END SUB

     SUB UpdateMem1
      Mem1.Position = 0
      FOR i = 1 TO BufLen
       Mem1.WriteNum(SIN(frq) * 20000, 2)
       frq = frq + Shift
       Shift = Shift + ShiftStep
       IF (Shift > .2) OR (Shift < .1) THEN ShiftStep = -ShiftStep
      NEXT
     END SUB

     SUB UpdateMem2
      Mem2.Position = 0
      FOR i = 1 TO BufLen
       Mem2.WriteNum(SIN(frq) * 20000, 2)
       frq = frq + Shift
       Shift = Shift + ShiftStep
       IF (Shift > .2) OR (Shift < .1) THEN ShiftStep = -ShiftStep
      NEXT
     END SUB

     SUB Form_OnShow
      SoundOpen
     END SUB

     SUB Form_OnClose
      SoundClose
      Application.Terminate
     END SUB

     SUB SoundOpen
      waveOutOpen(WaveHandle, -1, WaveFmt, Form.handle, 0, &H10000)
     END SUB

     SUB SoundClose
      waveOutUnPrepareHeader(WaveHandle, WaveHeader1, SIZEOF(WaveHeader1))
      waveOutUnPrepareHeader(WaveHandle, WaveHeader2, SIZEOF(WaveHeader2))
      waveOutClose(WaveHandle)
     END SUB

2010-05-30 09:36