Тема : Как заставить приложение Delphi 2 `петь`.

Данный совет демонстрирует четыре различных способа как заставить ваше Delphi 2.0 приложение `петь`, т.е. загружать и проигрывать звуковой файл:

1. Для проигрывания звукового файла используйте непосредственно функцию sndPlaySound().

2. Считывайте звуковой файл в память, затем для его проигрывания используйте sndPlaySound().

3. Используйте sndPlaySound для непосредственного проигрывания звуковых файлов, расположенных в файлах ресурсов, прилинкованных к вашему приложению.

4. Считывайте звуковой файл, располагаемый в файле ресурса, прилинкованному к вашему приложению, в память, и затем для его проигрывания используйте sndPlaySound().

Для построения проекта вам понадобиться:

1. Создайте звуковой файл с именем "hello.wav" в каталоге проекта.

2. Создайте текстовый файл с именем "snddata.rc" в каталоге проекта.

3. Добавьте следующую строку к файлу "snddata.rc":

.

4. В dos-сессии перейдите в ваш каталог приложения и скомпилируйте.rc-файл, используя компилятор ресурсов Borland (brcc32.exe): введите путь к brcc32.exe и передайте "snddata.rc" в качестве параметра.

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

uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;

type TForm1 = class (TForm)

procedure PlaySndFromFileClick(Sender: TObject);

procedure PlaySndFromMemoryClick(Sender: TObject);

procedure PlaySndFromResClick(Sender: TObject);

procedure PlaySndbyLoadResClick(Sender: TObject);

procedure TForm1.PlaySndFromFileClick(Sender: TObject);

sndPlaySound("hello.wav", SND_FILENAME or SND_SYNC);

procedure TForm1.PlaySndFromMemoryClick(Sender: TObject);

sndPlaySound(p, SND_MEMORY or SND_SYNC);

procedure TForm1.PlaySndFromResClick(Sender: TObject);

PlaySound("HELLO", hInstance, SND_RESOURCE or SND_SYNC);

procedure TForm1.PlaySndbyLoadResClick(Sender: TObject);

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

h:= LoadResource(hInstance, h);

sndPlaySound(p, SND_MEMORY or snd_sync);

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

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

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

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

type TForm1 = class (TForm)

procedure

procedure Button2Click(Sender: TObject);

procedure

procedure AppException(Sender: TObject; E: Exception );

procedure RecordMedia;

procedure CloseMedia;

var MyError,Flags: Longint;

procedure TForm1.OpenMedia;

MyOpenParms: TMCI_Open_Parms;

Flags:=mci_Wait or mci_Open_Element or mci_Open_Type;

with MyOpenParms do begin

lpstrDeviceType:=PChar("WaveAudio");

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

if MyError = 0 then FDeviceID:=MyOpenParms.wDeviceID;

procedure TForm1.RecordMedia;

MyRecordParms: TMCI_Record_Parms;

with MyRecordParms do begin

dwCallback:=Handle; // TForm1.Handle

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

procedure TForm1.StopMedia;

var

if FDeviceID <> 0 then begin

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

procedure TForm1.SaveMedia;

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

PMCI_Save_Parms = ^TMCI_Save_Parms;

TMCI_Save_Parms = record

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

var MySaveParms: TMCI_Save_Parms;

if FDeviceID <> 0 then begin

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

Flags:=mci_Save_File or mci_Wait;

with MySaveParms do begin

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

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

procedure TForm1.CloseMedia;

var MyGenParms: TMCI_Generic_Parms;

if FDeviceID <> 0 then begin

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

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

if MyError = 0 then FDeviceID:=0;

procedure

procedure TForm1.Button2Click(Sender: TObject);

procedure

Application.OnException:= AppException;

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

Как реализовать регулятор громкости?

Nomadic советует:

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

INT GetMasterVolumeControlID() {

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;

mxlc.cbStruct = sizeof(MIXERLINECONTROLS);

mxlc.dwLineID = mxl.dwLineID;

mxlc.dwControlType = MIXERCONTROL_CONTROLTYPE_VOLUME;

mxlc.cbmxctrl = sizeof(MIXERCONTROL);

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

BOOL SetMasterVolume(DWORD dwVolume) {

MIXERCONTROLDETAILS_UNSIGNED mxcd_u;

mxcd.cbStruct = sizeof(mxcd);

mxcd.dwControlID = MasterVolumeControlID;

mmr = mixerGetControlDetails((HMIXEROBJ)ghmx, &mxcd, 0L);

mmr = mixerSetControlDetails((HMIXEROBJ)ghmx, &mxcd, 0L);

if (MMSYSERR_NOERROR != mmr) return FALSE;

Переписывать на Delphi, думаю, ни к чему. Надо лишь не забыть добавить uses MMSystem; Громкость отдельных каналов очень просто устанавливается через auxSetVolume и аналогичные.

Как использовать в своей программе API DirectSound и DirectSound3D?

Nomadic советует:

Пример 1

Представляю вашему вниманию рабочий пример использования DirectSound на Delphi + несколько полезных процедур. В этом примере создается один первичный SoundBuffer и 2 статических, вторичных; в них загружаются 2 WAV файла. Первичный буфер создается процедурой AppCreateWritePrimaryBuffer, а любой вторичный - AppCreateWritePrimaryBuffer. Так как вторичный буфер связан с WAV файлом, то при создании буфера нужно определить его параметры в соответствии со звуковым файлом, эти характеристики (Samples, Bits, IsStereo) задаются в виде параметров процедуры. Time - время WAV"файла в секундах (округление в сторону увеличения). При нажатии на кнопку происходит микширование из вторичных буферов в первичный. AppWriteDataToBuffer позволяет записать в буфер PCM сигнал. Процедура CopyWAVToBuffer открывает WAV файл, отделяет заголовок, читает чанк "data" и копирует его в буфер (при этом сначала считывается размер данных, так как в некоторых WAV файлах существует текстовый довесок, и если его не убрать, в динамиках возможен треск).

PS. Если есть какие-нибудь вопросы, постараюсь на них ответить.

uses

type TForm1 = class (TForm)

procedure FormCreate(Sender: TObject);

procedure

procedure Button1Click(Sender: TObject);

SecondarySoundBuffer: array of IDirectSoundBuffer;

procedure

procedure AppCreateWriteSecondaryBuffer(var

procedure var

procedure CopyWAVToBuffer(Name: PChar;

var

procedure TForm1.FormCreate(Sender: TObject);

if DirectSoundCreate(nil , DirectSound, nil ) <> DS_OK then Raise

AppCreateWriteSecondaryBuffer(SecondarySoundBuffer, 22050, 8,False, 10);

AppCreateWriteSecondaryBuffer(SecondarySoundBuffer, 22050, 16, True, 1);

procedure

if Assigned(DirectSoundBuffer) then DirectSoundBuffer.Release;

for i:=0 to 1 do if Assigned(SecondarySoundBuffer[i]) then SecondarySoundBuffer[i].Release;

if Assigned(DirectSound) then DirectSound.Release;

procedure

H:=;

if H = DSERR_BUFFERLOST then begin

if Buffer.Lock(OffSet, SoundBytes, AudioPtr1, AudioBytes1, AudioPtr2, AudioBytes2, 0) <> DS_OK then Raise

else if H <> DS_OK then Raise Exception.Create("Unable to Lock Sound Buffer");

if AudioPtr2 <> nil then begin

if <> DS_OK then Raise

procedure

with BufferDesc do begin

if <> DS_OK then Raise

if nil ) <> DS_OK then Raise

if <> DS_OK then Raise

if DirectSound.SetCooperativeLevel(Handle,DSSCL_NORMAL) <> DS_OK then Raise Exception.Create("Unable to set Coopeative Level");

procedure TForm1.AppCreateWriteSecondaryBuffer;

FillChar(BufferDesc, SizeOf(DSBUFFERDESC), 0);

FillChar(PCM, SizeOf(TWaveFormatEx), 0);

with BufferDesc do begin

PCM.wFormatTag:=WAVE_FORMAT_PCM;

if isStereo then PCM.nChannels:=2

else PCM.nChannels:=1;

PCM.nBlockAlign:=(Bits div 8)*PCM.nChannels;

PCM.nAvgBytesPerSec:=PCM.nSamplesPerSec * PCM.nBlockAlign;

dwSize:=SizeOf(DSBUFFERDESC);

if nil ) <> DS_OK then Raise Exception.Create("Create Sound Buffer failed");

procedure TForm1.CopyWAVToBuffer;

until Chunk = "data";

procedure TForm1.Button1Click(Sender: TObject);

CopyWAVToBuffer("1.wav", SecondarySoundBuffer);

CopyWAVToBuffer("flip.wav", SecondarySoundBuffer);

if <> DS_OK then

if SecondarySoundBuffer.Play(0, 0, 0) <> DS_OK then ShowMessage("Can""t play the Sound");

Пример 2

Представляю вашему вниманию очередной пример работы с DirectSound на Delphi. В этом примере показан принцип работы с 3D буфером. Итак, процедуры AppCreateWritePrimaryBuffer, AppWriteDataToBuffer, CopyWAVToBuffer я оставил без изменения (см. письма с до этого). Процедура AppCreateWriteSecondary3DBuffer является полным аналогом процедуры AppCreateWriteSecondaryBuffer, за исключением флага DSBCAPS_CTRL3D, который указывает на то, что со статическим вторичным буфером будет связан еще один буфер – SecondarySound3DBuffer. Чтобы его инициализировать, а также установить некоторые начальные значения (положение в пространстве, скорость и.т.д.) вызывается процедура AppSetSecondary3DBuffer, в качестве параметров которой передаются сам SecondarySoundBuffer и связанный с ним SecondarySound3DBuffer. В этой процедуре SecondarySound3DBuffer инициализируется с помощью метода QueryInterface c соответствующим флагом. Кроме того, здесь же устанавливается положение источника звука в пространстве: SetPosition(Pos,1{X},1{Y},0{Z}).

Таким образом в начальный момент времени источник находится на высоте 1 м (ось Y направлена вертикально вверх, а ось Z – «в экран»). Если смотреть сверху:

Точка O (фактически вы) имеет координаты (0,0), источник звука А(-25,1). Разумеется понятие «метр» весьма условно.

При нажатии на кнопку в буфер SecondarySoundBuffer загружается звук "xhe4.wav". Это звук работающего винта вертолета, его длина (звука) ровно 3.99 с (а размер буфера ровно 4 с). Далее происходит микширование из вторичного буфера в первичный с флагом DSBPLAY_LOOPING, что позволяет сделать многократно повторяющийся звук; время в 0.01 с ухом практически не улавливается и получается непрерывный звук летящего вертолета. После этого запускется таймер (поле INTERVAL в Инспекторе Оъектов установлено в 1). Разумеется, Вам совсем необязательно делать именно так, это просто пример. В процедуре Timer1Timer просто меняется координата X с шагом 0.1.

В итоге получаем летящий вертолет слева направо. Заодно можете проверить, правильно ли у вас расположены колонки.

PS. Если есть вопросы, постараюсь на них ответить.

uses Windows, Messages, SysUtils, Classes, Graphics, Controls,Forms, Dialogs, DSound, MMSystem, StdCtrls, ExtCtrls;

type TForm1 = class (TForm)

procedure FormCreate(Sender: TObject);

procedure FormDestroy(Sender: TObject);

procedure Button1Click(Sender: TObject);

procedure Timer1Timer(Sender: TObject);

DirectSoundBuffer: IDirectSoundBuffer;

SecondarySoundBuffer: IDirectSoundBuffer;

SecondarySound3DBuffer: IDirectSound3DBuffer;

procedure AppCreateWritePrimaryBuffer;

procedure AppCreateWriteSecondary3DBuffer(var Buffer: IDirectSoundBuffer; SamplesPerSec: Integer; Bits: Word; isStereo: Boolean; Time: Integer);

procedure AppSetSecondary3DBuffer(var Buffer: IDirectSoundBuffer; var _3DBuffer: IDirectSound3DBuffer);

procedure AppWriteDataToBuffer(Buffer: IDirectSoundBuffer; OffSet: DWord; var SoundData; SoundBytes: DWord);

procedure CopyWAVToBuffer(Name: PChar; var Buffer: IDirectSoundBuffer);

procedure TForm1.FormCreate(Sender: TObject);

if DirectSoundCreate(nil , DirectSound, nil ) <> DS_OK then Raise Exception.Create("Failed to create IDirectSound object");

AppCreateWriteSecondary3DBuffer(SecondarySoundBuffer, 22050, 8, False, 4);

AppSetSecondary3DBuffer(SecondarySoundBuffer, SecondarySound3DBuffer);Timer1.Enabled:=False;

procedure TForm1.FormDestroy(Sender: TObject);

if Assigned(DirectSoundBuffer) then DirectSoundBuffer.Release;

if Assigned(SecondarySound3DBuffer) then SecondarySound3DBuffer.Release;

if Assigned(SecondarySoundBuffer) then SecondarySoundBuffer.Release;

if Assigned(DirectSound) then DirectSound.Release;

procedure TForm1.AppCreateWritePrimaryBuffer;

FillChar(BufferDesc, SizeOf(DSBUFFERDESC),0);

FillChar(PCM, SizeOf(TWaveFormatEx), 0);

with BufferDesc do begin

PCM.wFormatTag:=WAVE_FORMAT_PCM;

PCM.nAvgBytesPerSec:=PCM.nSamplesPerSec * PCM.nBlockAlign;

dwSize:=SizeOf(DSBUFFERDESC);

dwFlags:=DSBCAPS_PRIMARYBUFFER;

if DirectSound.SetCooperativeLevel(Handle, DSSCL_WRITEPRIMARY) <> DS_OK then Raise

if DirectSound.CreateSoundBuffer(BufferDesc, DirectSoundBuffer, nil ) <> DS_OK then Raise Exception.Create("Create Sound Buffer failed");

if DirectSoundBuffer.SetFormat(PCM) <> DS_OK then Raise Exception.Create("Unable to Set Format ");

if DirectSound.SetCooperativeLevel(Handle, DSSCL_NORMAL) <> DS_OK then Raise Exception.Create("Unable to set Cooperative Level");

procedure TForm1.AppCreateWriteSecondary3DBuffer;

FillChar(BufferDesc, SizeOf(DSBUFFERDESC), 0);

FillChar(PCM, SizeOf(TWaveFormatEx), 0);

with BufferDesc do begin

PCM.wFormatTag:=WAVE_FORMAT_PCM;

if isStereo then PCM.nChannels:=2

else PCM.nChannels:=1;

PCM.nSamplesPerSec:=SamplesPerSec;

PCM.nBlockAlign:=(Bits div 8)*PCM.nChannels;

PCM.nAvgBytesPerSec:=PCM.nSamplesPerSec * PCM.nBlockAlign;

dwSize:=SizeOf(DSBUFFERDESC);

dwFlags:=DSBCAPS_STATIC or DSBCAPS_CTRL3D;

dwBufferBytes:=Time*PCM.nAvgBytesPerSec;

if DirectSound.CreateSoundBuffer(BufferDesc, Buffer, nil ) <> DS_OK then Raise Exception.Create("Create Sound Buffer failed");

procedure TForm1.AppWriteDataToBuffer;

AudioPtr1, AudioPtr2: Pointer;

AudioBytes1, AudioBytes2: DWord;

if H = DSERR_BUFFERLOST then begin

if Buffer.Lock(OffSet, SoundBytes, AudioPtr1, AudioBytes1, AudioPtr2, AudioBytes2, 0) <> DS_OK then Raise Exception.Create("Unable to Lock Sound Buffer");

else if H <> DS_OK then Raise Exception.Create("Unable to Lock Sound Buffer");

Move(Temp^, AudioPtr1^, AudioBytes1);

if AudioPtr2 <> nil then begin

Inc(Integer(Temp), AudioBytes1);

Move(Temp^, AudioPtr2^, AudioBytes2);

if Buffer.UnLock(AudioPtr1, AudioBytes1, AudioPtr2, AudioBytes2) <> DS_OK then Raise Exception.Create("Unable to UnLock Sound Buffer");

procedure TForm1.CopyWAVToBuffer;

FName:=TFileStream.Create(Name,fmOpenRead);

FName.Seek(Pos, soFromBeginning);

until Chunk = "data";

FName.Seek(Pos+3, soFromBeginning);

FName.Read(DataSize, SizeOf(DWord));

AppWriteDataToBuffer(Buffer, 0, Data^, DataSize);

var Pos: Single = -25;

procedure TForm1.AppSetSecondary3DBuffer;

if Buffer.QueryInterface(IID_IDirectSound3DBuffer, _3DBuffer) <> DS_OK then Raise Exception.Create("Failed to create IDirectSound3D object");

if _3DBuffer.SetPosition(Pos, 1, 1, 0) <> DS_OK then Raise Exception.Create("Failed to set IDirectSound3D Position");

procedure TForm1.Button1Click(Sender: TObject);

CopyWAVToBuffer("xhe4.wav",SecondarySoundBuffer);

if SecondarySoundBuffer.Play(0, 0, DSBPLAY_LOOPING) <> DS_OK then ShowMessage("Can""t play the Sound");

procedure TForm1.Timer1Timer(Sender: TObject);

SecondarySound3DBuffer.SetPosition(Pos,1,1,0);

В этой статье я постараюсь рассмотреть три процедуры для воспроизведения звука. Использование этих процедур вместо компонента TMediaPlayer существенно сэкономит ресурсы системы. С помощью этих процедур можно решать довольно широкий круг задач. Итак, начнем рассмотрение этих процедур с самой простой.

Процедура Beep

Эта процедура не имеет никаких параметров. Ее объявление выглядит довольно-таки просто:

Суть этой процедуры - воспроизводить стандартный звуковой сигнал, установленный в Windows, если имеется звуковая карта и настроен стандартный звук, если же нет, то звук поступит через динамик компьютера в виде короткого щелчка. Ее можно использовать, например, при вводе пользователем не тех данных, или при закрытии формы:

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Beep;
end;

С первой процедурой мы разобрались. Теперь посмотрим вторую...

Функция MessageBeep

Эта функция является более серьезной, она определена как:

function MessageBeep(uType:word) : boolean;

Параметр uType указывает воспроизводимый звук, как идентификатор раздела реестра, в котором записаны звуки, сопровождающие те, или иные события Windows. Параметр uType может принимать следующие значения:

• MB_ICONASTERISK - проигрывает звук "Звездочка" (SystemAsterisk)
• MB_ICONEXCLAMATION - проигрывает звук "Восклицание" (SystemExclamation)
• MB_ICONHAND - проигрывает звук "Критическая ошибка" (SystemHand)
• MB_ICONQUESTION - проигрывает звук "Вопрос" (SystemQuestion)
• MB_OK - проигрывает звук "Стандартный звук" (SystemDefault)

Надо отметить, что эта функция воспроизводит звук асинхронно, т.е. во время воспроизведения звука Ваше приложение продолжает работать. После запроса звука функция MessageBeep передает управление вызвавшей ее функции.

Если невозможно воспроизвести указанный звук, то функция попытается воспроизвести стандартный системный звук, установленный по умолчанию, если и это невозможно, то будет воспроизведен стандартный сигнал через динамик.

Ну и наконец, осталась самая интересная и полезная функция воспроизведения звука, о ней мы сейчас и поговорим.

Функция PlaySound

Эта функция может воспроизводить любые волновые звуки, а не только звуки событий Windows. Функция API Windows, параметры которой описаны в модуле mmsystem. Поэтому для использования этой функции в Ваших программах, необходимо включить в раздел uses модуль mmsystem. Функция PlaySound определена так:

function PlaySound(pszSound:PChar; hmod:HINST; fdwSound:Cardinal):boolean;

Параметр pszSound является нуль терминированной строкой (последний символ строки имеет нулевой код), он определяет воспроизводимый звук. Параметр hmod используется в случае, когда звук берется из ресурса, поскольку мы этого делать не будем, то можно этот параметр задавать равным 0 или nil.

Последний параметр fdwSound является множеством, которое определяет как будет воспроизводиться звук (режим воспроизведения). Приведу наиболее важные значения этого множества для воспроизведения произвольных волновых флагов.

• SND_ASYNC - Звук воспроизводится асинхронно и функция возвращается сразу же после начала воспроизведения. Чтобы прекратить воспроизведение нужно вызвать функцию PlaySound с параметром pszSound, равным 0.
• SND_LOOP - воспроизведение звука постоянно повторяется, одновременно надо установить флаг SND_ASYNC.
• SND_NOSTOP - Если заданный звук не может быть воспроизведен из-за занятости ресурсов, то функция немедленно вернет false (и звук не будет воспроизведен). Если же данный флаг не указан, то функция попытается остановить воспроизведение другого звука, чтобы освободить ресурсы.
• SND_PURGE - Останавливает воспроизведение любых звуков, вызванных в данной задаче.
• SND_SYNC - Синхронное воспроизведение звука события. Функция PlaySound возвращается только после окончания воспроизведения.

Важно: флаги можно комбинировать операцией or.

Указанный параметром pszSound звук, должен подходить для установленного драйвера устройства воспроизведения волновых файлов, а также должен помещаться в доступную память.

Прервать воспроизведение звука можно выполнив оператор

PlaySound(0, 0, SND_PURGE);

или путем задания нового звука.

Например, чтобы многократно и асинхронно проиграть какой-нибудь звук, выбранный с помощью OpenDialog, можно написать такой код:

procedure TForm1.Button1Click(Sender: TObject);
var PCh: PChar;
begin
if OpenDialog1.Execute then
begin
StrPCopy(PCh,OpenDialog1.FileName);
PlaySound(Pch,0,SND_ASYNC or SND_LOOP);
end;
end;

Ну вот, надеюсь все ясно! В следующий раз будет что-нибудь посложнее и поинтереснее!

После настройки компонентов следует установить размер формы в соответствии с размером компонента Image1 так, чтобы компоненты MediaPlayer1 , SpeedButton5 и SpeedButton6 оказались за границей формы. В результате форма должна выглядеть так, как показано на рис. 10.17.

Рис. 10.17. Окончательный вид формы программы "MP3-плеер"

Регулятор громкости

Задать необходимую громкость воспроизведения MP3-файла можно с помощью API-функции waveOutSetVolume . Для того чтобы эта функция стала доступной, в текст программы надо поместить ссылку на модуль MMSystem (указать имя модуля в директиве uses ).

Инструкция вызова функции в общем виде выглядит так:

r = waveOutSetVolume(ИдентификаторУстройства, Громкость)

Параметр ИдентификаторУстройства задает устройство воспроизведения (точнее, звуковой канал), громкость которого надо установить. При регулировке громкости воспроизведения MP3-файла значение этого параметра должно быть равно

WAVE_MAPPER (константа WAVE_MAPPER определена в модуле MMSystem ).

Параметр Громкость (двойное слово) задает громкость воспроизведения: младшее слово определяет громкость левого канала, старшее - правого. Максимальной громкости звучания канала соответствует шестнадцатеричное значение FFFF , минимальной - 0000 . Таким образом, чтобы установить максимальную громкость воспроизведения в обоих каналах, значение параметра Громкость должно быть $FFFFFFFF (в Delphi при записи шестнадцатеричных констант используется префикс $ ). Уровню громкости 50% соответствует константа $7FFF7FFF .

Необходимо обратить внимание, что функция waveOutSetVolume регулирует громкость воспроизведения звукового канала , а не общий уровень звука.

Изменение громкости осуществляется с помощью компонента TrackBar1 . Следует обратить внимание, что при вертикальном расположении компонента верхнему положению движка соответствует нулевое значение свойства Position , нижнему - значение, заданное свойством Max . Поэтому уровень громкости, соответствующий положению движка, вычисляется как разница между текущим и макси-

мально возможным значением свойства Position (это значение задает свойство Max ), умноженная на $FFFF .

Непосредственное изменение громкости осуществляет процедура обработки события Change (листинг 10.14), регулятора громкости (компонента TrackBar1 ), которое происходит в результате перемещения движка мышью или клавишами перемещения курсора. Сначала она вычисляет значение громкости для левого канала, затем к полученному значению добавляет сдвинутое на 16 разрядов это же значение (в результате в старшем и младшем словах находятся одинаковые значения), и полученное таким образом значение передается в качестве параметра функции

waveOutSetVolume.

Листинг 10.14. Обработка события Change компонента TrackBar1

begin

volume:= $FFFF * (TrackBar1.Max - TrackBar1.Position); volume:= volume + (volume shl 16); waveOutSetVolume(WAVE_MAPPER,volume);

end;

Перемещение окна

Значение свойства BorderStyle формы равно bsNone , поэтому в окне программы заголовок не отображается (см. рис. 10.5), и поэтому, на первый взгляд, пользователь, вроде бы, лишен возможности перемещения окна по экрану привычным для себя способом. Тем не менее окно программы все-таки переместить можно. Для этого надо установить указатель мыши в свободную (не занятую компонентами) точку окна, нажать левую кнопку мыши и, удерживая ее нажатой, перетащить окно в нужную точку экрана (такой способ весьма распространен). Описанный способ перемещения окна обеспечивает процедура обработки события MouseDown в поле компонента Image1 (листинг 10.15). Процедура "обманывает" операционную систему, сообщает ей (путем посылки соответствующего сообщения), что пользователь нажал кнопку мыши в заголовке окна, т. е. выполнил действие, требующее перемещения окна.

Листинг 10.15. Обработка события MouseDown в поле компонента Image1

// В этом случае пользователь может перемещать окно обычным образом

SendMessage(Form1.Handle, WM_NCLBUTTONDOWN, HTCAPTION, 0) end ;

Текст программы

Полный текст программы "MP3-плеер" приведен в листинге 10.16.

Листинг 10.16. MP3-плеер

{ MP3-плеер с регулятором громкости.

(с) Культин Н.Б., 2003-2010 }

unit MainForm;

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Buttons, ExtCtrls, MPlayer, ComCtrls, MMSYSTEM, FileCtrl, Menus; // эти ссылки вставлены вручную

TForm1 = class(TForm) MediaPlayer1: TMediaPlayer;

SpeedButton1: TSpeedButton; // предыдущая композиция SpeedButton2: TSpeedButton; // Play/Stop SpeedButton3: TSpeedButton; // следующая композиция SpeedButton4: TSpeedButton; // выбор папки

// невидимые кнопки SpeedButton5 и SpeedButton6 обеспечивают

// хранение картинок Play и Stop

SpeedButton5: TSpeedButton;

SpeedButton6: TSpeedButton;

ListBox1: TListBox; // список композиций

	Часть II. Практикум программирования

Label1: TLabel; // воспроизводимая композиция

Label2: TLabel; // время воспроизведения

Image1: TImage; // фон

PopupMenu1: TPopupMenu; // контекстное меню

N1: TMenuItem; // "Закрыть"

N2: TMenuItem; // "Свернуть"

// регулятор громкости

Panel1: TPanel; // панель TrackBar1: TTrackBar;

procedure Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

procedure N2Click(Sender: TObject); procedure N1Click(Sender: TObject);

procedure FormCreate(Sender: TObject); procedure ListBox1Click(Sender: TObject); procedure SpeedButton2Click(Sender: TObject); procedure SpeedButton1Click(Sender: TObject); procedure SpeedButton3Click(Sender: TObject); procedure TrackBar1Change(Sender: TObject); procedure Timer1Timer(Sender: TObject); procedure SpeedButton4Click(Sender: TObject);

// эти объявления вставлены сюда вручную procedure Play; // воспроизведение

procedure PlayList(Path: string ); // формирует список MP3-файлов

{ Private declarations } public

{ Public declarations } end ;

{$R *.dfm} var

SoundPath: string ; // каталог, в котором находятся MP3-файлы

min,sec: integer; // время воспроизведения

volume: LongWord; // громкость воспроизведения:

// старшее слово - правый канал,

// младшее слово - левый

procedure TForm1.FormCreate(Sender: TObject); begin

PlayList(""); // сформировать список MP3-файлов

ListBox1.ItemIndex:= 0; Label1.Caption:=ListBox1.Items;

// установить уровень громкости

TrackBar1.Position:= 7;

// старшее слово переменной volume - правый канал,

// младшее - левый

volume:= (TrackBar1.Position - TrackBar1.Max+1)* $FFFF; volume:= volume + (volume shl 16); waveOutSetVolume(WAVE_MAPPER,volume); // уровень громкости

end;

// формирует список MP3-файлов procedure TForm1.PlayList(Path: string ); var

SearchRec: TSearchRec; // структура SearchRec содержит информацию // о файле, удовлетворяющем условию поиска

// сформировать список MP3-файлов

if FindFirst(Path + "*.mp3", faAnyFile, SearchRec) = 0 then begin

// В каталоге есть файл с расширением mp3.

// Добавим имя этого файла в список

ListBox1.Items.Add(SearchRec.Name);

	Часть II. Практикум программирования

// Есть еще MP3-файлы?

while (FindNext(SearchRec) = 0) do ListBox1.Items.Add(SearchRec.Name);

end; ListBox1.ItemIndex:= 0;

end;

// щелчок на названии произведения

procedure TForm1.ListBox1Click(Sender: TObject); begin

if SpeedButton2.Tag = 0 then

// вывести в поле метки Label1 имя выбранного файла

Label1.Caption:=ListBox1.Items else

Form1.Play; // активизировать процесс воспроизведения

end;

// щелчок на кнопке "Воспроизведение"

procedure TForm1.SpeedButton2Click(Sender: TObject); begin

// свойство Tag хранит информацию о состоянии

// плеера: 0 - стоп; 1 - воспроизведение

if SpeedButton2.Tag = 0 then begin // начать воспроизведение

Form1.Play; end

// если кнопка "Воспроизведение" нажата,

// то повторное нажатие останавливает воспроизведение begin

SpeedButton2.Tag:= 0; MediaPlayer1.Stop;

SpeedButton2.Glyph:= SpeedButton5.Glyph; Timer1.Enabled:= False; SPeedButton2.Hint:= "Play"; Label2.Caption:= "0:00";

end;

end;

// кнопка "Предыдущий трек"

procedure TForm1.SpeedButton1Click(Sender: TObject);

if ListBox1.ItemIndex > 0 then

ListBox1.ItemIndex:= ListBox1.ItemIndex - 1; if SpeedButton2.Tag = 1 then

end;

// кнопка "Следующий трек"

procedure TForm1.SpeedButton3Click(Sender: TObject); begin

if ListBox1.ItemIndex < ListBox1.Count then ListBox1.ItemIndex:= ListBox1.ItemIndex + 1;

if SpeedButton2.Tag = 1 then Play;

end;

// пользователь изменил положение регулятора громкости procedure TForm1.TrackBar1Change(Sender: TObject); begin

volume:= $FFFF * (TrackBar1.Max - TrackBar1.Position); volume:= volume + (volume shl 16); waveOutSetVolume(WAVE_MAPPER,volume);

end;

// воспроизвести композицию, название которой выделено в списке ListBox1 procedure TForm1.Play;

Timer1.Enabled:= False; Label1.Caption:=ListBox1.Items; MediaPlayer1.FileName:= SoundPath + ListBox1.Items;

Mediaplayer1.Open; except

on EMCIDeviceError do begin

ShowMessage("Ошибка обращения к файлу "+ ListBox1.Items);

exit; end ;

end;

	Часть II. Практикум программирования

MediaPlayer1.Play; min:=0;

sec:=0; Timer1.Enabled:= True;

SpeedButton2.Hint:= "Stop"; SpeedButton2.Tag:= 1;

end;

// сигнал таймера

procedure TForm1.Timer1Timer(Sender: TObject); begin

// изменить счетчик времени if sec < 59

then inc(sec) else begin

sec:=0; inc(min);

end;

// вывести время воспроизведения

Label2.Caption:= IntToStr(min)+":"; if sec < 10

then Label2.Caption:= Label2.Caption +"0"+ IntToStr(sec) else Label2.Caption:= Label2.Caption + IntToStr(sec);

// если воспроизведение текущей композиции не завершено

if MediaPlayer1.Position < MediaPlayer1.Length then exit;

// воспроизведение текущей композиции закончено

Timer1.Enabled:= False; // остановить таймер MediaPlayer1.Stop; // остановить плеер

if ListBox1.ItemIndex < ListBox1.Count // список не исчерпан then begin

ListBox1.ItemIndex:= ListBox1.ItemIndex + 1; Play; // активизировать воспроизведение MP3-файла end

end;

// Щелчок на кнопке "Папка".

// Выбрать папку, в которой находятся MP3-файлы procedure TForm1.SpeedButton4Click(Sender: TObject); var

Root: string ; // корневой каталог pwRoot: PWideChar;

Dir: string ; begin

Root:= ""; // корневой каталог - папка Рабочий стол

GetMem(pwRoot, (Length(Root)+1) * 2);

pwRoot:= StringToWideChar(Root,pwRoot,MAX_PATH*2);

if not SelectDirectory("Выберите папку, в которой находятся MP3-файлы", pwRoot, Dir)

then Dir:=""

else Dir:= Dir+"\";

// каталог, в котором находятся MP3-файлы, выбран

SoundPath:= Dir; PlayList(SoundPath);

end;

// нажатие кнопки мыши в поле компонента Image1

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

// Заголовка у окна нет. Обманем Windows. Пусть OC думает,

// что кнопка нажата, и удерживается в заголовке окна.

// В этом случае пользователь может перемещать окно обычным образом

SendMessage(Form1.Handle, WM_NCLBUTTONDOWN, HTCAPTION, 0)

end;

// выбор команды "Закрыть" в контекстном меню procedure TForm1.N1Click(Sender: TObject); begin

Form1.Close; end ;

end.