Валентин Озеров - Советы по Delphi. Версия 1.4.3 от 1.1.2001

Пример:

bin\brcc32 snddata.rc

Это создаст файл 'snddata.res', который Delphi слинкует с EXE-файлом вашего приложения.

Далее приведен необходимый вам код:

unitPlaySnd1;

interface

usesWindows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;

typeTForm1 = class(TForm)

PlaySndFromFile: TButton;

PlaySndFromMemory: TButton;

PlaySndbyLoadRes: TButton;

PlaySndFromRes: TButton;

procedurePlaySndFromFileClick(Sender: TObject);

procedurePlaySndFromMemoryClick(Sender: TObject);

procedurePlaySndFromResClick(Sender: TObject);

procedurePlaySndbyLoadResClick(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

varForm1: TForm1;

implementation

{$R *.DFM}

{$R snddata.res}

usesMMSystem;

procedureTForm1.PlaySndFromFileClick(Sender: TObject);

begin

sndPlaySound('hello.wav', SND_FILENAME orSND_SYNC);

end;

procedureTForm1.PlaySndFromMemoryClick(Sender: TObject);

var

f: file;

p: pointer;

fs: integer;

begin

AssignFile(f, 'hello.wav');

Reset(f,1);

fs := FileSize(f);

GetMem(p, fs);

BlockRead(f, p^, fs);

CloseFile(f);

sndPlaySound(p, SND_MEMORY orSND_SYNC);

FreeMem(p, fs);

end;

procedureTForm1.PlaySndFromResClick(Sender: TObject);

begin

PlaySound('HELLO', hInstance, SND_RESOURCE orSND_SYNC);

end;

procedureTForm1.PlaySndbyLoadResClick(Sender: TObject);

var

h: THandle;

p: pointer;

begin

h := FindResource(hInstance, 'HELLO', 'WAVE');

h := LoadResource(hInstance, h);

p := LockResource(h);

sndPlaySound(p, SND_MEMORY orsnd_sync);

UnLockResource(h);

FreeResource(h);

end;

end.

Тема: Создание нового файла с расширением .wav.

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

unitutestrec;

interface

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

typeTForm1 = class(TForm)

Button1: TButton;

Button2: TButton;

procedureButton1Click(Sender: TObject);

procedureButton2Click(Sender: TObject);

procedureFormCreate(Sender: TObject);

procedureAppException(Sender: TObject; E: Exception);

private

FDeviceID: Word;

{ Private declarations }

public

procedureOpenMedia;

procedureRecordMedia;

procedureStopMedia;

procedureSaveMedia;

procedureCloseMedia;

end;

varForm1: TForm1;

implementation

{$R *.DFM}

varMyError,Flags: Longint;

procedureTForm1.OpenMedia;

var

MyOpenParms: TMCI_Open_Parms;

MyPChar: PChar;

TextLen: Longint;

begin

Flags:=mci_Wait ormci_Open_Element ormci_Open_Type;

withMyOpenParms do begin

dwCallback:=Handle; // TForm1.Handle

lpstrDeviceType:=PChar('WaveAudio');

lpstrElementName:=PChar('');

end;

MyError:=mciSendCommand(0, mci_Open, Flags, Longint(@MyOpenParms));

ifMyError = 0 thenFDeviceID:=MyOpenParms.wDeviceID;

end;

procedureTForm1.RecordMedia;

var

MyRecordParms: TMCI_Record_Parms;

TextLen: Longint;

begin

Flags:=mci_Notify;

withMyRecordParms do begin

dwCallback:=Handle; // TForm1.Handle

dwFrom:=0;

dwTo:=10000;

end;

MyError:=mciSendCommand(FDeviceID, mci_Record, Flags,Longint(@MyRecordParms));

end;

procedureTForm1.StopMedia;

varMyGenParms: TMCI_Generic_Parms;

begin

ifFDeviceID <> 0 then begin

Flags:=mci_Wait;

MyGenParms.dwCallback:=Handle; // TForm1.Handle

MyError:=mciSendCommand(FDeviceID, mci_Stop, Flags,Longint(@MyGenParms));

end;

end;

procedureTForm1.SaveMedia;

type // не реализовано в Delphi

PMCI_Save_Parms = ^TMCI_Save_Parms;

TMCI_Save_Parms = record

dwCallback: DWord;

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

end;

varMySaveParms: TMCI_Save_Parms;

begin

ifFDeviceID <> 0 then begin

// сохраняем файл...

Flags:=mci_Save_File ormci_Wait;

withMySaveParms do begin

dwCallback:=Handle;

lpstrFileName:=PChar('c:\message.wav');

end;

MyError:=mciSendCommand(FDeviceID, mci_Save, Flags,Longint(@MySaveParms));

end;

end;

procedureTForm1.CloseMedia;

varMyGenParms: TMCI_Generic_Parms;

begin

ifFDeviceID <> 0 then begin

Flags:=0;

MyGenParms.dwCallback:=Handle; // TForm1.Handle

MyError:=mciSendCommand(FDeviceID, mci_Close, Flags,Longint(@MyGenParms));

ifMyError = 0 thenFDeviceID:=0;

end;

end;

procedureTForm1.Button1Click(Sender: TObject);

begin

OpenMedia;

RecordMedia;

end;

procedureTForm1.Button2Click(Sender: TObject);

begin

StopMedia;

SaveMedia;

CloseMedia;

end;

procedureTForm1.FormCreate(Sender: TObject);

begin

Application.OnException := AppException;

end;

procedureTForm1.AppException(Sender: TObject; E: Exception);

begin

CloseMedia;

end;

end.

Nomadicсоветует:

Да всё пpосто. Даже, я бы сказал, тyпо. :-)

INT GetMasterVolumeControlID() {

// get dwLineID

MIXERLINE mxl;

mxl.cbStruct = sizeof(MIXERLINE);

mxl.dwComponentType = MIXERLINE_COMPONENTTYPE_DST_SPEAKERS;

if (::mixerGetLineInfo((HMIXEROBJ)ghmx, &mxl, MIXER_OBJECTF_HMIXER | MIXER_GETLINEINFOF_COMPONENTTYPE) != MMSYSERR_NOERROR) return 34;

// get dwControlID

MIXERCONTROL mxc;

MIXERLINECONTROLS mxlc;

mxlc.cbStruct = sizeof(MIXERLINECONTROLS);

mxlc.dwLineID = mxl.dwLineID;

mxlc.dwControlType = MIXERCONTROL_CONTROLTYPE_VOLUME;

mxlc.cControls = 1;

mxlc.cbmxctrl = sizeof(MIXERCONTROL);

mxlc.pamxctrl = &mxc;

if (::mixerGetLineControls((HMIXEROBJ)ghmx, &mxlc, MIXER_OBJECTF_HMIXER | MIXER_GETLINECONTROLSF_ONEBYTYPE) != MMSYSERR_NOERROR) return 34;