unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
sidmon_lib, mmsystem, windows;
const
Channels = 2;
BitsPerSample = 16;
SampleRate = 44100; // Nombre d'échantillons par seconde
BufSize = 8192-1024-1024; // To do .. Alien Buffer !!!
BufferCount = 4;
type
{ TForm1 }
TForm1 = class(TForm)
Label1: TLabel;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormShow(Sender: TObject);
private
buffers: array[0..BufferCount-1] of array[0..BufSize-1] of Byte;
waveHeaders: array[0..BufferCount-1] of TWaveHdr;
currentBuffer: Integer;
currentSong: Integer;
maxSongs: Integer;
public
end;
var
Form1: TForm1;
waveOut: HWAVEOUT;
FDecoder: Pointer; // sidmon decoder !
ok_flag: Boolean = false;
implementation
{$R *.lfm}
procedure FillBuffer(bufferIndex: Integer);
begin
if ok_flag and (FDecoder <> nil) then
begin
sidmon_decoder_fillBuffer(FDecoder, @Form1.Buffers[bufferIndex][0], BufSize);
end;
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_HIGHEST); // if needed
with wFormat do
begin
wFormatTag := 1; // PcM
nChannels := 2; // stereo 2
nSamplesPerSec := 44100; // 44100
wBitsPerSample := 16; // 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(Byte);
dwFlags := 0 ;
end;
waveOutPrepareHeader(waveOut, @Form1.waveHeaders[i], SizeOf(TWaveHdr));
end;
Form1.currentBuffer := 0;
for i := 0 to BufferCount - 1 do
begin
FillBuffer(i);
waveOutWrite(waveOut, @Form1.waveHeaders[i], SizeOf(TWaveHdr));
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
Buffer: TBytes;
FileName: string;
formatName: integer;
begin
ok_flag := False;
waveOut := 0;
currentSong := 0;
maxSongs := 1;
FDecoder := sidmon_decoder_new;
FileName := 'fusion.sid2';
// Chargement du fichier
with TMemoryStream.Create do
try
LoadFromFile(FileName);
SetLength(Buffer, Size);
Position := 0;
ReadBuffer(Buffer[0], Size);
finally
Free;
end;
formatName := sidmon_decoder_detect(FDecoder, @Buffer[0], Length(Buffer));
if formatName = 0 then
begin
ShowMessage('Format SidMon non reconnu');
Exit;
end;
// Initialiser le décodeur
if not sidmon_decoder_init(FDecoder, @Buffer[0], Length(Buffer)) then
begin
ShowMessage('Erreur d''initialisation');
Exit;
end;
end;
procedure TForm1.FormShow(Sender: TObject);
var s_duration : integer;
begin
InitAudio;
ok_flag := true;
Label1.Caption:= 'Default Duration :' +IntToStr(sidmon_decoder_getDuration(Fdecoder) div 1000) + ' sec ' ;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
ok_flag := False;
if waveOut <> 0 then
begin
waveOutReset(waveOut);
waveOutClose(waveOut);
end;
if FDecoder <> nil then
sidmon_decoder_delete(FDecoder);
end;
end.
Recent
