OOP a Windows [10. Multimédiá]

10. Multimédiá

Na prednáške:

ovládanie multimédií pomocou MCI;
práca so zvukmi.

Na prácu s multimédiami (zvuk, midi, video, CD) máme vo Windows k dispozícií niekoľko prostriedkov:

nízka úrovňové - volanie funkcií, ktoré pracujú s konkrétnym zariadením;
vysoká úroveň - MCI (Media Control Interface);
DirectX.

Jednoduché prehrávanie wav súborov

Budeme využívať funkcie z knižnice MMSystem. Existujú funkcie typu "prehraj po zavolaní jedného príkazu":

PlaySound('C:\WINNT\Media\chord.wav', 0, SND_SYNC);
PlaySound('C:\WINNT\Media\chimes.wav', 0, SND_ASYNC);

Parameter:
SND_SYNC ... PlaySound počká, kým sa zvuk dohrá, až potom program pokračuje;
SND_ASYNC ... PlaySound spustí prehrávanie zvuku a program ihneď pokračuje ďalším príkazom.

Funkcia sa dá použiť aj na prehrávanie zvukov, ktoré sú uložené v resourcoch:
PlaySound('TEST', HInstance, SND_ASYNC or SND_RESOURCE);
V *.rc súbore prilinkujeme wav súbor nasledujúcim spôsobom:
TEST WAVE "C:\WINNT\Media\chord.wav"

MCI

S MCI môžeme komunikovať niekoľkými spôsobmi:

pomocou správ:
function mciSendCommand(
    Id: MCIDEVICEID;
    Msg: Cardinal;
    Param1, Param2: DWORD): MCIERROR;
pomocou textových príkazov:
function mciSendString(
    Command, Result: PChar;
    ResultLength: Cardinal;
    Handle: HWND): MCIERROR;
mciSendString('play D:\DELPHI~1\Demos\Coolstuf\speedis.avi', nil, 0, 0);
pomocou vysoko-úrovňovej funkcie:
function mciExecute(Command: PChar): BOOL;
mciExecute('play C:\WINNT\Media\flourish.mid');

Delphi zapuzdrili prácu s MCI funkcia v komponente TMediaPlayer. Dôležité vlastnosti komponentu:
FileName ... meno súboru, ktorý sa má prehrávať;
Display ... určuje komponent, v ktorom sa zobrazuje video;
DisplayRect ... obdĺžnik, v ktorom sa prehráva video;
AutoOpen ... či sa má súbor otvoriť už pri spustení programu.
Malá ukážka:

var
M: TMediaPlayer;
begin
M:=TMediaPlayer.Create(Self);
M.Parent:=Self;
M.Visible:=False;
M.Display:=Panel1;
M.FileName:='C:\Windows\clock.avi';
M.Open;
M.DisplayRect:=Panel1.ClientRect;
M.Play;
end.

Práca so zvukmi na nízkej úrovni

Prehrávanie vlastných zvukových vzoriek:

var
A: array[0..19999] of Byte;
WH: TWAVEHDR;
OutHandle: Integer=0;

procedure TForm1.FormCreate(Sender: TObject);
var
WF: TPCMWaveformat;
I: Integer;
begin
OutHandle:=0;
WF.wf.wFormatTag:=WAVE_FORMAT_PCM;
WF.wf.nChannels:=1;
WF.wf.nSamplesPerSec:=22050;
WF.wf.nAvgBytesPerSec:=22050;
WF.wf.nBlockAlign:=1;
WF.wBitsPerSample:=8;
waveOutOpen(@OutHandle, WAVE_MAPPER, @WF, Handle, 0, CALLBACK_NULL);
for I:=0 to 19999 do A[I]:=128+Round(127*Sin(I/40));
WH.lpData:=@A;
WH.dwBufferLength:=SizeOf(A);
WH.dwBytesRecorded:=0;
WH.dwUser:=0;
WH.dwFlags:=0;
WH.dwLoops:=0;
waveOutPrepareHeader(OutHandle, @WH, SizeOf(WH));
waveOutWrite(OutHandle, @WH, SizeOf(WH));
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if OutHandle=0 then Exit;
waveOutUnprepareHeader(OutHandle, @WH, SizeOf(WH));
waveOutClose(OutHandle);
end;

Použitie dvoch bufferov pri prehrávaní zvukov:

unit Wave;

interface

uses
Windows, Messages, SysUtils, Classes, Forms, MMSystem;

type
TWaveArray=array[0..$FFF] of packed record
    R, L: SmallInt;
end;
TWave=class;
TWaveEvent=procedure(Sender: TWave; var Buffer: TWaveArray) of object;
TWave=class(TComponent)
private
    FWindow: HWND;
    FHandle: HWAVEOUT;
    FIsPlaying: Boolean;
    FWave: array[0..1] of record
      IsFree: Boolean;
      Hdr: TWaveHdr;
      Buffer: TWaveArray;
    end;
    FOnWave: TWaveEvent;
    procedure PlayWave(Index: Integer);
    procedure FreeWave(Index: Integer);
    procedure WndProc(var Msg: TMessage);
public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Play;
    procedure Stop;
    property Handle: HWAVEOUT read FHandle;
    property IsPlaying: Boolean read FIsPlaying;
published
    property OnWave: TWaveEvent read FOnWave write FOnWave;
end;

procedure Register;

implementation

// TWave - public:

constructor TWave.Create(AOwner: TComponent);
var
WF: TPCMWaveformat;
I: Integer;
begin
inherited;
FWindow:=AllocateHWnd(WndProc);
for I:=0 to 1 do FWave[I].IsFree:=True;
WF.wf.wFormatTag:=WAVE_FORMAT_PCM;
WF.wf.nChannels:=2;
WF.wf.nSamplesPerSec:=44100;
WF.wf.nAvgBytesPerSec:=176400;
WF.wf.nBlockAlign:=4;
WF.wBitsPerSample:=16;
if waveOutOpen(@FHandle, WAVE_MAPPER, @WF, FWindow, 0, CALLBACK_WINDOW)<>
    MMSYSERR_NOERROR then FHandle:=0;
end;

destructor TWave.Destroy;
var
I: Integer;
begin
if Handle<>0 then begin
    if IsPlaying then waveOutReset(Handle);
    for I:=0 to 1 do FreeWave(I);
    waveOutClose(Handle);
    FHandle:=0;
end;
if FWindow<>0 then DeallocateHWnd(FWindow);
inherited;
end;

procedure TWave.Play;
var
I: Integer;
begin
if FIsPlaying then Exit;
for I:=0 to 1 do PlayWave(I);
end;

procedure TWave.Stop;
var
I: Integer;
begin
if not IsPlaying then Exit;
if IsPlaying then waveOutReset(Handle);
FIsPlaying:=False;
for I:=0 to 1 do FreeWave(I);
end;

// TWave - private:

procedure TWave.PlayWave(Index: Integer);
begin
if not FWave[Index].IsFree or not Assigned(OnWave) then Exit;
OnWave(Self, FWave[Index].Buffer);
FWave[Index].Hdr.lpData:=@FWave[Index].Buffer;
FWave[Index].Hdr.dwBufferLength:=SizeOf(TWaveArray);
FWave[Index].Hdr.dwUser:=0;
FWave[Index].Hdr.dwFlags:=0;
FWave[Index].Hdr.dwLoops:=0;
if waveOutPrepareHeader(FHandle, @FWave[Index].Hdr, SizeOf(TWAVEHDR))=MMSYSERR_NOERROR
then
    if waveOutWrite(FHandle, @FWave[Index].Hdr, SizeOf(TWAVEHDR))<>MMSYSERR_NOERROR
    then
      waveOutUnprepareHeader(FHandle, @FWave[Index].Hdr, SizeOf(TWaveHdr))
    else begin
      FWave[Index].IsFree:=False;
      FIsPlaying:=True;
    end;
end;

procedure TWave.FreeWave(Index: Integer);
begin
if FWave[Index].IsFree then Exit;
if waveOutUnprepareHeader(FHandle, @FWave[Index].Hdr, SizeOf(TWaveHdr))=
    MMSYSERR_NOERROR then FWave[Index].IsFree:=True;
end;

procedure TWave.WndProc(var Msg: TMessage);
var
I: Integer;
begin
if Msg.Msg<>MM_WOM_DONE then begin
    Msg.Result:=DefWindowProc(FWindow, Msg.Msg, Msg.wParam, Msg.lParam);
    Exit;
end;
if not IsPlaying then Exit;
for I:=0 to 1 do
    if Integer(@FWave[I].Hdr)=Msg.LParam then begin
      FreeWave(I);
      PlayWave(I);
    end;
end;

procedure Register;
begin
RegisterComponents('Test', [TWave]);
end;

end.

Ukážka použitia:

procedure TForm1.FormCreate(Sender: TObject);
begin
Wave1.Play;
end;

var
Faza: Real=0;

procedure TForm1.Wave1Wave(Sender: TWave; var Buffer: TWaveArray);
var
I: Integer;
begin
for I:=$000 to $FFF do begin
    Buffer[I].R:=Round($7FFF*Cos(Faza));
    Buffer[I].L:=Round($7FFF*Sin(Faza));
    Faza:=Faza+2*PI/44100*261.6;   // nota C
end;
end;