Re: Delphi and DSP

Jatin wrote: 
MeMyselfAndI wrote:

Jatin -
No sound card can interpret data into sound. Sound cards take PCM data (ie: plain digital audio as in a .wav file or a CD) and convert it into analog signals. To get the physical parameters you told Marc about to come out as sound you need to write the interpretation rules into your program and get your program to create PCM data based on what information comes through the com port. (Incidentally, why not use a USB port)? You then use the windows sound playback routines to play those sounds. I've got a class that I use for playing buffers of wave data up to 8MB. I'll send it to you if you like. 


I will appreciate if you can share the class with me.

Thanks,

Jatin
============

Okay, here it is...

Regards,
Andrew

unit SimpleWaveIO;

{Last major modification: 23/08/00}
{Last minor modification: 08/08/01}


// Look at MMWPlay.pas to find out how to obtain deviceID's, product names and
//  cast handles for wave out devices. Also find out how to obtain the complete
//  details on device capabilities. Replace Force16Bit and PlayAs16 with code
//  that will rescale data to whatever the device capabilities are.

// Write the class for recording wave data, and see to a proper inheritance
//  pattern from TobjSimpleWaveIO, shifting fields that are applicable only to
//  WaveOut operations downwards and those that may be shared (such as
//  SetWaveFormatEx?) upwards.

// Try using the dwCallback parameter in WaveOutOpen to pass a pointer to a
//  method which will refresh the waveheaders with new data when they have been
//  played. This will consume less CPU time than the current design with a
//  TTimer in constant progress.




interface

uses
  Windows, SysUtils, MMSystem, Classes, AudioInfoStructures, RWAudioFile,
  Streams, General, ExtCtrls, Dialogs;



const
  uDeviceID_dflt : UINT  = WAVE_MAPPER;
  fdwOpen_dflt   : DWORD = CALLBACK_NULL;
  Callback_dflt  : DWORD = 0;
  TimeReportFmt = TIME_SAMPLES;



type

  TenmTimeFormat = (tfSamples, tfMilliSecs, tfBytes, tfMIDI, tfSMPTE, tfTicks);
  TenmWIOState = (prClosed, prIdle, prPaused, prPlaying, prRecording);


  TobjSimpleWaveIO = class(TObject)
  protected
    WaveHdr    : TWAVEHDR;
    ptrWaveHdr : PWAVEHDR;
    cbwh       : UINT;
    hndWaveOut : HWAVEOUT;
    cbmmt      : UINT;
    mmt        : TMMTIME;
    pmmt       : PMMTIME;
    uDeviceID  : UINT;
    wfx        : TWAVEFORMATEX;
    MMReturn   : MMResult;
    dwCallback,
    dwCallbackInstance : DWORD;
    Stopping,
    Creating,
    Destroying,
    Closing,
  //  FMute,
    WaveOut,
    MakeVoid,
    FStopNow,
    FCloseWhenDone : Boolean;
    PtrRec         : TrecSubPointer;
    FState         : TenmWIOState;
    WaveSelect     : PrecProcessData;
    AudioInfo      : PrecAudioInfo;
    procedure SetTimeFormat (NewFmt: TenmTimeFormat);
    function GetTimeFormat : TenmTimeFormat;
    destructor Destroy; override;
    procedure Initialise;
    constructor Create;
  public
    function Stop   : boolean;
    function Pause  : boolean;
    function Resume : boolean;
    function Close  : boolean;
    property StopNow       : boolean        read FStopNow       write FStopNow;
    property State         : TenmWIOState   read FState         write FState;
    property CloseWhenDone : boolean        read FCloseWhenDone write FCloseWhenDone;
    property TimeFormat    : TenmTimeFormat read GetTimeFormat  write SetTimeFormat;
 //   property Mute        : Boolean          read FMute          write FMute;
  end;



  TobjPlaySound = class(TobjSimpleWaveIO)
  private
    cbwoc          : UINT;
    fdwOpen        : DWORD;
    woc            : TWaveOutCapsA;
    pwoc           : PWaveOutCapsA;
    Initialised    : Boolean;
    FFramesGot,
    FramesReturned : Integer;
    ptrBuffer      : Pointer;
  protected
    procedure Initialise;
    function GetFramesPosn   : Integer;
    function GetTimePosn     : Integer;
    function SetWaveFormatEx : TWAVEFORMATEX;
    procedure DisposeWHDR;
  public
    function InitPlay    (AudInf:PrecAudioInfo; WvSlct:PrecProcessData): Boolean;
    function Play        (ptrData:pointer): Boolean;
    function NewPosition (WvSlct:PrecProcessData; ptrData:Pointer;
               AState:TenmWIOState): Boolean;
    function Stop: Boolean;
    constructor Create;
    property FramesPosn  : integer       read GetFramesPosn;
    property TimePosn    : integer       read GetTimePosn;
    property FramesGot   : integer       read FFramesGot;
    property DeviceCaps  : TWaveOutCapsA read woc;
  end;



  TobjRecdSound = class (TobjSimpleWaveIO)
  public
    function Recrd (AudInf: PrecAudioInfo; WvSlct: PrecProcessData): boolean;
  end;






implementation



//----- TobjSimpleWaveIO -------------------------------------------------------
  procedure TobjSimpleWaveIO.SetTimeFormat (NewFmt: TenmTimeFormat);
  begin
    case NewFmt of
      tfMilliSecs : mmt.wType := TIME_MS;
      tfSamples   : mmt.wType := TIME_SAMPLES;
      tfBytes     : mmt.wType := TIME_BYTES;
      tfMIDI      : mmt.wType := TIME_MIDI;
      tfSMPTE     : mmt.wType := TIME_SMPTE;
      tfTicks     : mmt.wType := TIME_TICKS;
    end;
  end;



//----- TobjSimpleWaveIO -------------------------------------------------------
  function TobjSimpleWaveIO.GetTimeFormat : TenmTimeFormat;
  begin
    case mmt.wType of
      TIME_MS      : Result := tfMilliSecs;
      TIME_SAMPLES : Result := tfSamples;
      TIME_BYTES   : Result := tfBytes;
      TIME_MIDI    : Result := tfMIDI;
      TIME_SMPTE   : Result := tfSMPTE;
      TIME_TICKS   : Result := tfTicks;
    end;
  end;



//----- TobjSimpleWaveIO -------------------------------------------------------
  procedure TobjSimpleWaveIO.Initialise;
  begin
    if (Stopping) or (Creating) then
    begin
      cbmmt := 0;
      with mmt do
      begin
        wType  := TIME_SAMPLES;
        ms     := 0;
        sample := 0;
        cb     := 0;
        ticks  := 0;
        hour   := 0;
        min    := 0;
        sec    := 0;
        frame  := 0;
        fps    := 0;
        dummy  := 0;
        songptrpos := 0;
      end;
    end;

    if Destroying then pmmt := nil;
    WaveHdr.lpData := nil;

    if Closing then
    begin
      uDeviceID := 0;
      with wfx do
      begin
        wFormatTag      := 0;
        nChannels       := 0;
        nSamplesPerSec  := 0;
        nAvgBytesPerSec := 0;
        nBlockAlign     := 0;
        wBitsPerSample  := 0;
      end;
      cbwh := 0;
    end;

    if Creating then
    begin
      ptrWaveHdr := @WaveHdr;
      pmmt       := @mmt;
      uDeviceID  := uDeviceID_dflt;
      mmt.wType  := TimeReportFmt;
      State      := prClosed;
    end;

  end;



//----- TobjSimpleWaveIO -------------------------------------------------------
  destructor TobjSimpleWaveIO.Destroy;
  begin
    if integer(State) > integer (prIdle) then Stop;
    Close;
    Destroying := true;
    Initialise;
    inherited Destroy;
  end;



//----- TobjSimpleWaveIO -------------------------------------------------------
  constructor TobjSimpleWaveIO.Create;
  begin
    Inherited Create;
    Creating := true;
    Initialise;
    Creating := false;
  end;



//----- TobjSimpleWaveIO -------------------------------------------------------
  function TobjSimpleWaveIO.Stop: boolean;
  begin
    Stopping := true;
    StopNow := true;
    Result := (State = prIdle) or (State = prClosed);
    if not Result then Result := WaveOutReset (hndWaveOut) = MMSYSERR_NOERROR;
    Initialise;
    if Result then State := prIdle;
    Stopping := false;
  end;



//----- TobjSimpleWaveIO -------------------------------------------------------
  function TobjSimpleWaveIO.Pause: boolean;
  begin
    Result := false;
    if (State = prPlaying) or (State = prRecording) then
    begin
      Result := WaveOutPause (hndWaveOut) = MMSYSERR_NOERROR;
      if Result then
      begin
        State := prPaused;
       // Mute := true;
      end;
    end;
  end;



//----- TobjSimpleWaveIO -------------------------------------------------------
  function TobjSimpleWaveIO.Resume: boolean;
  begin
    Result := false;
    if State <> prPaused then exit;
    Result := WaveOutRestart (hndWaveOut) = MMSYSERR_NOERROR;
    if Result then
    begin
      if WaveOut then State := prPlaying
      else State := prRecording;
  //    Mute := false;
    end;
  end;



//----- TobjSimpleWaveIO -------------------------------------------------------
  function TobjSimpleWaveIO.Close : boolean;
  begin
    if State <> prClosed then
    begin
      MMReturn := WaveOutClose(hndWaveOut);
      Result := MMReturn = MMSYSERR_NOERROR;
      if MMReturn = WAVERR_STILLPLAYING then
      begin
        Stop;
        Result := WaveOutClose(hndWaveOut) = MMSYSERR_NOERROR;
      end;
    end else Result := true;
    
    if Result then
    begin
      State := prClosed;
      Closing := true;
      Initialise;
      Closing := false;
    end;
  end;


//------------------------------------------------------------------------------
//------------------------------------------------------------------------------











//----- TobjPlaySound ----------------------------------------------------------
  procedure TobjPlaySound.Initialise;
  begin
   // inherited Initialise;
    if Closing then
    begin
      hndWaveOut     := 0;
      cbwoc          := 0;
      fdwOpen        := 0;
      FramesReturned := 0;
    end;

    if Destroying then
    begin
      pwoc := nil;
    end;

    if Creating then
    begin
      pwoc               := @woc;
      fdwOpen            := CALLBACK_NULL;
      dwCallback         := 0; //DWORD(@TobjPlaySound.WaveCallback);
      dwCallbackInstance := 0; //DWORD(@WaveHdr);
      WaveOut            := true;
    end;
  end;



//----- TobjPlaySound ----------------------------------------------------------
  procedure TobjPlaySound.DisposeWHDR;
  begin
    WaveOutUnprepareHeader (hndWaveOut, ptrWaveHdr, cbwh);
    WaveHdr.lpData := nil;
  end;



//----- TobjPlaySound ----------------------------------------------------------
  function TobjPlaySound.GetFramesPosn : integer;
  begin
    if WaveOutGetPosition (hndWaveOut, pmmt, cbmmt) = MMSYSERR_NOERROR
      then Result := mmt.sample div WaveSelect.ChnlsReqd
    else Result := -1;
  end;



//----- TobjPlaySound ----------------------------------------------------------
  function TobjPlaySound.GetTimePosn : integer;
  begin
    if WaveOutGetPosition (hndWaveOut, pmmt, cbmmt) = MMSYSERR_NOERROR
      then Result := mmt.ms
    else Result := -1;
  end;



//----- TobjPlaySound ----------------------------------------------------------
  function TobjPlaySound.SetWaveFormatEx : TWAVEFORMATEX;
  const DataTypeFlag = 1;
  begin
    With Result do
    begin
      wFormatTag      := DataTypeFlag;
      nChannels       := WaveSelect.ChnlsReqd;
      nSamplesPerSec  := AudioInfo.Rate;
      nAvgBytesPerSec := AudioInfo.BytesPSec;
      nBlockAlign     := AudioInfo.BlockAlign;
      wBitsPerSample  := AudioInfo.BitsPSmpl;
      if wFormatTag = 1 then cbSize := 0 else cbSize := 256;
      // 256 is arbitrary. Just for while PCM only is supported.
    end;
  end;



//----- TobjPlaySound ----------------------------------------------------------
  function TobjPlaySound.InitPlay (AudInf: PrecAudioInfo;
    WvSlct: PrecProcessData) : boolean;
  begin
    AudioInfo  := AudInf;
    WaveSelect := WvSlct;
    wfx        := SetWaveFormatEx;
    cbwoc      := SizeOf (woc);
    cbmmt      := SizeOf (mmt);
    if WaveOutOpen (@hndWaveOut, uDeviceID, @wfx, dwCallback,
      dwCallbackInstance, WAVE_FORMAT_QUERY) <> MMSYSERR_NOERROR then
    begin
      Result := false;
      ShowMessage ('Audio format not supported by the wave out device.');
      Close;
    end
    else begin
      MMReturn := WaveOutOpen (@hndWaveOut, uDeviceID, @wfx, dwCallback,
      dwCallbackInstance, CALLBACK_NULL);
      Result := MMReturn = MMSYSERR_NOERROR;   // Use of MMReturn for debugging only.
    end;
    if Result then
    begin
      State := prIdle;
      Initialised := true;
    end
    else begin
      ShowMessage ('Unable to open wave out device.');
      Close;
    end;
  end;



//----- TobjPlaySound ----------------------------------------------------------
  function TobjPlaySound.Play (ptrData: pointer) : boolean;
  begin
    Result := false;
    if Initialised then
    begin
      WaveHdr.dwBufferLength := WaveSelect.SelectBytes;
      WaveHdr.lpData         := ptrData;
      WaveHdr.dwFlags        := 0;
      cbwh  := SizeOf (WaveHdr);
      State := prPlaying;

      MMReturn := WaveOutPrepareHeader (hndWaveOut, @WaveHdr, cbwh);
      Result := MMReturn = MMSYSERR_NOERROR;

      if not Result then
      begin
        Close;
        ShowMessage ('Unable to prepare wave out header.');
        Exit;
      end

      else begin
        MMReturn := WaveOutWrite (hndWaveOut, @WaveHdr, cbwh);
        Result := MMReturn = MMSYSERR_NOERROR;
        if not Result then
        begin
          Close;
          ShowMessage ('Unable to send data to wave out device.');
        end
        // Think up a new way to dispose of the Wave Header.
      end;

    end;
  end;



//---- TobjPlaySound -----------------------------------------------------------------------
function TobjPlaySound.NewPosition (WvSlct:PrecProcessData; ptrData:Pointer;
           AState:TenmWIOState) : boolean;
begin
  Stop;
  WaveSelect := WvSlct;
  Initialised := true;
  if (AState = prPlaying) then Result := Play (ptrData)
  else if (AState = prPaused) then Result := Pause;
end;



//----- TobjPlaySound ----------------------------------------------------------
  function TobjPlaySound.Stop : boolean;
  begin
    Result := inherited Stop;
    DisposeWHDR;
  end;



//----- TobjPlaySound ----------------------------------------------------------
  constructor TobjPlaySound.Create;
  begin
    inherited Create;
    Creating := true;
    Initialise;
    Creating := false;
  end;


//==========================================================================================
//==========================================================================================









//----- TobjRecdSound ----------------------------------------------------------
  function TobjRecdSound.Recrd (AudInf: PrecAudioInfo; WvSlct: PrecProcessData): boolean;
  begin
    Result := false;
  { Yet to write }
  end;


//------------------------------------------------------------------------------
//------------------------------------------------------------------------------


end.