Múltiplos sons com MCI
Como
o MCI diretamente para tocar seus sons
O
MCI (Media Control Interface) é
na verdade o dispositivo usado pelo TMediaPlayer
para “tocar” os sons, quando usamos
esse componente em nossos jogos. No entanto, podemos
usa-lo diretamente, bastando para isso criar alguns
procedimentos. A vantagem mais imediata, além
de podermos dispor dos sons na memória, é
permitir que mais de um som seja executado ao mesmo
tempo.
Vamos
ver nesta matéria como usar este recurso
e a primeira providência é declarar
MMSystem, na seção
uses inicial do projeto:
uses
Windows, Messages, SysUtils, Classes,
Graphics,
Controls, Forms, Dialogs, MMSystem; |
A primeira
procedure a ser criada servirá
para tratar os erros que porventura ocorram durante
o processamento dos sons:
procedure
MCIErro(ErrorCode: dWord);
var
S: string;
begin
SetLength(S, 128);
MCIGetErrorString(ErrorCode, PChar(S),
127);
S:= trim(S);
raise
Exception.Create(S);
end;
|
Para
carregar um arquivo wave para a memória,
criamos uma procedure que associa
esse arquivo a um nome (alias):
procedure
MCICarregarWave(Arquivo, Alias: string);
var
S: string;
Erro: dword;
begin
S:= 'open '+ Arquivo + ' type
waveaudio alias ' + Alias;
Erro:= MCISendString(PChar(S),
nil, 0, 0);
if
Erro <> 0 then
MCIErro(Erro);
end;
|
Em
seguida criamos uma procedure que
“toca” esse som, bastando para isso
informar o seu nome (alias):
procedure
MCITocarAlias(Alias: string);
var
Erro: dWord;
S: string;
begin
S:= 'play ' + Alias + ' from 0';
Erro:= MCISendString(PChar(S),
nil, 0, 0);
if
Erro <> 0 then
MCIErro(Erro);
end;
|
Uma
procedure para parar de tocar:
procedure
MCIPararAlias(Alias: string);
var
Erro: dWord;
S: string;
begin
S:= 'stop ' + Alias;
Erro:= MCISendString(PChar(S),
nil, 0, 0);
if
Erro <> 0 then
MCIErro(Erro);
S:= 'seek ' + Alias + ' to start';
Erro:= MCISendString(PChar(S),
nil, 0, 0);
if
Erro <> 0 then
MCIErro(Erro);
end;
|
E uma
procedure para “descarregar”
o som da memória:
procedure
MCIFecharAlias(Alias: string);
var
Erro: dWord;
S: string;
begin
S:= 'close ' + Alias;
Erro:= MCISendString(PChar(S),
nil, 0, 0);
if
Erro <> 0 then
MCIErro(Erro);
end;
|
Como
complemento, criamos uma function
para testar se um determinado som está sendo
tocado ou não:
function
MCITocando(Alias: string): boolean;
var
Erro: dWord;
S, Res: string;
Len, Pos: integer;
begin
S:= 'status ' + Alias + ' length';
SetLength(Res, 21);
Erro:= MCISendString(PChar(S),
PChar(Res), 20, 0);
if
Erro <> 0 then
MCIErro(Erro);
Len:= StrToInt(trim(Res));
S:= 'status ' + Alias + ' position';
SetLength(Res, 21);
Erro:= MCISendString(PChar(S),
PChar(Res), 20, 0);
if
Erro <> 0 then
MCIErro(Erro);
Pos:= StrToInt(trim(Res));
result:= ((Len - Pos) > 0)
and (pos > 0);
end;
|
Para
testar o funcionamento dessas procedures
e funções, colocamos
o load de dois arquivos wav no evento OnCreate
do Form1 e suas respectivas liberações
no evento OnDestroy:
procedure
TForm1.FormCreate(Sender: TObject);
begin
MCICarregarWave('som1.wav', 'som1');
MCICarregarWave('som2.wav', 'som2');
end;
procedure
TForm1.FormDestroy(Sender: TObject);
begin
MCIFecharAlias('som1');
MCIFecharAlias('som2');
end;
|
Criamos
então quatro botões: um para tocar
o som1, outro para tocar o som2,
outro para parar todos os sons e um quarto botão
para verificar se o som1 está
sendo tocado:
procedure
TForm1.SpeedButton1Click(Sender: TObject);
begin
MCITocarAlias('som1');
end;
procedure
TForm1.SpeedButton2Click(Sender: TObject);
begin
MCITocarAlias('som2');
end;
procedure
TForm1.SpeedButton4Click(Sender: TObject);
begin
MCIPararAlias('som1');
MCIPararAlias('som2');
end;
procedure
TForm1.SpeedButton3Click(Sender: TObject);
begin
if
MCITocando('som1') then
Form1.Caption:= 'tocando'
else
Form1.Caption:= 'não está tocando';
end;
|
Agora
é usar e abusar desses recursos...
Qualquer
dúvida quanto aos fontes, baixe o pacote
zipado no link abaixo e bons estudos.
|
|
|
Download...
Clique no link para fazer
o download dos arquivos. Se sua assinatura está para
terminar, clique aqui
e saiba como renová-la.
|
|
|
|