recdemo1.pas

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

    pbuf := FWaveMem[0]; // use one of the wave buffers for copying
    // open the temp file for reading...
    ht := _lopen(PChar(FTmpFileName), OF_READ);
    if ht = HFILE_ERROR then begin
        Result := -1;
        Exit;
    end;

    // copy to RIFF/wave file...
    while TRUE do begin
        nbytes := _lread(ht, pbuf, WAVE_BUFSIZE);
        if nbytes <= 0 then
            break;
        mmioWrite(mmfp, pbuf, nbytes);
    end;

    // close read file...
    _lclose(ht);

    Result := 0;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TRecorderForm.Save1Click(Sender: TObject);
begin
    SaveWaveFile(smSave);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TRecorderForm.SaveAs1Click(Sender: TObject);
begin
    SaveWaveFile(smSaveAs);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TRecorderForm.Exit1Click(Sender: TObject);
begin
    Close;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
// Prepare headers, add buffer, and start recording.
function TRecorderForm.StartWavePlay : Integer;
begin
    Result := -1;

    // if the device is still open, just return...
    if FDeviceOpened then
        Exit;

    FByteDataSize := 0;
    FBufIndex     := 0;

    // open the device for recording...
    if waveOutOpen(@FWaveOut, WAVE_MAPPER, FWaveFormat,
                   Handle, 0, CALLBACK_WINDOW or WAVE_ALLOWSYNC) <> 0 then begin
        ierrormsg('Error opening wave out device.');
        Result := -1;
        Exit;
    end;

    FDeviceOpened := TRUE;

    // prepare the headers...
    InitWaveHeaders;

    if (waveOutPrepareHeader(FWaveOut, FWaveHdr[0], sizeof(TWAVEHDR)) <> 0) or
       (waveOutPrepareHeader(FWaveOut, FWaveHdr[1], sizeof(TWAVEHDR)) <> 0)
    then begin
        CloseWaveDevicePlay;
        ierrormsg('Error preparing header for playing.');
        Result := -2;
        Exit;
    end;

    // open the temporary file for reading...
    if OpenTmpFile = 0 then begin
        CloseWaveDevicePlay;
        ierrormsg('Error opening temporary wave file for read.');
        Result := -3;
        Exit;
    end;

    // write the first buffer to start playing,..
    if QueueNextBuffer <> 0 then begin
        CloseWaveDevicePlay;
        Result := -4;
        Exit;
    end;

    FRecorderMode := recModePlay;
    FMoreToPlay   := TRUE;

    // set the timer for updating the display...
    Timer1.Interval := 250;
    Timer1.Enabled  := TRUE;
    UpdateLength(0, FTotalWaveSize);

    // turn the play light on...
    RecordLight(recModePlay);

    // adjust control button states...
    PlayButton.Caption := '&Stop';
    SetButtonState;

    // and queue the next buffer up...
    QueueNextBuffer;

    Result := 0;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
// Write the buffer to the wave device and toggle buffer index.
function TRecorderForm.QueueNextBuffer : Integer;
begin
    // fill the wave buffer with data from the file...
    if ReadWaveBuffer = 0 then begin
        // reset flags field (remove WHDR_DONE attribute)...
        FWaveHdr[FBufIndex].dwFlags := WHDR_PREPARED;

        // now queue the buffer for output...
        if waveOutWrite(FWaveOut, FWaveHdr[FBufIndex], sizeof(TWAVEHDR)) <> 0
        then begin
            StopWavePlay(TRUE);
            ierrormsg('Error writing wave buffer.');
            Result := -1;
            Exit;
        end;

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

    Result := 0;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
// Read a wave chunk from the temp file.
function TRecorderForm.ReadWaveBuffer : Integer;
begin
    // if we haven't encountered the end of the wave yet,
    // read another buffer in...
    if FByteDataSize < FTotalWaveSize then begin
        // read wave chunk from the temporary file...
        FWaveHdr[FBufIndex].dwBufferLength :=
            _lread(FTmpFileHandle, FWaveMem[FBufIndex], FWaveBufSize);

        // update total number of bytes read so far...
        Inc(FByteDataSize, FWaveHdr[FBufIndex].dwBufferLength);
        Result := 0;
        Exit;
    end;

    // otherwise the last buffer has been queued, just let it finish playing...
    FMoreToPlay := FALSE;	// handled in MM_WOM_DONE message
    Result      := 1;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
// Open the temporary file for reading.
function TRecorderForm.OpenTmpFile : Integer;
begin
    FTmpFileHandle := _lopen(PChar(FTmpFileName), OF_READ);
    if FTmpFileHandle = HFILE_ERROR then
        Result := 0
    else
        Result := 1;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
// Stop the wave playing.
procedure TRecorderForm.StopWavePlay(prematurely : Boolean);
begin
    // if the device isn't open, just return...
    if not FDeviceOpened then
        Exit;

    // stop playing...
    waveOutReset(FWaveOut);

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

    // update the length only if we played to the end...
    if not prematurely then
        UpdateLength(FByteDataSize, FTotalWaveSize);

    FRecorderMode := recModeOff;
    FMoreToPlay   := FALSE;

    // close the device and unprepare the headers...
    CloseWaveDevicePlay;

    // update display...
    RecordLight(recModeOff);
    PlayButton.Caption := '&Play';
    SetButtonState;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
// Close the wave output device.
procedure TRecorderForm.CloseWaveDevicePlay;
begin
    // unprepare the headers...
    if (waveOutUnprepareHeader(FWaveOut, FWaveHdr[0], sizeof(TWAVEHDR)) <> 0) or
       (waveOutUnprepareHeader(FWaveOut, FWaveHdr[1], sizeof(TWAVEHDR)) <> 0)
    then
        errormsg('Error unpreparing play header.');

    // close the device...
    if waveOutClose(FWaveOut) <> 0 then
        errormsg('Error closing wave play device.');

    FDeviceOpened := FALSE;

    // close the temporary file...
    CloseTmpFile;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TRecorderForm.PlayButtonClick(Sender: TObject);
begin
    if FRecorderMode = recModePlay then // stop playing...
        StopWavePlay(TRUE)
    else		           // start playing...
        StartWavePlay;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TRecorderForm.Open1Click(Sender: TObject);
begin
    ReadWaveFile;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TRecorderForm.ReadWaveFile : Integer;
var
    mmfp           : HMMIO;
    mminfopar      : TMMCKINFO;
    mminfosub      : TMMCKINFO;
begin
    InitFilenameDialog(OpenDialog1);
    if not OpenDialog1.Execute then begin
        Result := 0;
        Exit;
    end;
    FFileName    := OpenDialog1.FileName;
    FHasFilename := TRUE;

    // open the wave file for reading...
    mmfp := mmioOpen(PChar(FFileName), nil, MMIO_READ + MMIO_ALLOCBUF);
    if mmfp = 0 then begin
        ierrormsg('Open for read failed.');
        Result := -1;
        Exit;
    end;

    Cursor := crHourGlass;

    // search for wave type and format chunks...
    mminfopar.fccType := FOURCC_WAVE;
    if mmioDescend(mmfp, @mminfopar, nil, MMIO_FINDRIFF) <> 0 then begin
        WFerror(mmfp, 'Wave format not found in file.');
        Result := -2;
        Exit;
    end;

    mminfosub.ckid := FOURCC_FMT;
    if mmioDescend(mmfp, @mminfosub, @mminfopar, MMIO_FINDCHUNK) <> 0 then begin
        WFerror(mmfp, 'Format chunk not found.');
        Result := -3;
        Exit;
    end;

    // read the wave format if the size checks out...
    if mminfosub.cksize > FMaxFmtSize then begin
        WFerror(mmfp, 'Format size in file doesn''t match ACM''s.');
        Result := -4;
        Exit;
    end;

    // read the wave format...
    if mmioRead(mmfp, PChar(FWaveFormat), mminfosub.cksize)
          <> LongInt(mminfosub.cksize) then begin
        WFerror(mmfp, 'Error reading format chunk.');
        Result := -4;
        Exit;
    end;

    // get the total wave data size (mminfo.cksize)...
    mmioAscend(mmfp, @mminfosub, 0);
    mminfosub.ckid := FOURCC_DATA;
    if mmioDescend(mmfp, @mminfosub, @mminfopar, MMIO_FINDCHUNK) <> 0 then begin
        WFerror(mmfp, 'Data chunk not found.');
        Result := -5;
        Exit;
    end;

    // if there's no data get out...
    if mminfosub.cksize = 0 then begin
        WFerror(mmfp, 'The data chunk contains no data.');
        Result := -6;
        Exit;
    end;

    // now read the wave data and copy it to the temorary file...
    if CopyWaveToTempFile(mmfp, mminfosub.cksize) <> 0 then begin
        mminfosub.cksize := 0;
        errormsg('Error reading the wave data.');
    end;

    // all done...
    mmioClose(mmfp, 0);
    Cursor := crDefault;
    FTotalWaveSize := mminfosub.cksize;

    // this data wasn't recorded, it was read in...
    FRecordedData := FALSE;

    // store the format and tag decription strings...
    GetFormatTagDetails(FWaveFormat.wFormatTag);
    GetFormatDetails(FWaveFormat);

    // update display...
    UpdateLength(FTotalWaveSize, FTotalWaveSize);
    SetButtonState;
    FormatTagLabel.Caption  := FFormatTag;
    FormatDescLabel.Caption := FFormatDesc;

    Caption := WindowCaption + ' - ' + FFileName;
    Result  := 0;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
// Copy the wave data from the RIFF file to the temorary file.
function TRecorderForm.CopyWaveToTempFile(
    mmfp     : HMMIO;
    datasize : DWORD) : Integer;
var
    pbuf     : PChar;
    ntotal   : DWORD;
    nbytes   : integer;
    readsize : DWORD;
begin
    pbuf     := FWaveMem[0];
    readsize := WAVE_BUFSIZE;
    ntotal   := 0;
    Result   := 0;

    // create the temporary file based on the current temp name...
    if CreateTmpFile <> 0 then begin
        Result := -1;
        Exit;
    end;

    // enter read/copy loop...
    while ntotal < datasize do begin
        if (ntotal + readsize) > datasize then
            readsize := datasize - ntotal;

        nbytes := mmioRead(mmfp, pbuf, readsize);
        if nbytes = 0 then begin
            Result := -2;
            break;
        end;

        if _lwrite(FTmpFileHandle, pbuf, nbytes) <> UINT(nbytes) then begin
            Result := -3;
            break;
        end;

        Inc(ntotal, nbytes);
    end;

    // close read file...
    CloseTmpFile;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TRecorderForm.Help1Click(Sender: TObject);
begin
    AboutBoxForm.ShowModal;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

end.