'-------------------------------------------------------------- ' PBSinWav.bas ' ' Sine wave generator ' The program is an extended version of Petzolds sinewave.c from ' 'Programming Windows' (fifth edition) chapt. 22. ' ' The program is extended to allow for 16-bit waveforms and more than ' 2 buffers. ' ' If you dont get a smooth sound, increase the number of buffers or ' increase the buffer size. Small buffer size implies faster reaction ' when the frequency is changed. ' ' Try to play with the arrow-keys. '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ' REMARK: In win32api.inc you have to change WAVEFORMAT to WAVEFORMATEX ' in the declaration of waveOutOpen. '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ' ' Regards, ' Peter Stephensen ' mw-ps@post.tele.dk ' '-------------------------------------------------------------- #REGISTER NONE #COMPILE EXE #OPTION VERSION4 #INCLUDE "win32api.inc" %IDC_SCROLL = 1000 %IDC_TEXT = 1001 %IDC_ONOFF = 1002 %FREQ_MIN = 20 %FREQ_MAX = 3000 %FREQ_STEP = 10 %FREQ_INIT = 440 %SAMPLE_RATE = 22050 ' Possible values: 44100, 22050, 11025, 8000 %OUT_BUFFER_SIZE = 128 ' Size of buffers (if 16-bit, be sure that %OUT_BUFFER_SIZE/2 is an integer ) %NUM_BUF = 48 ' Numbers of buffers %BIT16 = 1 ' %BIT16 defined implies 16-bit, %BIT16 not defined implies 8-bit $AppName = "PBSineWave" GLOBAL PI AS DOUBLE DECLARE CALLBACK FUNCTION DlgProc FUNCTION PBMAIN LOCAL hDlg AS LONG DIALOG NEW 0, "",,, 278, 44, %DS_MODALFRAME OR %DS_CENTER OR %WS_POPUP OR %WS_CAPTION OR %WS_SYSMENU TO hDlg CONTROL ADD BUTTON, hDlg, %IDC_ONOFF, "Turn On", 221, 23, 50, 14 CONTROL ADD "SCROLLBAR", hDlg, %IDC_SCROLL, "", 7, 7, 262, 11, %WS_CHILD OR %SBS_HORZ OR %WS_VISIBLE CONTROL ADD LABEL, hDlg, -1, "Frequency:", 7, 26, 36, 8 CONTROL ADD LABEL, hDlg, %IDC_TEXT, "", 47,24,27,12, %SS_CENTERIMAGE OR %SS_SUNKEN DIALOG SHOW MODAL hDlg CALL DlgProc END FUNCTION #IF %DEF(%BIT16) %BITS = 16 SUB FillBuffer(BYVAL pBuffer AS INTEGER PTR, BYVAL iFreq AS SINGLE) REGISTER i AS LONG STATIC fAngle AS DOUBLE FOR i = 0 TO %OUT_BUFFER_SIZE/2 - 1 @pBuffer[i] = 30000 * SIN( fAngle ) fAngle = fAngle + 2 * PI * iFreq / %SAMPLE_RATE IF fAngle > 2 * PI THEN fAngle = fAngle - 2 * PI END IF NEXT i END SUB #ELSE %BITS = 8 SUB FillBuffer(BYVAL pBuffer AS BYTE PTR, BYVAL iFreq AS SINGLE) REGISTER i AS LONG STATIC fAngle AS DOUBLE FOR i = 0 TO %OUT_BUFFER_SIZE-1 @pBuffer[i] = 127 + 127 * SIN( fAngle ) fAngle = fAngle + 2 * PI * iFreq / %SAMPLE_RATE IF fAngle > 2 * PI THEN fAngle = fAngle - 2 * PI END IF NEXT i END SUB #ENDIF SUB FillWAVEFORMATEX(w AS WAVEFORMATEX, BYVAL nChannels AS INTEGER, BYVAL nSamplesPerSec AS LONG, BYVAL wBitsPerSample AS WORD) w.wFormatTag = %WAVE_FORMAT_PCM w.nChannels = nChannels w.nSamplesPerSec = nSamplesPerSec w.nAvgBytesPerSec = nSamplesPerSec * nChannels * wBitsPerSample / 8 w.nBlockAlign = nChannels * wBitsPerSample / 8 w.wBitsPerSample = wBitsPerSample w.cbSize = 0 END SUB SUB FillWAVEHDR(w AS WAVEHDR, lpData AS DWORD, BYVAL dwBufferLength AS LONG, BYVAL dwLoops AS LONG) w.lpData = lpData w.dwBufferLength = dwBufferLength w.dwBytesRecorded = 0 w.dwUser = 0 w.dwFlags = 0 w.dwLoops = dwLoops w.lpNext = %NULL w.Reserved = 0 END SUB CALLBACK FUNCTION DlgProc STATIC bShutOff AS LONG, bClosing AS LONG STATIC hWaveOut AS LONG STATIC hwndScroll AS LONG STATIC iFreq AS SINGLE DIM zBuffer(%NUM_BUF-1) AS STATIC ASCIIZ*(%OUT_BUFFER_SIZE+1) DIM WavHdr(%NUM_BUF-1) AS STATIC WAVEHDR STATIC wavformat AS WAVEFORMATEX LOCAL iDummy AS LONG LOCAL pWaveHdr AS WAVEHDR PTR LOCAL i AS LONG SELECT CASE CBMSG CASE %WM_INITDIALOG SetWindowText CBHNDL, $AppName CONTROL HANDLE CBHNDL, %IDC_SCROLL TO hwndScroll SetScrollRange hwndScroll, %SB_CTL, %FREQ_MIN*%FREQ_STEP, %FREQ_MAX*%FREQ_STEP, %FALSE SetScrollPos hwndScroll, %SB_CTL, %FREQ_INIT*%FREQ_STEP, %TRUE CONTROL SET TEXT CBHNDL, %IDC_TEXT, FORMAT$(%FREQ_INIT) iFreq = %FREQ_INIT PI = 4 * ATN(1) CASE %WM_HSCROLL SELECT CASE LOWRD(CBWPARAM) CASE %SB_LINELEFT : iFreq = 2 ^ (-1 / 6 ) * iFreq ' one tone CASE %SB_LINERIGHT : iFreq = 2 ^ ( 1 / 6 ) * iFreq CASE %SB_PAGELEFT : iFreq = iFreq / 2 ' octave CASE %SB_PAGERIGHT : iFreq = iFreq * 2 CASE %SB_THUMBTRACK : iFreq = HIWRD(CBWPARAM)/%FREQ_STEP CASE %SB_TOP : GetScrollRange hwndScroll, %SB_CTL, CLNG(iFreq*%FREQ_STEP), iDummy CASE %SB_BOTTOM : GetScrollRange hwndScroll, %SB_CTL, CLNG(iFreq*%FREQ_STEP), iDummy END SELECT iFreq = MAX(%FREQ_MIN, MIN(%FREQ_MAX, iFreq)) SetScrollPos hwndScroll, %SB_CTL, CLNG(iFreq*%FREQ_STEP), %TRUE CONTROL SET TEXT CBHNDL, %IDC_TEXT, FORMAT$(iFreq,"#.#") CASE %WM_COMMAND SELECT CASE LOWRD(CBWPARAM) CASE %IDC_ONOFF ' If turning on the waveform, hWaveOut is NULL IF hWaveOut = %NULL THEN ' Variable to indicate Off button pressed bShutOff = %FALSE ' Open waveform audio for output FillWAVEFORMATEX wavformat, 1, %SAMPLE_RATE, %BITS ' 1=Mono IF waveOutOpen(hWaveOut, %WAVE_MAPPER, wavformat, CBHNDL, 0, %CALLBACK_WINDOW) <> %MMSYSERR_NOERROR THEN hWaveOut = %NULL MessageBeep %MB_ICONEXCLAMATION MSGBOX "Error opening waveform audio device!", %MB_ICONEXCLAMATION OR %MB_OK, $AppName EXIT FUNCTION END IF ' Set up headers and prepare them FOR i = 0 TO %NUM_BUF-1 FillWAVEHDR WavHdr(i), VARPTR(zBuffer(i)), %OUT_BUFFER_SIZE, 1 waveOutPrepareHeader hWaveOut, WavHdr(i), SIZEOF(WavHdr(i)) NEXT i ' If turning off waveform, reset waveform audio ELSE bShutOff = %TRUE waveOutReset hWaveOut END IF CASE %IDCANCEL DIALOG SEND CBHNDL, %WM_SYSCOMMAND, %SC_CLOSE, 0 END SELECT ' Message generated from waveOutOpen call CASE %MM_WOM_OPEN CONTROL SET TEXT CBHNDL, %IDC_ONOFF, "Turn Off" ' Send buffers to output device FOR i = 0 TO %NUM_BUF-1 FillBuffer VARPTR(zBuffer(i)), iFreq waveOutWrite hWaveOut, WavHdr(i), SIZEOF(WavHdr(i)) NEXT i ' Message generated when a buffer is finished CASE %MM_WOM_DONE IF bShutOff THEN waveOutClose hWaveOut EXIT FUNCTION END IF ' Fill and send out a new buffer pWaveHdr = CBLPARAM FillBuffer @pWaveHdr.lpData, iFreq waveOutWrite hWaveOut, @pWaveHdr, SIZEOF(@pWaveHdr) CASE %MM_WOM_CLOSE FOR i = 0 TO %NUM_BUF-1 waveOutUnprepareHeader hWaveOut, WavHdr(i), SIZEOF(WavHdr(i)) NEXT i hWaveOut = %NULL CONTROL SET TEXT CBHNDL, %IDC_ONOFF, "Turn On" IF bClosing THEN DIALOG END CBHNDL CASE %WM_SYSCOMMAND IF CBWPARAM = %SC_CLOSE THEN IF hWaveOut <> %NULL THEN bShutOff = %TRUE bClosing = %TRUE waveOutReset hWaveOut ELSE DIALOG END CBHNDL END IF END IF END SELECT END FUNCTION