recdemo1.pas

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

        ierrormsg('Error in FormatChoose function');
        Result :=  -2;
        Exit;
    end;

    // store the format description...
    FFormatDesc := acmopt.szFormat;

    // get the format tag details, we don't need to call acmGetFormatDetails since
    // that information was supplied by the choose function...
    GetFormatTagDetails(acmopt.pwfx.wFormatTag);

    FreeMem(ptmpfmt);

    // now set the play button to a grayed state cause we don't want
    // to try to play the recorded data with a different format...
    FTotalWaveSize := 0;
    UpdateLength(FTotalWaveSize, 0);
    SetButtonState;

    Result := 0;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TRecorderForm.AudioFormatButtonClick(Sender: TObject);
begin
    GetWaveFormat;
    FormatTagLabel.Caption  := FFormatTag;
    FormatDescLabel.Caption := FFormatDesc;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
// Allocate format and wave headers, data buffers, and temporary filename.
function TRecorderForm.InitWaveRecorder : integer;
var
    Temp : array [0..MAX_PATH] of char;
begin
    Result := -1;
    // allocate memory for wave format structure...
    if AllocWaveFormatEx <> 0 then
        Exit;

    // find a device compatible with the available wave characteristics...
    if waveInGetNumDevs < 1 then begin
        ierrormsg('No wave audio recording devices found.');
        Result := -1;
        Exit;
    end;

    // allocate the wave header memory...
    if AllocWaveHeader <> 0 then begin
        Result := -3;
        Exit;
    end;

    // allocate the wave data buffer memory...
    if AllocPCMBuffers <> 0 then begin
        Result := -4;
        Exit;
    end;

    // generate a temporary filename for writing to...
    GetTempPath(sizeof(Temp), Temp);
    SetLength(FTmpFileName, MAX_PATH);
    GetTempFileName(Temp, 'wr', 0, PChar(FTmpFileName));

    Result := 0;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
// Free the memory associated with the wave buffers.
procedure TRecorderForm.DestroyWaveRecorder;
begin
    FreeWaveFormatEx;
    FreePCMBuffers;
    FreeWaveHeader;
    DeleteTmpFile;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
// Allocate and lock WAVEFORMATEX structure based on maximum format size
// according to the ACM.
function TRecorderForm.AllocWaveFormatEx : Integer;
begin
    // get the largest format size required from installed ACMs...
    // FMaxFmtSize is the sum of sizeof(WAVEFORMATEX) + FWaveFormat.cbSize
    if acmMetrics(nil, ACM_METRIC_MAX_SIZE_FORMAT, FMaxFmtSize) <> 0 then begin
        ierrormsg('Error getting the max compression format size.');
        Result := -1;
        Exit;
    end;

    GetMem(FWaveFormat, FMaxFmtSize);
    if FWaveFormat = nil then begin
        ierrormsg('Error allocating local memory for WaveFormatEx structure.');
        Result := -2;
        Exit;
    end;

    // initialize the format to standard PCM...
    FillChar(FWaveFormat^, FMaxFmtSize, 0);
    FWaveFormat.wFormatTag      := WAVE_FORMAT_PCM;
    FWaveFormat.nChannels       := 1;
    FWaveFormat.nSamplesPerSec  := 11025;
    FWaveFormat.nAvgBytesPerSec := 11025;
    FWaveFormat.nBlockAlign     := 1;
    FWaveFormat.wBitsPerSample  := 8;
    FWaveFormat.cbSize          := 0;

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

    Result := 0;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
// Free the WAVEFORMATEX buffer.
procedure TRecorderForm.FreeWaveFormatEx;
begin
    if FWaveFormat <> nil then begin
        FreeMem(FWaveFormat);
        FWaveFormat := nil;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
// Allocate and lock header memory
function TRecorderForm.AllocWaveHeader : integer;
var
    i : Integer;
begin
    for i := Low(FWaveHdr) to High(FWaveHdr) do begin
        GetMem(FWaveHdr[i], sizeof(TWAVEHDR));
        if FWaveHdr[i] = nil then begin
            ierrormsg('Error allocating wave header memory.');
            Result := -1;
            Exit;
        end;
    end;
    Result := 0;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
// Free the wave header memory.
procedure TRecorderForm.FreeWaveHeader;
var
    i : Integer;
begin
    for i := Low(FWaveHdr) to High(FWaveHdr) do begin
        if FWaveHdr[i] <> nil then begin
            FreeMem(FWaveHdr[i]);
            FWaveHdr[i] := nil;
        end;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
// Allocate and lock wave memory
function TRecorderForm.AllocPCMBuffers : Integer;
var
    i : Integer;
begin
    for i := Low(FWaveMem) to High(FWaveMem) do begin
        GetMem(FWaveMem[i], WAVE_BUFSIZE);
        if FWaveMem[i] = nil then begin
            errormsg('Error allocating wave buffer memory.');
            Result := -1;
            Exit;
        end;
        FWaveHdr[i].lpData := FWaveMem[i];
    end;
    Result := 0;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
// Free the wave memory.
procedure TRecorderForm.FreePCMBuffers;
var
    i : Integer;
begin
    for i := Low(FWaveMem) to High(FWaveMem) do begin
        if FWaveMem[i] <> nil then begin
            FreeMem(FWaveMem[i]);
            FWaveMem[i] := nil;
        end;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
// Write the recorded data to the temporary file.
function TRecorderForm.WriteWaveBuffer(size : UINT) : integer;
begin
    Result := 0;
    if size = 0 then
        Exit;

    if _lwrite(FTmpFileHandle, FWaveMem[FBufIndex], size) <> size then begin
        ierrormsg('Error writing data to temporary file.');
        Result := -1;
        Exit;
    end;

    // running total bytes recorded...
    Inc(FByteDataSize, size);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
// Create the temporary file for writing the wave data to.
function TRecorderForm.CreateTmpFile : integer;
var
    RootPathName          : array [0..MAX_PATH] of char;
    SectorsPerCluster     : DWORD;
    BytesPerSector        : DWORD;
    NumberOfFreeClusters  : DWORD;
    TotalNumberOfClusters : DWORD;
begin
    FTmpFileHandle := _lcreat(PChar(FTmpFileName), 0);
    if FTmpFileHandle = HFILE_ERROR then begin
        ierrormsg('Error creating temporary file.');
        Result := -1;
        Exit;
    end;

    // get available space on the temp disk...
    if FTmpFileName[2] = ':' then
        RootPathName[0] := FTmpFileName[1]
    else
        GetCurrentDirectory(sizeof(RootPathName), @RootPathName);
    RootPathName[1] := ':';
    RootPathName[2] := '\';
    RootPathName[3] := #0;

    GetDiskFreeSpace(@RootPathName,
                     SectorsPerCluster,
                     BytesPerSector,
                     NumberOfFreeClusters,
                     TotalNumberOfClusters);
    // We may have more than 2GB (High(Integer)) free space !
    if NumberOfFreeClusters > (High(DWORD) div SectorsPerCluster) then
        FDiskFreeSpace := High(DWORD)
    else begin
        FDiskFreeSpace := NumberOfFreeClusters * SectorsPerCluster;
        if FDiskFreeSpace > (High(DWORD) div BytesPerSector) then
            FDiskFreeSpace := High(DWORD)
        else
            FDiskFreeSpace := FDiskFreeSpace * BytesPerSector;
    end;

    Result := 0;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
// Close the temporary file contaning the newly recorded data.
procedure TRecorderForm.CloseTmpFile;
begin
    if _lclose(FTmpFileHandle) = HFILE_ERROR then
        errormsg('Error closing temporary file.');
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
// Delete the temporary wave file.
procedure TRecorderForm.DeleteTmpFile;
begin
    if Length(FTmpFileName) > 0 then
        DeleteFile(FTmpFileName);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
// Prepare headers, add buffer, adjust display, and start recording.
function TRecorderForm.StartWaveRecord : Integer;
var
    Status : MMRESULT;
begin
    FTotalWaveSize := 0;
    FByteDataSize  := 0;
    FBufIndex      := 0;

    // open the device for recording...
    Status := waveInOpen(@FWaveIn, WAVE_MAPPER, FWaveFormat,
                         Handle, 0, CALLBACK_WINDOW);
    if Status <> MMSYSERR_NOERROR then begin
        ierrormsg('Could not open the input device for recording.');
        Result := -1;
        Exit;
    end;

    // tell CloseWaveDeviceRecord() that the device is open...
    FDeviceOpened := TRUE;

    // prepare the headers...
    InitWaveHeaders;

    if not ((waveInPrepareHeader(FWaveIn, FWaveHdr[0], sizeof(TWAVEHDR)) = 0) and
        (waveInPrepareHeader(FWaveIn, FWaveHdr[1], sizeof(TWAVEHDR)) = 0))
    then begin
        CloseWaveDeviceRecord;
        ierrormsg('Error preparing header for recording.');
        Result := -2;
        Exit;
    end;

    // add the first buffer...
    if AddNextBuffer <> 0 then begin
        Result := -3;
        Exit;
    end;

    // create the file we'll be writing to...
    if CreateTmpFile <> 0 then begin
        CloseWaveDeviceRecord;
        Result := -4;
        Exit;
    end;

    // start recording to first buffer...
    if waveInStart(FWaveIn) <> 0 then begin
        CloseWaveDeviceRecord;
        ierrormsg('Error starting wave record.');
        Result := -5;
        Exit;
    end;

    FRecorderMode := recModeRecord;

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

    // queue the next buffer...
    if AddNextBuffer <> 0 then begin
        Result := -6;
        Exit;
    end;

    // turn the record light on...
    RecordLight(recModeRecord);

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

    Result := 0;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TRecorderForm.SetButtonState;
begin
    RecordButton.Enabled := (FRecorderMode <> recModePlay);
    PlayButton.Enabled   := ((FTotalWaveSize <> 0) and
                             (FRecorderMode <> recModeRecord));
    AudioFormatButton.Enabled := (FRecorderMode = recModeOff);
//    EnableMenuItem( GetSubMenu(GetMenu(hwnd),0), 0, MF_BYPOSITION | ((FRecorderMode)?MF_DISABLED:MF_ENABLED) );
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
// Zero out the wave headers and initialize the data pointers and
// buffer lengths.
procedure TRecorderForm.InitWaveHeaders;
begin
    // make the wave buffer size a multiple of the block align...
    FWaveBufSize := (WAVE_BUFSIZE - WAVE_BUFSIZE mod FWaveFormat.nBlockAlign);

    // zero out the wave headers...
    FillChar(FWaveHdr[0]^, sizeof(TWAVEHDR), 0);
    FillChar(FWaveHdr[1]^, sizeof(TWAVEHDR), 0);

    // now init the data pointers and buffer lengths...
    FWaveHdr[0].dwBufferLength := FWaveBufSize;
    FWaveHdr[1].dwBufferLength := FWaveBufSize;
    FWaveHdr[0].lpData         := FWaveMem[0];
    FWaveHdr[1].lpData         := FWaveMem[1];
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
// Close the temp file and wave recording device.
procedure TRecorderForm.CloseWaveDeviceRecord;
begin
    // if the device is already closed, just return...
    if not FDeviceOpened then
        Exit;

    // unprepare the headers...
    if waveInUnprepareHeader(FWaveIn, FWaveHdr[0], sizeof(TWAVEHDR)) <> 0 then
        errormsg('Error in waveInUnprepareHeader (1)');