//============================================================================
//                     LowLVPCM コンポーネント Ver.0.70
//                      Copyright & Programmed by C60
//														for Delphi2,3,4
//============================================================================

// ソース改変 by Moonlight (2002/08/26)

unit _LowLVPCM_Moonlight;

interface

// Delphi２〜４
(*
uses
	Classes, Windows, Messages, Forms, MMSystem, SysUtils, Dialogs, DsgnIntf;
*)

// Delphi５以上だとこちらを有効にする
uses
	Classes, Windows, Forms, MMSystem, SysUtils, TypInfo;


const
	MaxNumOfBuffers = 1024;
	CommandWait = 50;					// コマンド解析時の待ち時間(msec)
	WaveOutWait = 100;				//	wave 出力時の最高待ち時間(msec)

type
	TBufferStatus = (BSNone, BSEmpty, BSPlay, BSFull);

	PLowLVPCMFormat = ^TLowLVPCMFormat;
	TLowLVPCMFormat = record
		nChannels: Word;        { number of channels (i.e. mono, stereo, etc.) }
		nSamplesPerSec: DWORD;  { sample rate }
		wBitsPerSample: Word;   { number of bits per sample of mono data }
		BufferSize : DWORD;     { each buffer size(byte) }
		NumOfBuffers : Word;    { number of buffers }
	end;

	TLowLVPCMEvent = record
		OnBufferEmpty : TNotifyEvent;
		OnPlayStart : TNotifyEvent;
		OnPlayStop : TNotifyEvent;
		OnPlayEnd : TNotifyEvent;
	end;

	TStatus = (STPlay, STStop, STPause, STFadeout);
	TCommand= (CMNone, CMPlay, CMStop, CMFadeout, CMPause, CMPauseOnly,
																																	CMResume);

	// 例外の定義
	ELowLVPCMError = Class(Exception)
	end;


	TOnPlayEndThread = class(TThread)
	private
		{ Private 宣言 }
		FLowLVPCMEvent  : TLowLVPCMEvent;
	protected
		procedure Execute; override;
	public
		{ Public 宣言 }
		constructor Create;
		property LowLVPCMEvent : TLowLVPCMEvent read FLowLVPCMEvent
																									write FLowLVPCMEvent;
	end;


	TLowLVPCMThread = class(TThread)
	private
		{ Private 宣言 }
		OnPlayEndThread : TOnPlayEndThread;
		FLowLVPCMFormat : TLowLVPCMFormat;
		FLowLVPCMEvent  : TLowLVPCMEvent;
		Fstatus : TStatus;
		FCommand : TCommand;
		FlhWaveOut : HWaveOut;
		FDeviceID : UINT;
		FSetBufferEnd : Boolean;	// OnBufferEmpty を呼ぶ必要がない
															// (データが切れた)なら True
		FUsewaveOutGetPostion : Boolean;	// waveOutGetPosition を使うなら True
		FlWaveOutHdr : array[0..MaxNumofBuffers-1] of PWaveHdr; //Headerのポインタ
		FMemPtr : array[0..MaxNumofBuffers-1] of Pointer;		// Buffer のポインタ
		FMemSize : array[0..MaxNumofBuffers-1] of Integer;		// 実際のサイズ
		FTotalMemSize : array[0..MaxNumofBuffers-1] of Integer;		// 実際のサイズ
		FTotalSize : Integer;
		FBufferStatus : array[0..MaxNumofBuffers-1] of TBufferStatus;
																										// バッファがフルか？
		FEmptyBuffer : Integer;	// これからデータを入れるバッファ
		FPlayBuffer : Integer;	// これから演奏するバッファ
		FNewHeap : THandle;
//		FVolume : DWORD;
		Sect1 : TRTLCriticalSection;

		procedure GetMemory;
		procedure FreeMemory;
		function  LowLVPCMPlayStart : Boolean;
		procedure LowLVPCMPlayContinue;
		procedure LowLVPCMStop;
		procedure LowLVPCMPauseOnly;
		procedure LowLVPCMResume;
		procedure SetCommand(Value : TCommand);
	protected
		procedure Execute; override;
	public
		{ Public 宣言 }
		constructor Create;
		destructor Destroy; override;
		procedure LowLVPCMFadeout(Speed : Integer);
		property Command:TCommand read FCommand write SetCommand;
		procedure Play(LowLVPCMFormat : TLowLVPCMFormat;
																					LowLVPCMEvent : TLowLVPCMEvent);
		procedure Stop;
		procedure Pause;
		procedure PauseOnly;
		procedure Resume;
		procedure FadeoutToStop(Speed : Integer);
		procedure Fadeout(Speed : Integer);
		procedure SetBuffer(Buf : Pointer; Size : Integer);
		function GetBufferData(Buf : Pointer; Size : Integer) : Integer;
		property DeviceID : UINT read FDeviceID write FDeviceID default WAVE_MAPPER;
		property lhWaveOut : HWaveOut read FlhWaveOut;
		property UsewaveOutGetPostion : Boolean read FUsewaveOutGetPostion write FUsewaveOutGetPostion;
	end;


	TLowLVPCM = class(TComponent)
	private
		{ Private 宣言 }
		FDeviceID : UINT;
		LowLVPCMThread : TLowLVPCMThread;
		FLowLVPCMFormat : TLowLVPCMFormat;
		FLowLVPCMEvent : TLowLVPCMEvent;
		FUsewaveOutGetPostion : Boolean;
		procedure SetnChannels(Value : Word);
		procedure SetnSamplesPerSec(Value : DWORD);
		procedure SetwBitsPerSample(Value : Word);
		procedure SetBufferSize(Value : DWORD);
		procedure SetNumOfBuffers(Value : Word);
		function GetlhWaveOut : HWaveOut;
    procedure SetDeviceID(Value : UINT);
    function GetDeviceID : UINT;
	public
		{ Public 宣言 }
		constructor Create(AOwner: TComponent); override;
		destructor Destroy; override;
		procedure Play;
		procedure Stop;
		procedure Pause;
		procedure PauseOnly;
		procedure Resume;
		procedure FadeoutToStop(Speed : Integer);
		procedure Fadeout(Speed : Integer);
		procedure SetBuffer(Buf : Pointer; Size : Integer);
		function GetBufferData(Buf : Pointer; Size : Integer) : Integer;
	protected
		{ Protected 宣言 }
		function GetUsewaveOutGetPostion : Boolean;
  	procedure SetUsewaveOutGetPostion(Value : Boolean);
	published
		{ Published 宣言 }
		property OnBufferEmpty : TNotifyEvent
			read FLowLVPCMEvent.OnBufferEmpty write FLowLVPCMEvent.OnBufferEmpty;
		property OnPlayStart : TNotifyEvent
	 			read FLowLVPCMEvent.OnPlayStart write FLowLVPCMEvent.OnPlayStart;
		property OnPlayStop : TNotifyEvent
			read FLowLVPCMEvent.OnPlayStop write FLowLVPCMEvent.OnPlayStop;
		property OnPlayEnd : TNotifyEvent
			read FLowLVPCMEvent.OnPlayEnd write FLowLVPCMEvent.OnPlayEnd;
		property nChannels: Word
			read FLowLVPCMFormat.nChannels write SetnChannels default 1;
		property nSamplesPerSec: DWORD
			read FLowLVPCMFormat.nSamplesPerSec write SetnSamplesPerSec default 22050;
		property wBitsPerSample: Word
			read FLowLVPCMFormat.wBitsPerSample write SetwBitsPerSample default 8;
		property BufferSize : DWORD
			read FLowLVPCMFormat.BufferSize write SetBufferSize default 4096;
		property NumOfBuffers : Word
			read FLowLVPCMFormat.NumOfBuffers write SetNumOfBuffers default 4;
		property lhWaveOut : HWaveOut read GetlhWaveOut;
		property DeviceID : UINT read GetDeviceID write SetDeviceID
    																										default WAVE_MAPPER;
		property UsewaveOutGetPostion : Boolean
    				read GetUsewaveOutGetPostion write SetUsewaveOutGetPostion;
	end;


procedure Register;
function GetForm(NowComponent : TComponent) : TComponent;

implementation

procedure Register;
begin
	RegisterComponents('Samples', [TLowLVPCM]);
end;


function GetForm(NowComponent : TComponent) : TComponent;
begin
	while not(NowComponent is TForm) do begin
		NowComponent := NowComponent.Owner;
	end;
	GetForm := NowComponent;
end;


{ TLowLVPCM }
// コンストラクタ
constructor TLowLVPCM.Create(AOwner: TComponent);
//var
//	WindowHandle : Hwnd;
//	FormComponent : TComponent;
begin
	inherited Create(AOwner);
	with FLowLVPCMFormat do begin
		nChannels := 1;
		nSamplesPerSec := 22050;
		wBitsPerSample := 8;
		BufferSize := 4096;
		NumOfBuffers := 4;
	end;

	FDeviceID := WAVE_MAPPER;
//	FormComponent := GetForm(AOwner);
	// スレッドオープン
	if not (csDesigning in ComponentState) then begin
		LowLVPCMThread := TLowLVPCMThread.Create;
		LowLVPCMThread.Priority := tpHighest;
		LowLVPCMThread.DeviceID := WAVE_MAPPER;
	end else begin
		LowLVPCMThread := nil;
	end;
end;


// デストラクタ
destructor TLowLVPCM.Destroy;
begin

	if not (csDesigning in ComponentState) then begin
		LowLVPCMThread.Stop;
		LowLVPCMThread.Terminate;
		LowLVPCMThread.WaitFor;
		LowLVPCMThread.Destroy;
	end;
	inherited Destroy;
end;


//	バッファにデータをセット
procedure TLowLVPCM.SetBuffer(Buf : Pointer; Size : Integer);
begin
	LowLVPCMThread.SetBuffer(Buf, Size);
end;


//	演奏開始
procedure TLowLVPCM.Play;
begin
	if not Assigned(FLowLVPCMEvent.OnBufferEmpty) then
		raise ELowLVPCMError.Create('OnBufferEmpty に関連付けられていません');//@

	//	DeviceID 設定
	LowLVPCMThread.DeviceID := FDeviceID;

	//演奏開始
	LowLVPCMThread.Play(FLowLVPCMFormat, FLowLVPCMEvent);
end;

//	演奏終了
procedure TLowLVPCM.Stop;
begin
	LowLVPCMThread.Stop;
end;


//	ポーズ(toggle)
procedure TLowLVPCM.Pause;
begin
	LowLVPCMThread.Pause;
end;


//	ポーズ
procedure TLowLVPCM.PauseOnly;
begin
	LowLVPCMThread.PauseOnly;
end;


//	再生の再開
procedure TLowLVPCM.Resume;
begin
	LowLVPCMThread.Resume;
end;


//	フェードアウト（終了まで帰らない）
procedure TLowLVPCM.FadeoutToStop(Speed : Integer);
begin
	LowLVPCMThread.FadeoutToStop(Speed);
end;


//	フェードアウト
procedure TLowLVPCM.Fadeout(Speed : Integer);
begin
	LowLVPCMThread.Fadeout(Speed);
end;


//	データの取得
function TLowLVPCM.GetBufferData(Buf : Pointer; Size : Integer) : Integer;
begin
	Result := LowLVPCMThread.GetBufferData(Buf, Size);
end;

//	nChannels 範囲チェック
procedure TLowLVPCM.SetnChannels(Value : Word);
begin
	if(Value <> 1) and (Value <> 2) then
		raise EPropertyError.Create('nChannel が範囲外です');		// @
	FLowLVPCMFormat.nChannels := Value;
end;


//	nSamplesPerSec 範囲チェック
procedure TLowLVPCM.SetnSamplesPerSec(Value : DWORD);
begin
	if(Value <= 0) or (Value > 65535) then
		raise EPropertyError.Create('nSamplesPerSec が範囲外です');		// @
	FLowLVPCMFormat.nSamplesPerSec := Value;
end;


//	wBitsPerSample 範囲チェック
procedure TLowLVPCM.SetwBitsPerSample(Value : Word);
begin
	if(Value <> 8) and (Value <> 16) then
		raise EPropertyError.Create('wBitsPerSample が範囲外です');		// @
	FLowLVPCMFormat.wBitsPerSample := Value;
end;


//	BufferSize 範囲チェック
procedure TLowLVPCM.SetBufferSize(Value : DWORD);
begin
	if(Value <= 0) then
		raise EPropertyError.Create('BufferSize が範囲外です');		// @
	FLowLVPCMFormat.BufferSize := Value;
end;


//	NumOfBuffers 範囲チェック
procedure TLowLVPCM.SetNumOfBuffers(Value : Word);
begin
	if(Value <= 0) or (Value >= MaxNumOfBuffers) then
		raise EPropertyError.Create('NumOfBuffers が範囲外です');		// @
	FLowLVPCMFormat.NumOfBuffers := Value;
end;


//	lhWaveOut 取得
function TLowLVPCM.GetlhWaveOut : HWaveOut;
begin
	if Assigned(LowLVPCMThread) then begin
		Result := LowLVPCMThread.lhWaveOut;
  end else begin
    Result := 0;
  end;
end;


//  DeviceID 設定
procedure TLowLVPCM.SetDeviceID(Value : UINT);
begin
	FDeviceID := Value;
end;


//  DeviceID 取得
function TLowLVPCM.GetDeviceID : UINT;
begin
	Result := FDeviceID;
end;


//  UsewaveOutGetPostion 取得
function TLowLVPCM.GetUsewaveOutGetPostion : Boolean;
begin
	Result := FUsewaveOutGetPostion;
end;


//  UsewaveOutGetPostion 設定
procedure TLowLVPCM.SetUsewaveOutGetPostion(Value : Boolean);
begin
	FUsewaveOutGetPostion := Value;
	if not(csDesigning in ComponentState) then begin
		LowLVPCMThread.UsewaveOutGetPostion := Value;
	end;
end;


{ TLowLVPCMThread }
// 初期化
constructor TLowLVPCMThread.Create;
begin
	FUsewaveOutGetPostion := False;
	InitializeCriticalSection(Sect1);
	inherited Create(False);
  OnPlayEndThread := TOnPlayEndThread.Create;
end;


//  デストラクタ
destructor TLowLVPCMThread.Destroy;
begin
	OnPlayEndThread.Terminate;
  OnPlayEndThread.Resume;
	OnPlayEndThread.WaitFor;
	OnPlayEndThread.Destroy;
end;


//	メモリ確保
procedure TLowLVPCMThread.GetMemory;
var
	i : Integer;
begin
	if(FNewHeap <> 0) then FreeMemory;
	with FLowLVPCMFormat do begin
		FNewHeap:=HeapCreate(0,(BufferSize + 4096)*NumOfBuffers, 0);
		for i := 0 to NumOfBuffers-1 do begin
			FMemptr[i] := HeapAlloc(FNewHeap, 0, Buffersize);
			FlWaveOutHdr[i] := HeapAlloc(FNewHeap, 0, SizeOf(TWaveHdr));
			if(FMemptr[i] = nil) or (FlWaveOutHdr[i] = nil) then
				raise ELowLVPCMError.Create('メモリが足りません');		//@
			FBufferStatus[i] := BSEmpty;
		end;
	end;
end;


//	メモリ開放
procedure TLowLVPCMThread.FreeMemory;
begin
	EnterCriticalSection(Sect1);
		if(FNewHeap <> 0) then HeapDestroy(FNewHeap);
		FNewHeap := 0;
	LeaveCriticalSection(Sect1);
end;


// スレッドコード
procedure TLowLVPCMThread.Execute;
label ExitLoop;
var
//	i, j : Integer;
//	p : Pointer;
	WaitTime : Integer;
//	pdwVolume : PDWORD;
begin

	Fstatus := STStop;
	Fcommand:= CMNone;
	WaitTime := WaveOutWait;

	while(Terminated = False) do begin
		case FCommand of
			CMStop :
				if(FStatus in [STPlay, STPause, STFadeOut]) then begin
					LowLVPCMStop;
					FCommand := CMNone;
					FStatus := STStop;
					if Assigned(FLowLVPCMEvent.OnPlayStop) then
						FLowLVPCMEvent.OnPlayStop(Self);
				end else FCommand := CMNone;

			CMPlay :
				if(FStatus in [STStop]) then begin
        	OnPlayEndThread.LowLVPCMEvent := FLowLVPCMEvent;
					FNewHeap := 0;
					FSetBufferEnd := False;
					FEmptyBuffer := 0;
					FPlayBuffer := 0;

					with FLowLVPCMFormat do begin
						WaitTime := Buffersize * 1000 div
									(nSamplesPerSec * nChannels * wBitsPerSample div 8) div 2;
																								// バッファ１つの時間の 1/2
						if(WaitTime > WaveOutWait) then WaitTime := WaveOutWait;
					end;
					if(LowLVPCMPlayStart = True) then begin		// 演奏が成功した時
						FStatus := STPlay;
            FCommand := CMNone;
						if Assigned(FLowLVPCMEvent.OnPlayStart) then
							FLowLVPCMEvent.OnPlayStart(Self);
					end else begin  													// 演奏が失敗した時
          	FStatus := STStop;
	          FCommand := CMNone;
          end;
				end else begin
	        FCommand := CMNone;
        end;

			CMPause :
				if(FStatus in [STPlay, STFadeout]) then begin
					FCommand := CMPauseOnly;
				end else if(FStatus in [STPause]) then begin
					FCommand := CMResume;
				end else begin
					FCommand := CMNone;
				end;

			CMPauseOnly :
				if(FStatus in [STPlay, STFadeout]) then begin
					LowLVPCMPauseOnly;
					FCommand := CMNone;
					FStatus := STPause;
				end else FCommand := CMNone;

			CMResume:
				if(FStatus in [STPause]) then begin
					LowLVPCMResume;
					FCommand := CMNone;
					FStatus := STPlay;
				end else FCommand := CMNone;

			CMFadeout :; 	//	@@@
		end;


		if(FStatus in [STPlay]) then begin
			LowLVPCMPlayContinue;
		end;
		Sleep(WaitTime);
	end;
	
	DeleteCriticalSection(Sect1);
end;


//	演奏開始
function TLowLVPCMThread.LowLVPCMPlayStart : Boolean;
var
	i : Integer;
	lpFormat : TWaveFormatEx;
begin
	Result := False;
	// メモリ確保
	GetMemory;

	//	デバイスオープン
	with FLowLVPCMFormat do begin
		lpFormat.wFormatTag      := WAVE_FORMAT_PCM;
		lpFormat.nChannels       := nChannels;
		lpFormat.nSamplesPerSec  := nSamplesPerSec;
		lpFormat.wBitsPerSample  := wBitsPerSample;
		lpFormat.nBlockAlign     := nChannels * wBitsPerSample div 8;
		lpFormat.nAvgBytesPerSec := nSamplesPerSec * lpFormat.nBlockAlign;
		lpFormat.cbSize          := 0;

		if(waveOutOpen(@FlhWaveOut, FDeviceID, @lpFormat, 0, 0, 0) <> 0)
																																		then begin
			Windows.MessageBox(0, 'Wave デバイスを使用できません', 'Error', MB_OK);
			FlhWaveOut := 0;
			Exit;
		end;

(*
		waveOutGetVolume(FlhWaveOut, p);
		FVolume := WORD(p^);
//		FVolume := $FFFF;		// @暫定
*)

		// header 準備
		for i := 0 to NumOfBuffers-1 do begin
			with FlWaveOutHdr[i]^ do begin
				lpData          := FMemPtr[i];
				dwbufferLength  := Buffersize;
				dwUser          := 0;
				dwFlags         := 0;
				dwLoops         := 1;
			end;
		end;

		// Buffer Clear
		for i := 0 to NumOfBuffers-1 do begin
			if(wBitsPerSample = 8) then begin
				FillChar(FMemptr[i]^, Buffersize, $80);
			end else begin
				FillChar(FMemptr[i]^, Buffersize, 0);
			end;
		end;

		// 最初にバッファを満たす
    FTotalSize := 0;
		for i := 0 to FLowLVPCMFormat.NumOfBuffers-1 do begin
			FTotalMemSize[i] := 0;
			if(FSetBufferEnd = False) then FLowLVPCMEvent.OnBufferEmpty(Self);
		end;

		LowLVPCMPauseOnly;

		for i := 0 to FLowLVPCMFormat.NumOfBuffers-1 do begin
			if(FBufferStatus[i] = BSEmpty) then Break;
			FlWaveOutHdr[i]^.dwbufferLength := FMemSize[i];
			WaveOutPrepareHeader(FlhWaveOut, FlWaveOutHdr[i],
																													SizeOf(TWaveHdr));
			WaveOutWrite(FlhWaveOut, FlWaveOutHdr[i], SizeOf(TWaveHdr));
			FBufferStatus[i] := BSPlay;
		end;
		
		FPlayBuffer := 0;		// ０番目のバッファから使用
		
		LowLVPCMResume;
		Result := True;
	end;
end;


//	演奏継続
procedure TLowLVPCMThread.LowLVPCMPlayContinue;
begin
	while(FlWaveOutHdr[FPlayBuffer]^.dwFlags and MHDR_DONE <> 0) do begin
		while(waveOutUnprepareHeader(FlhWaveOut,FlWaveOutHdr[FPlayBuffer],
													SizeOf(TWaveHdr)) = WAVERR_STILLPLAYING) do begin
			Sleep(0);		// task swap
		end;

		if(FBufferStatus[FPlayBuffer] = BSEmpty) then begin

			LowLVPCMStop;
			FCommand := CMNone;
			FStatus := STStop;
			if Assigned(FLowLVPCMEvent.OnPlayStop) then
				FLowLVPCMEvent.OnPlayStop(Self);
			if Assigned(FLowLVPCMEvent.OnPlayEnd) then
				OnPlayEndThread.Resume;
			break;
		end;

		if(FBufferStatus[FPlayBuffer] = BSPlay) then begin
				FBufferStatus[FPlayBuffer] := BSEmpty;
			if(FSetBufferEnd = False) then FLowLVPCMEvent.OnBufferEmpty(Self);
		end;

		if(FBufferStatus[FPlayBuffer] = BSFull) then begin
			FlWaveOutHdr[FPlayBuffer]^.dwbufferLength := FMemSize[FPlayBuffer];
			WaveOutPrepareHeader(FlhWaveOut, FlWaveOutHdr[FPlayBuffer],
																													SizeOf(TWaveHdr));
			WaveOutWrite(FlhWaveOut, FlWaveOutHdr[FPlayBuffer], SizeOf(TWaveHdr));
 			FBufferStatus[FPlayBuffer] := BSPlay;
 		end;

		inc(FPlayBuffer);
 		if(FPlayBuffer = FLowLVPCMFormat.NumOfBuffers) then FPlayBuffer := 0;
 	end;
end;


//	演奏停止
procedure TLowLVPCMThread.LowLVPCMStop;
var
	i : Integer;
begin
	if(WaveOutReset(FlhWaveOut) <> 0) then
		raise ELowLVPCMError.Create('演奏を終了できません。');		// @

	// wav header 破棄
	for i := 0 to FLowLVPCMFormat.NumOfBuffers-1 do begin
		if(FBufferStatus[i] <> BSEmpty) then begin
			while(waveOutUnprepareHeader(FlhWaveOut,FlWaveOutHdr[i],SizeOf(TWaveHdr))
																						=  WAVERR_STILLPLAYING) do begin
				Sleep(0);		// task swap
			end;
		end;
	end;

	// 音量を元に戻す
//	waveOutSetVolume(FlhWaveOut, FVolume);

	// デバイスクローズ
	if(waveOutClose(FlhWaveOut) <> 0) then
		raise ELowLVPCMError.Create('Wave デバイスを開放できません。');		// @
	FlhWaveOut := 0;

	// メモリ開放
	FreeMemory;
end;


//	ポーズ
procedure TLowLVPCMThread.LowLVPCMPauseOnly;
begin
	waveOutPause(FlhWaveOut);
end;


//	演奏再開
procedure TLowLVPCMThread.LowLVPCMResume;
begin
	waveOutRestart(FlhWaveOut);
end;


//	フェードアウト
procedure TLowLVPCMThread.LowLVPCMFadeout(Speed : Integer);
{
var
	Vol : DWORD;
	p : Pointer;
	TEST : WORD;
}
begin
(*
	waveOutGetVolume(FlhWaveOut, p);
	FVolume := WORD(P^);
	Vol := FVolume and $ff;
	while(Vol >= Speed) and (FlhWaveOut <> 0) do begin
		Dec(Vol, Speed);
		waveOutSetVolume(FlhWaveOut, (Vol shl 8) + Vol);
		Sleep(10);
	end;
	Stop;
*)
end;


procedure TLowLVPCMThread.Play(LowLVPCMFormat:TLowLVPCMFormat;
																						LowLVPCMEvent : TLowLVPCMEvent);
begin
	// 演奏中なら止める
	Command := CMStop;

	FLowLVPCMFormat := LowLVPCMFormat;
	FLowLVPCMEvent := LowLVPCMEvent;

	// 演奏開始
	Command := CMPlay;
end;


procedure TLowLVPCMThread.Stop;
begin
	Command := CMStop;
end;


procedure TLowLVPCMThread.Fadeout;
begin
	// @@@
end;


procedure TLowLVPCMThread.FadeoutToStop;
begin
	// @@@
end;


procedure TLowLVPCMThread.Pause;
begin
	Command := CMPause;
end;


procedure TLowLVPCMThread.PauseOnly;
begin
	Command := CMPauseOnly;
end;


procedure TLowLVPCMThread.Resume;
begin
	Command := CMResume;
end;


procedure TLowLVPCMThread.SetBuffer(Buf : Pointer; Size : Integer);
begin
	if(FBufferStatus[FEmptyBuffer] <> BSEmpty) then
		raise ELowLVPCMError.Create('バッファがいっぱいです.');		//@
	if(Buf = nil) or (Size = 0) then begin
		FSetBufferEnd := True;
		FBufferStatus[FEmptyBuffer] := BSEmpty;
	end else if(Size > FLowLVPCMFormat.BufferSize) then begin
		raise ELowLVPCMError.Create('サイズが大きすぎます');		//@
	end else begin
		EnterCriticalSection(Sect1);
		Move(Buf^, FMemPtr[FEmptyBuffer]^, Size);
		FMemSize[FEmptyBuffer] := Size;
		FTotalMemSize[FEmptyBuffer] :=  FTotalSize;
		Inc(FTotalSize, Size);
		FBufferStatus[FEmptyBuffer] := BSFull;
		if(FLowLVPCMFormat.NumOfBuffers > 1) then begin
			Inc(FEmptyBuffer);
			if(FEmptyBuffer = FLowLVPCMFormat.NumOfBuffers) then
				FEmptyBuffer := 0;
		end;
		LeaveCriticalSection(Sect1);
	end;
end;


function TLowLVPCMThread.GetBufferData(Buf : Pointer; Size : Integer) : Integer;
var
//	i : Integer;
	BufPos, BufPos2, Size2 : Integer;
  MMTime : TMMTime;
  Offset : DWORD;
begin
	EnterCriticalSection(Sect1);
	try
		if(FlhWaveOut = 0) or ((Fstatus <> STPlay) and (Fstatus <> STFadeout)) or
  			(Size > FLowLVPCMFormat.BufferSize * FLowLVPCMFormat.NumOfBuffers) then begin
			Result := 0;
			Exit;
  	end;

    if(FUsewaveOutGetPostion = False) then begin
			BufPos := FEmptyBuffer;
			Size2 := Size;

			while(Size > 0) and (FBufferStatus[BufPos] in [BSPlay, BSFull]) do begin
				if(Size >= FMemSize[BufPos]) then begin
					Move(Pointer(Integer(FMemPtr[BufPos]))^, Buf^,
          																					FMemSize[BufPos]);
					Inc(Integer(Buf), FMemSize[BufPos]);
					Dec(Size, FMemSize[BufPos]);
					Inc(BufPos);
					if(BufPos = FLowLVPCMFormat.NumOfBuffers) then BufPos := 0;
				end else begin
					Move(Pointer(Integer(FMemPtr[BufPos]))^, Buf^, Size);
					Size := 0;
				end;
			end;
			Result := Size2 - Size;

    end else begin
			with FLowLVPCMFormat do begin
  	 		FillChar(MMTime, SizeOf(MMTime), 0);
				MMTime.wType := TIME_BYTES;
				if(waveOutGetPosition(FlhWaveOut, @MMTime, SizeOf(MMTime)) <> MMSYSERR_NOERROR) then begin
					Result := 0;
					Exit;
    	 	end;

				// TIME_BYTES で取れない場合は終了する
				if(MMTime.wType <> TIME_BYTES) then begin
					Result := 0;
					Exit;
	      end;

				BufPos := FEmptyBuffer;
    	  BufPos2 := BufPos;
				Size2 := Size;

	      while not((FTotalMemSize[BufPos] <= MMTime.cb) and
        		(MMTime.cb < FTotalMemSize[BufPos] + FMemSize[BufPos])) do begin

      		Inc(BufPos);
					if(BufPos = NumOfBuffers) then BufPos := 0;
  	     	if(BufPos2 = BufPos) then begin
						Result := 0;
						Exit;
					end;
				end;

    	  Offset := MMTime.cb - FTotalMemSize[BufPos];
  	    if(FLowLVPCMFormat.nChannels = 2) and
	     												(FLowLVPCMFormat.wBitsPerSample = 16) then begin
	    	  Offset := Offset and $fffc;
    	  end else if(FLowLVPCMFormat.nChannels = 2) or
  	   												(FLowLVPCMFormat.wBitsPerSample = 16) then begin
		      Offset := Offset and $fffe;
    		end;
				while(Size > 0) and (FBufferStatus[BufPos] in [BSPlay, BSFull]) do begin
					if(Size + Offset >= FMemSize[BufPos]) then begin
						Move(Pointer(Integer(FMemPtr[BufPos])+Offset)^, Buf^,
          																					FMemSize[BufPos]-Offset);
						Inc(Integer(Buf), FMemSize[BufPos]-Offset);
						Dec(Size, FMemSize[BufPos]-Offset);
 	    	    Offset := 0;
						Inc(BufPos);
						if(BufPos = NumOfBuffers) then BufPos := 0;
					end else begin
						Move(Pointer(Integer(FMemPtr[BufPos])+Offset)^, Buf^, Size);
						Size := 0;
					end;
				end;
				Result := Size2 - Size;
	    end;
		end;
	finally
		LeaveCriticalSection(Sect1);
	end;
end;


// コマンドセット
procedure TLowLVPCMThread.SetCommand(Value : TCommand);
begin
	while(FCommand <> CMNone) do Sleep(CommandWait);
	FCommand := Value;
	while(FCommand <> CMNone) do Sleep(CommandWait);
end;


{ TOnPlayEndThread }
// 初期化
constructor TOnPlayEndThread.Create;
begin
	inherited Create(True);
end;


// 次の曲を演奏
procedure TOnPlayEndThread.Execute;
begin
	while(Terminated = False) do begin
		FLowLVPCMEvent.OnPlayEnd(Self);
		Suspend;
	end;
end;


end.
