recdemo1.pas

Interface for Microsoft Audio Compression Manager. - Delphi Source The ACM uses existing driver i

    if waveInUnprepareHeader(FWaveIn, FWaveHdr[1], sizeof(TWAVEHDR)) <> 0 then
        errormsg('Error in waveInUnprepareHeader (2)');

    // save the total size recorded and update the display...
    FTotalWaveSize := FByteDataSize;
    UpdateLength(FTotalWaveSize, FDiskFreeSpace);

    // tell the file save functions that we've got unsaved data...
    FRecordedData := TRUE;

    // close the temporary file...
    CloseTmpFile;

    // close the wave input device...
    if waveInClose(FWaveIn) <> 0 then
        errormsg('Error closing input device.');

    // tell this function we are now closed...
    FDeviceOpened := FALSE;

    // update display...
    // InvalidateRect( hwnd, &specrect, TRUE );
    RecordLight(recModeOff);
    RecordButton.Caption := '&Record';
    SetButtonState;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
// Add the buffer to the wave input queue and toggle buffer index. This
// routine is called from the main window proc.
function TRecorderForm.AddNextBuffer : integer;
begin
    // queue the buffer for input...
    if waveInAddBuffer(FWaveIn, FWaveHdr[FBufIndex], sizeof(TWAVEHDR)) <> 0 then begin
        StopWaveRecord;
        ierrormsg('Error adding buffer.');
        Result := -1;
        Exit;
    end;

    // toggle for next buffer...
    FBufIndex := 1 - FBufIndex;

    Result := 0;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
// Get the total bytes recorded and update the display with the information.
procedure TRecorderForm.UpdateRecordDisplay;
var
    mmtime : TMMTIME;
begin
    mmtime.wType := TIME_BYTES;
    waveInGetPosition(FWaveIn, @mmtime, sizeof(mmtime));
    UpdateLength(mmtime.cb, FDiskFreeSpace);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
// Get the total bytes played and update the display with the information.
procedure TRecorderForm.UpdatePlayDisplay;
var
    mmtime : TMMTIME;
begin
    mmtime.wType := TIME_BYTES;
    waveOutGetPosition(FWaveOut, @mmtime, sizeof(mmtime));
    UpdateLength(mmtime.cb, FTotalWaveSize);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TRecorderForm.RecordLight(Mode : TRecorderMode);
const
    RecordColor : array [TRecorderMode] of TColor = (clBlack, clRed, clLime);
begin
    RecordLightShape.Brush.Color := RecordColor[Mode];
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
// Stop the recording.
procedure TRecorderForm.StopWaveRecord;
begin
    // set flag before stopping since it's used in the MM_WIM_DATA message
    // in our main window proc to control whether we add another buffer
    // or to close the device.
    FRecorderMode := recModeOff;

    // stop recording and return queued buffers...
    if waveInReset(FWaveIn) <> 0 then
        errormsg('Error in waveInReset');

    // stop the timer...
    Timer1.Enabled := FALSE;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TRecorderForm.Timer1Timer(Sender: TObject);
begin
    if FRecorderMode = recModeRecord then
        UpdateRecordDisplay
    else if FRecorderMode = recModePlay then
        UpdatePlayDisplay;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TRecorderForm.RecordButtonClick(Sender: TObject);
begin
    if FRecorderMode <> recModeOff then  // stop recording...
        StopWaveRecord
    else	                    // start recording...
        StartWaveRecord;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
// done recording buffer...
procedure TRecorderForm.MMWimData(var msg: TMessage);
var
    pwavehdrtmp : PWAVEHDR;
begin
    // Done recording buffer, write it out
    pwavehdrtmp := PWAVEHDR(msg.lparam);
    if WriteWaveBuffer(pwavehdrtmp.dwBytesRecorded) <> 0 then
        StopWaveRecord;

    if FRecorderMode <> recModeOff then
        AddNextBuffer    	        // queue it again...
    else
        CloseWaveDeviceRecord;          // stop recording...
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
// done playing queued wave buffer...
procedure TRecorderForm.MMWomDone(var msg: TMessage);
begin
    // done playing queued wave buffer...
    if FMoreToPlay then
        QueueNextBuffer
    else
        StopWavePlay(FALSE);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
// closing wave output device...
procedure TRecorderForm.MMWomClose(var msg: TMessage);
begin
    FDeviceOpened := FALSE;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TRecorderForm.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
    CheckSaveFile;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
// If unsaved wave data has been recorded, ask the user to save it.
procedure TRecorderForm.CheckSaveFile;
begin
    if FRecordedData and (FTotalWaveSize <> 0) and (not FFileSaved) then begin
        if Application.MessageBox(
                            'Wave data has not been saved. ' +
                            'Do you want to save it?',
                            'Just checking', MB_YESNO) = IDYES then
            SaveWaveFile(smSaveAs);
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
// Close the wave file, display an error message
procedure TRecorderForm.WFerror(
    mmfp      : HMMIO;
    const msg : String);
begin
    mmioClose(mmfp, 0);
    Cursor := crDefault;
    ierrormsg(msg);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
// Save the wave file by creating the required RIFF chunks and copy
// the wave data from the temporary wave file to the RIFF .wave file.
function TRecorderForm.SaveWaveFile(FSaveMode : TRecorderSaveMode) : Integer;
var
    mmfp           : HMMIO;
    dwTotalSamples : DWORD;
    fTotalSamples  : double;
    mminfopar      : TMMCKINFO;
    mminfosub      : TMMCKINFO;
const
    initsavename : Boolean = FALSE;
begin
    // if no data recorded, don't bother...
    if FTotalWaveSize = 0 then begin
        ierrormsg('No recorded wave data to save.');
        Result := 0;
        Exit;
    end;

    // initialize the save file struct...
    if not initsavename then begin
        InitFilenameDialog(OpenDialog1);
        initsavename := TRUE;
    end;

    // get a filename/use the current one, or cancel...
    if GetSaveFilename(FSaveMode) = FALSE then begin
        Result := 0;
        Exit;
    end;

    // open the wave file for write...
    mmfp := mmioOpen(PChar(FFilename), nil,
                     MMIO_CREATE or MMIO_WRITE or MMIO_ALLOCBUF);
    if mmfp = 0 then begin
        ierrormsg('Error opening file for write.');
        Result := -1;
        Exit;
    end;

    Cursor := crHourGlass;

    // create wave RIFF chunk...
    mminfopar.fccType := FOURCC_WAVE;
    mminfopar.cksize := 0;		 	// let the function determine the size
    if mmioCreateChunk(mmfp, @mminfopar, MMIO_CREATERIFF) <> 0 then begin
        WFerror(mmfp, 'Error creating RIFF wave chunk.');
        Result := -2;
        Exit;
    end;

    // create the format chunk and write the wave format...
    mminfosub.ckid   := FOURCC_FMT;
    mminfosub.cksize := FMaxFmtSize;
    if mmioCreateChunk(mmfp, @mminfosub, 0) <> 0 then begin
        WFerror(mmfp, 'Error creating RIFF format chunk.');
        Result := -3;
        Exit;
    end;

    if mmioWrite(mmfp, PChar(FWaveFormat), FMaxFmtSize) <> LongInt(FMaxFmtSize) then begin
        WFerror(mmfp, 'Error writing RIFF format data.');
        Result := -3;
        Exit;
    end;

    // back out of format chunk...
    mmioAscend(mmfp, @mminfosub, 0);

    // write the fact chunk (required for all non-PCM .wav files...
    // this chunk just contains the total length in samples...
    mminfosub.ckid   := FOURCC_FACT;
    mminfosub.cksize := sizeof(DWORD);
    if mmioCreateChunk(mmfp, @mminfosub, 0) <> 0 then begin
        WFerror(mmfp, 'Error creating RIFF ''fact'' chunk.');
        Result := -4;
        Exit;
    end;

    fTotalSamples := FTotalWaveSize / FWaveFormat.nAvgBytesPerSec *
                     FWaveFormat.nSamplesPerSec;
    dwTotalSamples := Trunc(fTotalSamples);
    if mmioWrite(mmfp, PChar(@dwTotalSamples), sizeof(dwTotalSamples))
       <> sizeof(dwTotalSamples) then begin
        WFerror(mmfp, 'Error writing RIFF ''fact'' data.');
        Result := -4;
        Exit;
    end;

    // back out of fact chunk...
    mmioAscend(mmfp, @mminfosub, 0);

    // now create and write the wave data chunk...
    mminfosub.ckid   := FOURCC_DATA;
    mminfosub.cksize := 0;	 	// let the function determine the size
    if mmioCreateChunk(mmfp, @mminfosub, 0) <> 0 then begin
        WFerror(mmfp, 'Error creating RIFF data chunk.');
        Result := -5;
        Exit;
    end;

    // copy the data from the temp file to the wave file...
    if CopyDataToWaveFile(mmfp) <> 0 then begin
        WFerror(mmfp, 'Error writing wave data.');
        Result := -5;
        Exit;
    end;

    // back out and cause the size of the data buffer to be written...
    mmioAscend(mmfp, @mminfosub, 0);

    // ascend out of the RIFF chunk...
    mmioAscend(mmfp, @mminfopar, 0);

    // done...
    mmioClose(mmfp, 0);

    Cursor := crDefault;

    // indicate filename on window title...
    Caption := WindowCaption + ' - ' + FFileName;

    // set this so we don't ask for a filename when the user does "SAVE"...
    FFileSaved := TRUE;

    Result := 0;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
// Initialize non-variant fields of OPENFILENAME struct.
procedure TRecorderForm.InitFilenameDialog(OpenDialog : TOpenDialog);
begin
    // just do this once...
    OpenDialog.Filter      := 'Wave Files (*.wav)|*.wav|All Files (*.*)|*.*';
    OpenDialog.FileName    := FFilename;
    OpenDialog.InitialDir  := ExtractFilePath(FFilename);
    OpenDialog.Title       := WindowCaption;
    OpenDialog.DefaultExt  := 'WAV';
    OpenDialog.Options     := [ofHideReadOnly];
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
// Get a save filename according to the save mode.  The FSaveMode is either
// "save" or "saveas" where "saveas" queries for a new name and "save" checks
// to see if the file exists and checks with the user before saving.
// Returns:
//	TRUE	- We have a filename, use that for the save.
//	FALSE	- Cancel the save operation.
function TRecorderForm.GetSaveFilename(FSaveMode : TRecorderSaveMode) : Boolean;
var
    response : Integer;
begin
    while TRUE do begin
        // if we're saving the file as the current name...
        if FSaveMode = smSave then begin
            if (not FHasFilename) or (Length(FFilename) = 0) then
                FSaveMode := smSaveAs
            else if not FFileSaved then begin // see if there's a file by that name already...
                if FileExists(FFilename) then begin	// there is. overwrite?
                    response := QueryUserSave(FFilename);
                    if response = IDNO then
                        FSaveMode := smSaveAs		// no, get a filename
                    else begin
                        Result := (response = IDYES);	// cancel the save operation
                        Exit;
                    end;
                end;
            end;
        end;

        if FSaveMode = smSaveAs then begin		// get a save filename...
            InitFilenameDialog(OpenDialog1);                // setup for common dlg
            if not OpenDialog1.Execute then begin
                Result := FALSE;
                Exit;
            end;

            FFilename    := OpenDialog1.FileName;
            FHasFilename := TRUE;

            // now go check to see if the files exists...
            FSaveMode := smSave;
            continue;
        end;

        break;
    end;

    Result := TRUE;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
// Notify user that the file exists and ask to overwrite, return 1 for yes, 0 for no.
function TRecorderForm.QueryUserSave(const name : String) : Integer;
begin
    Result := Application.MessageBox(
                  PChar('File ' + name + ' exists, overwite?'),
                  'Save File', MB_YESNOCANCEL);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
// Copy the wave data in the temporary file to the wave file.
function TRecorderForm.CopyDataToWaveFile(mmfp : HMMIO) : integer;
var
    pbuf   : PChar;
    ht     : HFILE;
    nbytes : integer;
begin