unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs,StdCtrls, ExtCtrls,
vgm_lib, mmsystem, windows;
const
Channels = 2;
BitsPerSample = 16;
SampleRate = 44100; // number of samples per second
BufSize = 8192 ; // multiple of 2
BufferCount = 2;
type
{ TForm1 }
TForm1 = class(TForm)
Label1: TLabel;
Memo1: TMemo;
Timer1: TTimer;
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure FormShow(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;
ok_flag : boolean = false;
// vgm
vgm_mus : boolean;
vgm_hdr : PVGM_HEADER;
vgm_tg : VGM_TAG;
vgm_f : integer;
tr_name : PChar;
FileName: string;
rt : integer;
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 FillBuff(bufferIndex: Integer);
var
GenSmp, NumSmp: Integer;
begin
if ok_flag then
begin
bufferIndex := Form1.currentBuffer;
NumSmp := BufSize div (Channels * (BitsPerSample div 16));
GenSmp := FillBuffer(@Form1.buffers[bufferIndex][0],NumSmp);
end;
end;
function WaveOutCallback(hwo: HWAVEOUT; uMsg: UINT; dwInstance, dwParam1, dwParam2: DWORD_PTR): DWORD; stdcall;
begin
if uMsg = WOM_DONE then
begin
FillBuff(Form1.currentBuffer);
waveOutWrite(hwo, @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;
nChannels := Channels;
nSamplesPerSec := SampleRate;
wBitsPerSample := BitsPerSample;
nBlockAlign := (wBitsPerSample * nChannels) div 8;
nAvgBytesPerSec := nSamplesPerSec * nBlockAlign;
cbSize := 0;
end;
if waveOutOpen(@waveOut, WAVE_MAPPER, @wFormat, QWORD(@WaveOutCallback), 0, CALLBACK_FUNCTION) <> MMSYSERR_NOERROR then
raise Exception.Create('Erreur ouverture periph audio');
// 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;
for i := 0 to BufferCount - 1 do
begin
FillBuff(i);
waveOutWrite(waveOut, @Form1.waveHeaders[i], SizeOf(TWaveHdr));
end;
end;
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
FileName := 'songs/02 Challenger (Opening Theme).vgz';
VGMPlay_Init;
VGMPlay_Init2;
vgm_mus := OpenVGMFile(Pchar(Filename));
end;
procedure TForm1.FormShow(Sender: TObject);
begin
InitAudio;
ok_flag := true;
PlayVGM; // start player
rt := GetVGMFileInfo(PChar(FileName),vgm_hdr,vgm_tg);
Memo1.Lines.Add(vgm_tg.strTrackNameE);
Memo1.Lines.Add(vgm_tg.strTrackNameJ);
Memo1.Lines.Add(vgm_tg.strGameNameE);
Memo1.Lines.Add(vgm_tg.strGameNameJ);
Memo1.Lines.Add(vgm_tg.strSystemNameE);
Memo1.Lines.Add(vgm_tg.strSystemNameJ);
Memo1.Lines.Add(vgm_tg.strAuthorNameE);
Memo1.Lines.Add(vgm_tg.strAuthorNameJ);
Memo1.Lines.Add(vgm_tg.strReleaseDate);
Memo1.Lines.Add(vgm_tg.strCreator);
Memo1.Lines.Add(vgm_tg.strNotes);
end;
procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
var
i: Integer;
begin
for i := 0 to BufferCount - 1 do
waveOutUnprepareHeader(waveOut, @waveHeaders[i], SizeOf(TWaveHdr));
waveOutClose(waveOut);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
end;
end.