Создание нового WAV-файла

Данный документ был создан по многочисленным просьбам пользователей и описывает дополнительную функциональность компонента Delphi TMediaPlayer. Новая функциональность компонента заключается в возможности создания при записи нового файла формата .wav. Процедура "SaveMedia" создает тип record, передаваемый команде MCISend. Существует исключение, которое вызывает закрытие медиа при любой ошибке, возникающей при открытии определенного файла. Приложение состоит из двух кнопок. Button1 вызывает по-порядку процедуры OpenMedia и RecordMedia. Процедура CloseMedia вызывается при генерации приложением исключительной ситуации. Button2 вызывает процедуры StopMedia,SaveMedia и CloseMedia.

unit
 utestrec;

interface


uses

  Windows, Messages, SysUtils, Classes, Graphics, Controls,
  Forms, Dialogs, MPlayer, MMSystem, StdCtrls;

type

  TForm1 = class
(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure
 Button1Click(Sender: TObject);
    procedure
 Button2Click(Sender: TObject);
    procedure
 FormCreate(Sender: TObject);
    procedure
 AppException(Sender: TObject; E: Exception);
  private

    FDeviceID: Word;
    { Private declarations }
  public

    procedure
 OpenMedia;
    procedure
 RecordMedia;
    procedure
 StopMedia;
    procedure
 SaveMedia;
    procedure
 CloseMedia;
  end
;

var

  Form1: TForm1;

implementation


{$R *.DFM}

var

  MyError, Flags: Longint;

procedure
 TForm1.OpenMedia;
var

  MyOpenParms: TMCI_Open_Parms;
  MyPChar: PChar;
  TextLen: Longint;
begin

  Flags := mci_Wait or
 mci_Open_Element or
 mci_Open_Type;
  with
 MyOpenParms do

  begin

    dwCallback := Handle; // TForm1.Handle
    lpstrDeviceType := PChar('WaveAudio');
    lpstrElementName := PChar('');
  end
;
  MyError := mciSendCommand(0, mci_Open, Flags,
    Longint(@MyOpenParms));
  if
 MyError = 0 then

    FDeviceID := MyOpenParms.wDeviceID;
end
;

procedure
 TForm1.RecordMedia;
var

  MyRecordParms: TMCI_Record_Parms;
  TextLen: Longint;
begin

  Flags := mci_Notify;
  with
 MyRecordParms do

  begin

    dwCallback := Handle; // TForm1.Handle
    dwFrom := 0;
    dwTo := 10000;
  end
;
  MyError := mciSendCommand(FDeviceID, mci_Record, Flags,
    Longint(@MyRecordParms));
end
;

procedure
 TForm1.StopMedia;
var

  MyGenParms: TMCI_Generic_Parms;
begin

  if
 FDeviceID <> 0 then

  begin

    Flags := mci_Wait;
    MyGenParms.dwCallback := Handle; // TForm1.Handle
    MyError := mciSendCommand(FDeviceID, mci_Stop, Flags,
      Longint(@MyGenParms));
  end
;
end
;

procedure
 TForm1.SaveMedia;
type
 // не реализовано в Delphi
  PMCI_Save_Parms = ^TMCI_Save_Parms;
  TMCI_Save_Parms = record

    dwCallback: DWord;
    lpstrFileName: PAnsiChar; // имя файла, который нужно сохранить
  end
;
var

  MySaveParms: TMCI_Save_Parms;
begin

  if
 FDeviceID <> 0 then

  begin

    // сохраняем файл...
    Flags := mci_Save_File or
 mci_Wait;
    with
 MySaveParms do

    begin

      dwCallback := Handle;
      lpstrFileName := PChar('c:message.wav');
    end
;
    MyError := mciSendCommand(FDeviceID, mci_Save, Flags,
      Longint(@MySaveParms));
  end
;
end
;

procedure
 TForm1.CloseMedia;
var

  MyGenParms: TMCI_Generic_Parms;
begin

  if
 FDeviceID <> 0 then

  begin

    Flags := 0;
    MyGenParms.dwCallback := Handle; // TForm1.Handle
    MyError := mciSendCommand(FDeviceID, mci_Close, Flags,
      Longint(@MyGenParms));
    if
 MyError = 0 then

      FDeviceID := 0;
  end
;
end
;

procedure
 TForm1.Button1Click(Sender: TObject);
begin

  OpenMedia;
  RecordMedia;
end
;

procedure
 TForm1.Button2Click(Sender: TObject);
begin

  StopMedia;
  SaveMedia;
  CloseMedia;
end
;

procedure
 TForm1.FormCreate(Sender: TObject);
begin

  Application.OnException := AppException;
end
;

procedure
 TForm1.AppException(Sender: TObject; E: Exception);
begin

  CloseMedia;
end
;

end
.

Другое по теме:

• Как воспроизвести wav-файл из ресурса (в EXE)
• Работа с микрофоном
• Изменение громкости