Programming Languages Suite/ProgLangD.iso/TURBOPASCAL WIN/OWLDEMOS.PAK/MCISOUND.PAS

Pascal/Delphi Source File | 1992-06-08 | 19.2 KB | 699 lines

{***************************************************}
{                                                   }
{   Turbo Pascal for Windows                        }
{   Windows 3.1 MCI API Sound Support               }
{               Demonstration Program               }
{                                                   }
{   Copyright (c) 1992 by Borland International     }
{                                                   }
{***************************************************}

program MCISound;

{ This example demonstrates the use of MCI APIs in Windows 3.1 in an
  OWL application.  You must have a sound board and its device driver
  properly installed under Windows 3.1.

  You may copy one of the .WAV files from the WINDOW subdirectory in
  your system to this example's subdirectory.

  Run the .EXE choose Open from the File menu and select a .WAV file.
  Choose Play from the Options menu and control of the sound is done
  via the Options menu and the scroll bar. The Options menu lets you
  stop/play/pause and resume.  The scrollbar allows random access
  through the waveform while it is playing.

  This example demostrates the use MCI API and use of a callback
}

uses Strings, WinTypes, WinProcs, WObjects, WinDOS, Win31, ShellAPI,
  MMSystem, CommDlg, BWCC;

{$R MCISOUND}

const

{ Resource IDs }

  id_Menu  = 100;
  id_About = 100;
  id_Instr = 101;   { Instructions }
  id_Icon  = 100;

{ Menu command IDs }

  cm_FileOpen   = 201;
  cm_HelpAbout  = 300;
  cm_SoundPlay  = 301;
  cm_SoundPause = 302;

  id_Scroll = 150;  { Scroll bar }
  Timer_Id  = 264;  { Unique timer ID. }

type

{ Filename string }

  TFilename = array[0..255] of Char;

{ Sound Control Scroll Bar }

  PSoundBar = ^TSoundBar;
  TSoundBar = object(TScrollBar)
    WaveRatio  : Integer;
    WaveLength : Longint;
    ElementName: TFilename;

    procedure RePosAndPlay(NewPos: Longint); virtual;

    procedure ScrollSetInfo(WRatio: Integer; WLength: Longint); virtual;
    procedure ScrollSetName(EName: PChar); virtual;

    procedure SBLineUp(var Msg: TMessage);
      virtual nf_First + sb_LineUp;
    procedure SBLineDown(var Msg: TMessage);
      virtual nf_First + sb_LineDown;
    procedure SBPageUp(var Msg: TMessage);
      virtual nf_First + sb_PageUp;
    procedure SBPageDown(var Msg: TMessage);
      virtual nf_First + sb_PageDown;
    procedure SBThumbPosition(var Msg: TMessage);
      virtual nf_First + sb_ThumbPosition;
    procedure SBTop(var Msg: TMessage);
      virtual nf_First + sb_Top;
    procedure SBBottom(var Msg: TMessage);
      virtual nf_First + sb_Bottom;
  end;

{ Application main window }

  PSoundWindow = ^TSoundWindow;
  TSoundWindow = object(TWindow)
    ElementName: TFilename;
    IsRunning  : Boolean;
    Paused     : Boolean;
    TimerGoing : Boolean;
    WaveRatio  : Integer;
    WaveLength : Longint;
    SoundBar   : PSoundBar;

    MciGenParm   : TMCI_Generic_Parms;
    MciOpenParm  : TMCI_Open_Parms;
    MciPlayParm  : TMCI_Play_Parms;
    MciStatusParm: TMCI_Status_Parms;
    MciSetParm   : TMCI_Set_Parms;

    constructor Init(AParent: PWindowsObject; ATitle: PChar);
    destructor  Done; virtual;

    procedure GetDeviceInfo;     virtual;
    procedure StopWave;          virtual;
    procedure UpdateSoundWindow; virtual;

    procedure GetWindowClass(var AWndClass: TWndClass); virtual;
    function  GetClassName: PChar; virtual;
    procedure SetupWindow; virtual;

    procedure MciNotify(var Msg: TMessage);
      virtual wm_First + mm_MCINotify;

    procedure Paint(PaintDC: HDC; var PaintInfo: TPaintStruct); virtual;

    procedure CMFileOpen(var Msg: TMessage);
      virtual cm_First + cm_FileOpen;
    procedure CMSoundPlay(var Msg: TMessage);
      virtual cm_First + cm_SoundPlay;
    procedure CMSoundPause(var Msg: TMessage);
      virtual cm_First + cm_SoundPause;
    procedure CMHelpAbout(var Msg: TMessage);
      virtual cm_First + cm_HelpAbout;

    procedure WMIdleStuff(var Msg: TMessage);
      virtual wm_First + wm_Timer;
  end;

{ Application object }

  TSoundApp = object(TApplication)
    procedure InitInstance;   virtual;
    procedure InitMainWindow; virtual;
  end;

{ Initialized globals }

const
  DemoTitle  : PChar   = 'MCI Sound Demo Program';
  DeviceID   : Word    = 0;
  FlushNotify: Boolean = FALSE;

{ Global variables }

var
  App: TSoundApp;


{ TSoundBar Methods }

procedure TSoundBar.RePosAndPlay(NewPos: Longint);
var
  MciSeekParm  : TMCI_Seek_Parms;
  MciGenParm   : TMCI_Generic_Parms;
  MciOpenParm  : TMCI_Open_Parms;
  MciPlayParm  : TMCI_Play_Parms;
  MciStatusParm: TMCI_Status_Parms;
  MciSetParm   : TMCI_Set_Parms;
begin
{ Only allow SEEK if playing. }

  if DeviceID = 0 then
    Exit;

{ Close the currently playing wave.
}
  FlushNotify := True;
  MciGenParm.dwCallback := 0;
  mciSendCommand(DeviceID, mci_Stop,  mci_Wait, Longint(@MciGenParm));
  mciSendCommand(DeviceID, mci_Close, mci_Wait, Longint(@MciGenParm));

{ Open the wave again and seek to new position.
}
  MciOpenParm.dwCallback := 0;
  MciOpenParm.wDeviceID  := DeviceID;
  MciOpenParm.wReserved0 := 0;
  MciOpenParm.lpstrDeviceType := nil;
  MciOpenParm.lpstrElementName:= ElementName;
  MciOpenParm.lpstrAlias      := nil;

  if mciSendCommand(DeviceID, mci_Open, mci_Wait or mci_Open_Element,
      Longint(@MciOpenParm)) <> 0 then
    MessageBox(HWindow, 'Open Error', DemoTitle, mb_OK)
  else
  begin
    DeviceID := MciOpenParm.wDeviceID;

{ Our time scale is in SAMPLES.
}
    MciSetParm.dwTimeFormat := mci_Format_Samples;
    if mciSendCommand(DeviceID, mci_Set, mci_Set_Time_Format,
        Longint(@MciSetParm)) <> 0 then
      MessageBox(HWindow, 'Set Time Error', DemoTitle, mb_OK)
    else
    begin
{ Compute new position, remember the scrollbar range has been scaled based
  on waveRatio.
}
      MciSeekParm.dwCallback:= 0;
      if (NewPos * WaveRatio) > WaveLength then
        MciSeekParm.dwTo := WaveLength
      else
        MciSeekParm.dwTo := NewPos * WaveRatio;

      if mciSendCommand(DeviceID, mci_Seek, mci_To,
          Longint(@MciSeekParm)) <> 0 then
        MessageBox(HWindow, 'Seek Error', DemoTitle, mb_OK)
      else
      begin
    MciPlayParm.dwCallback:= HWindow;
    MciPlayParm.dwFrom    := 0;
    MciPlayParm.dwTo      := 0;
    if mciSendCommand(DeviceID, mci_Play, mci_Notify,
        Longint(@MciPlayParm)) <> 0 then
          MessageBox(HWindow, 'Play Error', DemoTitle, mb_OK);
      end;
    end;
  end;  { Playing }
end;

{ Sets the given ratio and length as the current WaveRatio and WaveLength
  of the Sound Bar.
}
procedure TSoundBar.ScrollSetInfo(WRatio: Integer; WLength: Longint);
begin
  WaveRatio  := WRatio;
  WaveLength := WLength;
end;

{ Sets the given string as the name of the SoundBar.
}
procedure TSoundBar.ScrollSetName(EName: PChar);
begin
  StrCopy(ElementName, EName);
end;

{ Responds to a click on the Scroll Bar's up-arrow by stepping
  the wave.  Calls on the inherited SBLineUp to do the actual
  update of the scroll bar, then uses the new position for the
  sound.
}
procedure TSoundBar.SBLineUp(var Msg: TMessage);
begin
  TScrollBar.SBLineUp(Msg);
  RePosAndPlay(GetPosition);
end;

{ Responds to a click on the Scroll Bar's down-arrow as above.
}
procedure TSoundBar.SBLineDown(var Msg: TMessage);
begin
  TScrollBar.SBLineDown(Msg);
  RePosAndPlay(GetPosition);
end;

{ Responds to a click on the Scroll Bar's page-up area as above.
}
procedure TSoundBar.SBPageUp(var Msg: TMessage);
begin
  TScrollBar.SBPageUp(Msg);
  RePosAndPlay(GetPosition);
end;

{ Responds to a click on the Scroll Bar's page-down area as above.
}
procedure TSoundBar.SBPageDown(var Msg: TMessage);
begin
  TScrollBar.SBPageDown(Msg);
  RePosAndPlay(GetPosition);
end;

{ Responds to a movement of the Scroll Bar's thumb as above.
}
procedure TSoundBar.SBThumbPosition(var Msg: TMessage);
begin
  TScrollBar.SBThumbPosition(Msg);
  RePosAndPlay(GetPosition);
end;

{ Responds to movement of the scroll bar to the Top as above.
}
procedure TSoundBar.SBTop(var Msg: TMessage);
begin
  TScrollBar.SBTop(Msg);
  RePosAndPlay(GetPosition);
end;

{ Responds to movement of the scroll bar to the Bottom as above.
}
procedure TSoundBar.SBBottom(var Msg: TMessage);
begin
  TScrollBar.SBBottom(Msg);
  RePosAndPlay(GetPosition);
end;


{ TSoundWindow Methods }

{ Constructs an instance of the TSoundWindow, positioning it and setting
  its data fields to their initial values.
}
constructor TSoundWindow.Init(AParent: PWindowsObject; ATitle: PChar);
begin
  TWindow.Init(AParent, ATitle);

  Attr.X := 50;
  Attr.Y := 100;
  Attr.W := 400;
  Attr.H := 150;

  IsRunning  := False;
  Paused     := False;
  WaveLength := 0;
  WaveRatio  := 0;
  StrCopy(ElementName, '');

  SoundBar := New(PSoundBar, Init(@Self, id_Scroll, 50, 50, 300, 0, True));
  SoundBar^.SetRange(0, 0);
end;

{ Destroys an instance of the Sound Window.  Before calling the ancestral
  destructor to remove the object, stops the current wave.
}
destructor TSoundWindow.Done;
begin
  StopWave;
  TWindow.Done;
end;


{ Repaints the window, posting information about the current sound.
}
procedure TSoundWindow.Paint(PaintDC: HDC; var PaintInfo: TPaintStruct);
var
  Buffer: array [0..100] of Char;
begin
{ File Name }
  if StrLen(ElementName) > 0 then
    TextOut(PaintDC, 5, 5, ElementName, StrLen(ElementName))
  else
    TextOut(PaintDC, 5, 5, '<No WAVEFORM file loaded>', 25);

{ Beginning value }
  TextOut (PaintDC, 50, 30, '0', 1);

{ Ending number of samples }
  if WaveLength <> 0 then
    Str(WaveLength * WaveRatio, Buffer)
  else
    StrCopy(Buffer, 'Unknown');
  TextOut(PaintDC, 325, 30, Buffer, StrLen(Buffer));
end;

{ Redefines GetWindowClass to give this application an icon and a menu.
}
procedure TSoundWindow.GetWindowClass(var AWndClass: TWndClass);
begin
  TWindow.GetWindowClass(AWndClass);
  AWndClass.lpszMenuName := PChar(id_Menu);
end;

{ Returns the class name of this window.  This is necessary since we
  redefine the inherited GetWindowClass method, above.
}
function TSoundWindow.GetClassName: PChar;
begin
  GetClassName := 'SoundPlay';
end;

{ Completes the initialization of the Window, performing
  those functions which require a valid window handle.
}
procedure TSoundWindow.SetupWindow;
begin
  TWindow.SetupWindow;
  if WaveOutGetNumDevs = 0 then
  begin
    MessageBox(HWindow, 'No Wave Output device is available', 'Sound Demo',
      mb_OK or mb_IconStop);
    PostQuitMessage(0);
  end;
end;

{ Obtains information about the system's sound generating capabilities.
}
procedure TSoundWindow.GetDeviceInfo;
var
  WOutCaps: TWaveOutCaps;
begin
  if WaveOutGetDevCaps(DeviceID, @WOutCaps, SizeOf(WOutCaps)) <> 0 then
    MessageBox(HWindow, 'GetDevCaps Error', 'Sound Demo', mb_OK);
end;


{ Plays the wave on request.
}
procedure TSoundWindow.CMSoundPlay(var Msg: TMessage);
var
  MyMenu : HMenu;
  Res    : Longint;
  ErrMsg : array [0..255] of Char;
begin
  if not IsRunning then
  begin
{ MCI APIs to open a device and play a .WAV file, using notification to close
}
    MciOpenParm.dwCallback := 0;
    MciOpenParm.wDeviceID  := 0;
    MciOpenParm.wReserved0 := 0;
    MciOpenParm.lpstrDeviceType  := nil;
    MciOpenParm.lpstrElementName := ElementName;
    MciOpenParm.lpstrAlias       := nil;

    if mciSendCommand(0, mci_Open, (mci_Wait or mci_Open_Element),
        Longint(@MciOpenParm)) <> 0 then
      MessageBox(HWindow, 'Open Error - A waveForm output device is ' +
          'necessary to use this demo.', 'Sound Demo', mb_OK)
    else
    begin
      DeviceID := MciOpenParm.wDeviceID;

{ The time format in this demo is in Samples.
}
      MciSetParm.dwCallback   := 0;
      MciSetParm.dwTimeFormat := mci_Format_Samples;
      if mciSendCommand(DeviceID, mci_Set, mci_Set_Time_Format,
      Longint(@MciSetParm)) <> 0 then
      begin
        StopWave;
    MessageBox(HWindow, 'SetTime Error', 'Sound Demo', mb_OK)
      end
      else
      begin
        MciPlayParm.dwCallback := HWindow;
        MciPlayParm.dwFrom     := 0;
        MciPlayParm.dwTo       := 0;

    Res := mciSendCommand(DeviceID, mci_Play, mci_Notify,
      Longint(@MciPlayParm));
        if Res <> 0 then
        begin
          mciGetErrorString(Res, ErrMsg, SizeOf(ErrMsg));
      MessageBox(HWindow, ErrMsg, 'Sound Demo', mb_OK or mb_IconStop);
          StopWave;
        end
        else
        begin
{ Modify the menu to toggle PLAY to STOP, and enable PAUSE.
}
          MyMenu := GetMenu(HWindow);
          ModifyMenu(MyMenu, cm_SoundPlay, mf_String, cm_SoundPlay, '&Stop');
      EnableMenuItem(MyMenu, cm_SoundPause, mf_Enabled);

{ Make sure the Play/Stop toggle menu knows we're running.
}
      IsRunning := True;

{ Start a timer to show our progress through the waveform file.
}
          TimerGoing := (SetTimer(HWindow, Timer_Id, 500, nil) <> 0);

{ Give enough information to the scrollbar to monitor the progress and issue a re-mci_Open.
}
          SoundBar^.ScrollSetName(ElementName);
        end;
      end;
    end;
  end
  else
  begin
{ Stop menu is toggled so kill the timer and stop the wave.
}
    KillTimer(HWindow, Timer_Id);
    StopWave;
  end;
end;

{ Pauses or resumes the playback in response to requests to do so from
  the menu.  The File | Pause selection acts as a toggle.
}
procedure TSoundWindow.CMSoundPause(var Msg: TMessage);
var
  MyMenu: HMenu;
begin
  MyMenu := GetMenu(HWindow);

  if not Paused then
  begin       { Pause the playing. }
    MciGenParm.dwCallback := 0;
    mciSendCommand(DeviceID, mci_Pause, mci_Wait, Longint(@MciGenParm));

    ModifyMenu(MyMenu, cm_SoundPause, mf_String, cm_SoundPause,
      '&Resume'^I'Ctrl+P');
  end
  else
  begin       { Resume the playing. }
    MciGenParm.dwCallback := 0;
    mciSendCommand(DeviceID, mci_Resume, mci_Wait, Longint(@MciGenParm));

    ModifyMenu(MyMenu, cm_SoundPause, mf_String, cm_SoundPause,
      'P&ause'^I'Ctrl+P');
  end;

  Paused := not Paused;
end;

{ Posts the About Box for the Sound Demo.
}
procedure TSoundWindow.CMHelpAbout(var Msg: TMessage);
begin
  Application^.ExecDialog(New(PDialog, Init(@Self, PChar(id_About))));
end;

{ Stops the playing waveform file, and closes the waveform device.
}
procedure TSoundWindow.StopWave;
var
  MyMenu: HMenu;
begin
  if DeviceID <> 0 then
  begin
    MciGenParm.dwCallback := 0;
    mciSendCommand(DeviceID, mci_Stop,  mci_Wait, Longint(@MciGenParm));
    mciSendCommand(DeviceID, mci_Close, mci_Wait, Longint(@MciGenParm));

{ Reset the menus to Play menu and gray the Pause menu.
}
    MyMenu := GetMenu(HWindow);
    ModifyMenu(MyMenu, cm_SoundPlay,  mf_String, cm_SoundPlay,
      '&Play'^I'Ctrl+P');
    ModifyMenu(MyMenu, cm_SoundPause, mf_String or mf_Grayed, cm_SoundPause,
      'P&ause'^I'Ctrl+A');

    IsRunning := FALSE;
    DeviceID  := 0;
  end;
end;

{ Posts the file open dialog, gets a wave file name, and updates the sound
  window to use it.
}
procedure TSoundWindow.CMFileOpen(var Msg: TMessage);
const
  DefExt = 'wav';
var
  OpenFN   : TOpenFileName;
  Filter   : array [0..100] of Char;
  FileName : TFilename;
  WinDir   : array [0..145] of Char;
  MyMenu   : HMenu;
begin
  GetWindowsDirectory(WinDir, SizeOf(WinDir));
  SetCurDir(WinDir);
  StrCopy(FileName, '');

{ Set up a filter buffer to look for Wave files only.  Recall that filter
  buffer is a set of string pairs, with the last one terminated by a
  double-null.
}
  FillChar(Filter, SizeOf(Filter), #0);  { Set up for double null at end }
  StrCopy(Filter, 'Wave Files');
  StrCopy(@Filter[StrLen(Filter)+1], '*.wav');

  FillChar(OpenFN, SizeOf(TOpenFileName), #0);

  with OpenFN do
  begin
    hInstance     := HInstance;
    hwndOwner     := HWindow;
    lpstrDefExt   := DefExt;
    lpstrFile     := ElementName;
    lpstrFilter   := Filter;
    lpstrFileTitle:= nil;     {Title not needed right now ... use full path }
    flags         := ofn_FileMustExist;
    lStructSize   := SizeOf(TOpenFileName);
    nFilterIndex  := 1;       {Use first Filter String in lpstrFilter}
    nMaxFile      := SizeOf(FileName);
  end;
{ If a file is selected, turn the Play menu on, and update the sound
  window to show the new file name.
}
  if GetOpenFileName(OpenFN) then
  begin
    MyMenu := GetMenu(HWindow);
    EnableMenuItem(MyMenu, cm_SoundPlay, mf_Enabled);

    WaveLength := 0;
    WaveRatio  := 0;
    UpdateSoundWindow;
  end;
end;

{ Responds to mm_MCINotify messages when mci_Play is complete.  If the
  Stop/Close is from the thumb movement, then ignore it.  Otherwise,
  kill the timer and reset the scroller.
}
procedure TSoundWindow.MciNotify(var Msg: TMessage);
var
  LoVal, HiVal: Integer;
begin
  if not FlushNotify then
  begin               { Internal STOP/CLOSE, from thumb re-pos? }
    if TimerGoing then
    begin               { No, normal close. }
      KillTimer(HWindow, Timer_Id);
{ Make sure the thumb is at the end. There could be some wm_Timer
  messages on the queue when we kill it, thereby flushing wm_Timer's
  from the message queue.
}
      SoundBar^.GetRange(LoVal, HiVal);
      SoundBar^.SetPosition(HiVal);
    end;

    StopWave;
  end;
  FlushNotify := False;  { Yes, so ignore the close. }
end;

{ Invalidates the client area of the Sound Window so that the
  information display will get updated.
}
procedure TSoundWindow.UpdateSoundWindow;
begin
  InvalidateRect(HWindow, nil, True);
end;

{ Processes wm_Timer events.
}
procedure TSoundWindow.WMIdleStuff(var Msg: TMessage);
begin
  if not FlushNotify then
  begin            { Internal STOP/CLOSE, from thumb re-pos? }
    MciStatusParm.dwCallback := 0;     { No, normal close. }
    MciStatusParm.dwItem     := mci_Status_Length;
    mciSendCommand(DeviceID, mci_Status, mci_Status_Item,
      Longint(@MciStatusParm));

{ If the wavelength has changed, update the scroll bar numbers.
}
    if WaveLength <> MciStatusParm.dwReturn then
    begin
      UpdateSoundWindow;
      WaveLength := MciStatusParm.dwReturn;
    end;

{ Compute the length and ratio and update SoundBar info.
}
    WaveRatio := Round((WaveLength / 32000) + 0.5);
    SoundBar^.ScrollSetInfo(WaveRatio, WaveLength);
    SoundBar^.SetRange(0, Round(WaveLength / WaveRatio));

{ Update the current position.
}
    MciStatusParm.dwCallback := 0;
    MciStatusParm.dwItem     := mci_Status_Position;
    mciSendCommand(DeviceID, mci_Status, mci_Status_Item,
      Longint(@MciStatusParm));

    SoundBar^.SetPosition(Round(MciStatusParm.dwReturn / WaveRatio));
  end;

  FlushNotify := False;   { Yes, ignore this close. }
end;


{ TDragApp Methods }

{ Creates the application's main window.
}
procedure TSoundApp.InitMainWindow;
begin
  MainWindow := New(PSoundWindow, Init(nil, Application^.Name));
end;

{ Initializes this instance of the Sound Application.  Redefined
  to load the accelerators.
}
procedure TSoundApp.InitInstance;
begin
  TApplication.InitInstance;
  HAccTable := LoadAccelerators(HInstance, 'ACCELERATORS_1');
end;


{ Main Program }

begin
  App.Init(DemoTitle);
  App.Run;
  App.Done;
end.