recdemo1.pas

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

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

Description:  Wave audio direct-to-disk recorder using low-level multimedia
              wave audio API and real-time audio compression.
              This program shows how to perform direct-to-disk recording and
              playing of wave audio using a dual-buffer procedure.  While one
              buffer is being filled with recorded data, the other is being
              written to disk. RecDemo also includes function calls to the
              Audio Compression Manager (ACM) for setting the wave audio format.
              This allows various compression formats to be selected by the
              user.  When compresison is used, the size of the wave file is
              reduced significantly while retaining high audio quality.
              This program is based on DDREC Windows SDK sample program.
Author:       (c) 1999, Fran鏾is Piette. All rights reserved.
              http://www.rtfm.be/fpiette/indexuk.htm
              [e-mail]
              [e-mail]
Creation:     June 16, 1999
Version       1.00
Legal Stuff:  This software may be used without charge provided this notice is
              not removed. An acknowledgement for the author's work is welcome.

              THIS SOFTWARE IS PROVIDED BY FRANCOIS PIETTE "AS IS" AND ANY
              EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
              THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
              PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR
              OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
              SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
              LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
              USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED
              AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
              LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
              ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
              POSSIBILITY OF SUCH DAMAGE.
Support:      This code is unsupported. Anyway, I'll do my best to make it
              works correctly. If you find any problem, send me an EMail, I'll
              see if I can do something for you.
History:
Jul 21, 1999  V1.00 Released


 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
unit RecDemo1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  IniFiles, StdCtrls, ExtCtrls, MsAcm, MMSystem, Menus;

type
  TRecorderMode     = (recModeOff, recModeRecord, recModePlay);
  TRecorderSaveMode = (smSave, smSaveAs);
  TRecorderForm = class(TForm)
    ToolPanel: TPanel;
    DisplayMemo: TMemo;
    PlayButton: TButton;
    AudioFormatButton: TButton;
    Panel1: TPanel;
    Label1: TLabel;
    LengthDispLabel: TLabel;
    Label2: TLabel;
    LengthPosLabel: TLabel;
    FormatTagLabel: TLabel;
    FormatDescLabel: TLabel;
    RecordButton: TButton;
    PositionPanel: TPanel;
    Timer1: TTimer;
    RecordLightShape: TShape;
    OpenDialog1: TOpenDialog;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Open1: TMenuItem;
    Save1: TMenuItem;
    SaveAs1: TMenuItem;
    N1: TMenuItem;
    Exit1: TMenuItem;
    Help1: TMenuItem;
    PositionShape: TShape;
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure AudioFormatButtonClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure RecordButtonClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure Save1Click(Sender: TObject);
    procedure SaveAs1Click(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
    procedure PlayButtonClick(Sender: TObject);
    procedure Open1Click(Sender: TObject);
    procedure Help1Click(Sender: TObject);
  private
    FIniFileName   : String;
    FInitialized   : Boolean;
    FWaveFormat    : PWAVEFORMATEX;
    FTotalWaveSize : DWORD;                    // Number of samples recorded
    FByteDataSize  : DWORD;                    // Accumulative size of recorded data
    FDiskFreeSpace : DWORD;                    // Free space for temp file
    FWaveHdr       : array [0..1] of PWAVEHDR; // Points to wave header information
    FWaveMem       : array [0..1] of PChar;    // Points to wave buffers
    FBufIndex      : Integer;                  // Which buffer are we using
    FWaveIn        : HWAVEIN;                  // Device ID for recording input
    FWaveOut       : HWAVEOUT;                 // Device ID for playing
    FMaxFmtSize    : DWORD;                   // largest format size required for compression
    FFormatDesc    : String;                   // Format description
    FFormatTag     : String;                   // Format tag description
    FDeviceOpened  : Boolean;                  // Device open status
    FRecorderMode  : TRecorderMode;            // Recording/playing mode
    FWaveBufSize   : DWORD;                    // Size of buffer
    FFilename      : String;                   // File name to store WAV
    FHasFilename   : Boolean;
    FFileSaved     : Boolean;                  // Set when a save is done
    FMoreToPlay    : Boolean;                  // There is more data to play
    FRecordedData  : Boolean;                  // Did we recorded data
    FTmpFileName   : String;                   // temporary wave filename
    FTmpFileHandle : HFILE;                    // Handle to temporary wave file
    procedure Display(Msg : String);
    function  GetWaveFormat : integer;
    procedure UpdateLength(BytePosition : DWORD; BytePositiontotal : DWORD);
    function  GetFormatDetails(pfmtin : PWAVEFORMATEX) : integer;
    function  GetFormatTagDetails(wFormatTag : WORD) : integer;
    procedure errormsg(const msg : String);
    procedure ierrormsg(const msg : String);
    procedure WFerror(mmfp : HMMIO; const msg : String);
    procedure DestroyWaveRecorder;
    function  InitWaveRecorder : integer;
    function  AllocWaveFormatEx : Integer;
    procedure FreeWaveFormatEx;
    function  AllocWaveHeader : integer;
    procedure FreeWaveHeader;
    function  AllocPCMBuffers : Integer;
    procedure FreePCMBuffers;
    function  OpenTmpFile : Integer;
    function  CreateTmpFile : integer;
    procedure DeleteTmpFile;
    procedure CloseTmpFile;
    function  StartWaveRecord : Integer;
    procedure StopWaveRecord;
    procedure SetButtonState;
    procedure InitWaveHeaders;
    procedure CloseWaveDeviceRecord;
    procedure UpdateRecordDisplay;
    procedure UpdatePlayDisplay;
    function  AddNextBuffer : integer;
    procedure RecordLight(Mode : TRecorderMode);
    procedure MMWimData(var msg: TMessage); message MM_WIM_DATA;
    procedure MMWomDone(var msg: TMessage); message MM_WOM_DONE;
    procedure MMWomClose(var msg: TMessage); message MM_WOM_CLOSE;
    function  WriteWaveBuffer(size : UINT) : integer;
    procedure CheckSaveFile;
    function  SaveWaveFile(FSaveMode : TRecorderSaveMode) : integer;
    procedure InitFilenameDialog(OpenDialog : TOpenDialog);
    function  QueryUserSave(const name : String) : integer;
    function  GetSaveFilename(FSaveMode : TRecorderSaveMode) : Boolean;
    function  CopyDataToWaveFile(mmfp : HMMIO) : integer;
    function  StartWavePlay : Integer;
    function  QueueNextBuffer : Integer;
    function  ReadWaveBuffer : Integer;
    procedure StopWavePlay(prematurely : Boolean);
    procedure CloseWaveDevicePlay;
    function  ReadWaveFile : Integer;
    function  CopyWaveToTempFile(mmfp : HMMIO; datasize : DWORD) : Integer;
  public
    property IniFileName : String read FIniFileName write FIniFileName;
  end;

const
  WAVE_BUFSIZE  = 32768;
  FOURCC_WAVE   = $45564157;   { 'WAVE' }
  FOURCC_FMT    = $20746d66;   { 'fmt ' }
  FOURCC_FACT   = $74636166;   { 'fact' }
  FOURCC_DATA   = $61746164;   { 'data' }
  WindowCaption = 'Dual-buffer recorder';

var
  RecorderForm: TRecorderForm;

implementation

uses RecDemo2;

{$R *.DFM}

const
    SectionWindow      = 'RecDemoWindow';
    KeyTop             = 'Top';
    KeyLeft            = 'Left';
    KeyWidth           = 'Width';
    KeyHeight          = 'Height';


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TRecorderForm.FormCreate(Sender: TObject);
begin
    FIniFileName := LowerCase(ExtractFileName(Application.ExeName));
    FIniFileName := Copy(FIniFileName, 1, Length(FIniFileName) - 3) + 'ini';
    FRecorderMode  := recModeOff;
    FFilename      := 'Untitled.wav';
    if InitWaveRecorder <> 0 then
        Application.Terminate;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TRecorderForm.FormDestroy(Sender: TObject);
begin
    if FRecorderMode = recModeRecord then
        StopWaveRecord
    else if FRecorderMode = recModePlay then
        StopWavePlay(TRUE);
    DestroyWaveRecorder;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TRecorderForm.FormShow(Sender: TObject);
var
    IniFile : TIniFile;
begin
    if not FInitialized then begin
        FInitialized := TRUE;

        IniFile      := TIniFile.Create(FIniFileName);
        Width        := IniFile.ReadInteger(SectionWindow, KeyWidth,  Width);
        Height       := IniFile.ReadInteger(SectionWindow, KeyHeight, Height);
        Top          := IniFile.ReadInteger(SectionWindow, KeyTop,
                                            (Screen.Height - Height) div 2);
        Left         := IniFile.ReadInteger(SectionWindow, KeyLeft,
                                            (Screen.Width  - Width)  div 2);
        IniFile.Destroy;

        Display('');
        DisplayMemo.Clear;
        DisplayMemo.Visible := FALSE;
        ToolPanel.Align     := alClient;

        Caption                 := WindowCaption + ' - ' + FFileName;
        LengthPosLabel.Caption  := '0';
        LengthDispLabel.Caption := '0';
        FormatTagLabel.Caption  := FFormatTag;
        FormatDescLabel.Caption := FFormatDesc;
        RecordLight(recModeOff);
        UpdateLength(0, 0);
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TRecorderForm.FormClose(Sender: TObject; var Action: TCloseAction);
var
    IniFile : TIniFile;
begin
    IniFile := TIniFile.Create(FIniFileName);
    IniFile.WriteInteger(SectionWindow, KeyTop,         Top);
    IniFile.WriteInteger(SectionWindow, KeyLeft,        Left);
    IniFile.WriteInteger(SectionWindow, KeyWidth,       Width);
    IniFile.WriteInteger(SectionWindow, KeyHeight,      Height);
    IniFile.Destroy;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TRecorderForm.Display(Msg : String);
var
    I : Integer;
begin
    DisplayMemo.Lines.BeginUpdate;
    try
        if DisplayMemo.Lines.Count > 200 then begin
            for I := 1 to 50 do
                DisplayMemo.Lines.Delete(0);
        end;
        DisplayMemo.Lines.Add(Msg);
    finally
        DisplayMemo.Lines.EndUpdate;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
// Display an error message.
procedure TRecorderForm.errormsg(const msg : String);
begin
    Application.MessageBox(PChar(msg), 'Error', MB_OK);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
// Display an error message and return an error value.
procedure TRecorderForm.ierrormsg(const msg : String);
begin
    Application.MessageBox(PChar(msg), 'Error', MB_OK);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
// Get the format tag details and store the string description.
function TRecorderForm.GetFormatTagDetails(wFormatTag : WORD) : integer;
var
    acmtagdetails : TACMFORMATTAGDETAILS;
begin
    // zero out...
    FillChar(acmtagdetails, sizeof(acmtagdetails), 0);

    acmtagdetails.cbStruct    := sizeof(acmtagdetails);
    acmtagdetails.dwFormatTag := wFormatTag;

    if acmFormatTagDetails(nil, acmtagdetails,
                           ACM_FORMATTAGDETAILSF_FORMATTAG) <> 0 then begin
        ierrormsg('Warning, FormatTagDetails function failed');
        Result := -1;
        Exit;
    end;

    // store the format tag details description string...
    FFormatTag := acmtagdetails.szFormatTag;
    Result := 0;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
// Get the format details and store the string description.
function TRecorderForm.GetFormatDetails(pfmtin : PWAVEFORMATEX) : integer;
var
    acmfmtdetails : TACMFORMATDETAILS;
begin
    // zero out struct...
    FillChar(acmfmtdetails, sizeof(acmfmtdetails), 0);

    acmfmtdetails.cbStruct    := sizeof(acmfmtdetails);
    acmfmtdetails.pwfx        := pfmtin;
    acmfmtdetails.dwFormatTag := pfmtin.wFormatTag;
    acmfmtdetails.cbwfx       := sizeof(TWAVEFORMATEX) + pfmtin.cbSize;

    if acmFormatDetails(nil, acmfmtdetails,
                        ACM_FORMATDETAILSF_FORMAT) <> 0 then begin
        ierrormsg('Warning, FormatDetails function failed');
        Result := -1;
        Exit;
    end;

    // store the format details description string...
    FFormatDesc := acmfmtdetails.szFormat;

    Result := 0;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
// Update the display of the sample length.
procedure TRecorderForm.UpdateLength(BytePosition : DWORD; BytePositiontotal : DWORD);
begin
    // store these...
    LengthPosLabel.Caption  := IntToStr(BytePosition);
    LengthDispLabel.Caption := IntToStr(BytePositiontotal);
    if (BytePosition = 0) or (BytePositiontotal = 0) then
       PositionShape.Width := 0
    else
       PositionShape.Width := Trunc((PositionPanel.Width - 2) *
                                     Integer(BytePosition) / Integer(BytePositiontotal));
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TRecorderForm.GetWaveFormat : integer;
var
    acmopt  : TACMFORMATCHOOSE;
    err     : MMRESULT;
    ptmpfmt : PWAVEFORMATEX;
begin
    // store the format temporarily...
    GetMem(ptmpfmt, FMaxFmtSize);
    if ptmpfmt = nil then begin
        ierrormsg('Error allocating temporary format buffer.');
        Result := -1;
        Exit;
    end;

    Move(FWaveFormat^, ptmpfmt^, FMaxFmtSize);

    // setup ACM choose fields and display the dialog...
    FillChar(acmopt, sizeof(acmopt), 0);  // zero out
    acmopt.cbStruct  := sizeof(acmopt);
    acmopt.fdwStyle  := ACMFORMATCHOOSE_STYLEF_INITTOWFXSTRUCT;
    acmopt.hwndOwner := Handle;
    acmopt.pwfx      := FWaveFormat;
    acmopt.cbwfx     := FMaxFmtSize;
    acmopt.pszTitle  := 'Select Compression';
    acmopt.fdwEnum   := ACM_FORMATENUMF_INPUT;
    err              := acmFormatChoose(acmopt);

    // if the same format was selected we don't want to reset FTotalWaveSize
    // below, so act like a cancel...
    if CompareMem(FWaveFormat, ptmpfmt, sizeof(TWAVEFORMATEX)) then
        err := ACMERR_CANCELED;
    if err <> MMSYSERR_NOERROR then begin
        Move(ptmpfmt^, FWaveFormat^, FMaxFmtSize);
        FreeMem(ptmpfmt);
        if err = ACMERR_CANCELED then begin
            Result := 0;
            Exit;
        end;