unit Unit1;
{$mode objfpc}{$H+}
//{$PACKRECORDS C}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, windows,
mmsystem, ym_player ;
const
REPLAY_RATE = 44100;
Channels = 1;
ym_File = 'tcb.ym';
REPLAY_DEPTH = 16;
REPLAY_SAMPLELEN = REPLAY_DEPTH div 8;
SampleRate = 44100; // number of samples per second
BufSize = 65536*2 ; // multiple of 2
BufferCount = 4;
type
TYM_MusicInfo = record
pSongName: PAnsiChar;
pSongAuthor: PAnsiChar;
pSongComment: PAnsiChar;
pSongType: PAnsiChar;
pSongPlayer: PAnsiChar;
musicTimeInSec: Integer;
musicTimeInMs: Integer;
end;
{ TForm1 }
TForm1 = class(TForm)
Timer1: TTimer;
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
buffers: array[0..BufferCount-1] of array[0..BufSize-1] of SmallInt;
waveHeaders: array[0..BufferCount-1] of TWaveHdr;
currentBuffer: Integer;
public
end;
var
Form1: TForm1;
waveOut: HWAVEOUT;
waveHeader: TWaveHdr;
ym_pmus: PYM_Music ;
ym_mus : string;
ok_flag : boolean = true;
implementation
{$R *.lfm}
/// audio init et le reste !!
procedure HandleError(const Str: PAnsiChar);
begin
if Str <> nil then
begin
ShowMessage('Error: Wrong Format ? '+ Str);
Halt(1);
end;
end;
procedure FillBuffer(bufferIndex: Integer);
begin
YM_ComputePCM(ym_pmus, @Form1.buffers[bufferIndex][0], BufSize );
if Form1.buffers[bufferIndex][0] = 0 then
begin
ShowMessage('Attention : le buffer est vide');
end;
Form1.waveHeaders[bufferIndex].dwFlags := Form1.waveHeaders[bufferIndex].dwFlags and (not WHDR_DONE);
end;
function WaveOutCallback(hwo: HWAVEOUT; uMsg: UINT; dwInstance, dwParam1, dwParam2: DWORD_PTR): DWORD; stdcall;
begin
if uMsg = WOM_DONE then
begin
FillBuffer(Form1.currentBuffer);
waveOutWrite(waveOut, @Form1.waveHeaders[Form1.currentBuffer], SizeOf(TWaveHdr));
Form1.currentBuffer := (Form1.currentBuffer + 1) mod BufferCount;
end;
Result := 0;
end;
procedure InitAudio;
var
wFormat: TWaveFormatEx;
i: Integer;
begin
SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_LOWEST);
with wFormat do
begin
wFormatTag := WAVE_FORMAT_PCM; // 1
nChannels := 1; // Mono
nSamplesPerSec := REPLAY_RATE; // 44100
wBitsPerSample := REPLAY_DEPTH; // 16 bits
nBlockAlign := nChannels * (wBitsPerSample div 8); // Taille echantillon
nAvgBytesPerSec := nSamplesPerSec * nBlockAlign;
cbSize := 0;
end;
if waveOutOpen(@waveOut, WAVE_MAPPER, @wFormat, QWORD(@WaveOutCallback), 0, CALLBACK_FUNCTION) <> MMSYSERR_NOERROR then
ShowMessage('Error: Audio initialization failed');
// buffers
for i := 0 to BufferCount - 1 do
begin
ZeroMemory(@Form1.waveHeaders[i], SizeOf(TWaveHdr));
with Form1.waveHeaders[i] do
begin
lpData := @Form1.buffers[i][0];
dwBufferLength := BufSize * SizeOf(SmallInt);
dwFlags := 0 ;
end;
waveOutPrepareHeader(waveOut, @Form1.waveHeaders[i], SizeOf(TWaveHdr));
end;
Form1.currentBuffer := 0;
end;
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
ym_mus :='tcb.ym';
InitAudio;
ym_pmus := YM_Init;
if ym_pmus = nil then
ShowMessage('YM_Init failed');
YM_LoadFile(ym_pmus, Pchar(ym_mus));
if not YM_LoadFile(ym_pmus, Pchar(ym_mus)) then
begin
ShowMessage('YM file not Loaded');
HandleError(YM_GetLastError(ym_pmus));
Exit;
end;
FillBuffer(0);
waveOutWrite(waveOut, @waveHeaders[0], SizeOf(TWaveHdr));
YM_Play(ym_pmus); // on va dans l'espace :))
end;
// noting yet for the timer !!
procedure TForm1.Timer1Timer(Sender: TObject);
begin
end;
end.
Recent
