Данный документ был создан по многочисленным просьбам пользователей и
описывает дополнительную функциональность компонента Delphi TMediaPlayer. Новая
функциональность компонента заключается в возможности создания при записи нового
файла формата .wav. Процедура "SaveMedia" создает тип record, передаваемый
команде MCISend. Существует исключение, которое вызывает закрытие медиа при
любой ошибке, возникающей при открытии определенного файла. Приложение состоит
из двух кнопок. Button1 вызывает по-порядку процедуры OpenMedia и RecordMedia.
Процедура CloseMedia вызывается при генерации приложением исключительной
ситуации. Button2 вызывает процедуры StopMedia,SaveMedia и CloseMedia.
unit utestrec;
interfaceuses
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 }publicprocedure 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 dobegin
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 dobegin
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;
beginif FDeviceID <> 0 thenbegin
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;
beginif FDeviceID <> 0 thenbegin// сохраняем файл...
Flags := mci_Save_File or mci_Wait;
with MySaveParms dobegin
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;
beginif FDeviceID <> 0 thenbegin
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-файла раздела Мультимедиа Аудио может быть полезна для разработчиков на Delphi и FreePascal.
Комментарии и вопросы
Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.