?? dxsounds.pas
字號(hào):
function TAudioStream.GetFrequency: Integer;
begin
Result := FBuffer.Frequency;
end;
function TAudioStream.GetPan: Integer;
begin
Result := FBuffer.Pan;
end;
function TAudioStream.GetPlayedSize: Integer;
begin
if Playing then UpdatePlayedSize;
Result := FPlayedSize;
end;
function TAudioStream.GetSize: Integer;
begin
if WaveStream<>nil then
Result := WaveStream.Size
else
Result := 0;
end;
function TAudioStream.GetVolume: Integer;
begin
Result := FBuffer.Volume;
end;
procedure TAudioStream.UpdatePlayedSize;
var
PlayPosition, PlayedSize: DWORD;
begin
PlayPosition := FBuffer.Position;
if FPlayBufferPos <= PlayPosition then
begin
PlayedSize := PlayPosition - FPlayBufferPos
end else
begin
PlayedSize := PlayPosition + (FBufferSize - FPlayBufferPos);
end;
Inc(FPlayedSize, PlayedSize);
FPlayBufferPos := PlayPosition;
end;
function TAudioStream.GetWriteSize: Integer;
var
PlayPosition: DWORD;
i: Integer;
begin
PlayPosition := FBuffer.Position;
if FBufferPos <= PlayPosition then
begin
Result := PlayPosition - FBufferPos
end else
begin
Result := PlayPosition + (FBufferSize - FBufferPos);
end;
i := WaveStream.FilledSize;
if i>=0 then Result := Min(Result, i);
end;
procedure TAudioStream.Play;
begin
if not FPlaying then
begin
if WaveStream=nil then
raise EAudioStreamError.Create(SWaveStreamNotSet);
if Size=0 then Exit;
FPlaying := True;
try
SetPosition(FPosition);
if FAutoUpdate then
FNotifyThread := TAudioStreamNotify.Create(Self);
except
Stop;
raise;
end;
end;
end;
procedure TAudioStream.RecreateBuf;
var
APlaying: Boolean;
APosition: Integer;
AFrequency: Integer;
APan: Integer;
AVolume: Integer;
begin
APlaying := Playing;
APosition := Position;
AFrequency := Frequency;
APan := Pan;
AVolume := Volume;
SetWaveStream(WaveStream);
Position := APosition;
Frequency := AFrequency;
Pan := APan;
Volume := AVolume;
if APlaying then Play;
end;
procedure TAudioStream.SetAutoUpdate(Value: Boolean);
begin
if FAutoUpdate<>Value then
begin
FAutoUpdate := Value;
if FPlaying then
begin
if FNotifyThread<>nil then
begin
(FNotifyThread as TAudioStreamNotify).FStopOnTerminate := False;
FNotifyThread.Free;
end;
if FAutoUpdate then
FNotifyThread := TAudioStreamNotify.Create(Self);
end;
end;
end;
procedure TAudioStream.SetBufferLength(Value: Integer);
begin
if Value<10 then Value := 10;
if FBufferLength<>Value then
begin
FBufferLength := Value;
if WaveStream<>nil then RecreateBuf;
end;
end;
procedure TAudioStream.SetFrequency(Value: Integer);
begin
FBuffer.Frequency := Value;
end;
procedure TAudioStream.SetLooped(Value: Boolean);
begin
if FLooped<>Value then
begin
FLooped := Value;
Position := Position;
end;
end;
procedure TAudioStream.SetPan(Value: Integer);
begin
FBuffer.Pan := Value;
end;
procedure TAudioStream.SetPlayedSize(Value: Integer);
begin
if Playing then UpdatePlayedSize;
FPlayedSize := Value;
end;
procedure TAudioStream.SetPosition(Value: Integer);
begin
if WaveStream=nil then
raise EAudioStreamError.Create(SWaveStreamNotSet);
Value := Max(Min(Value, Size-1), 0);
Value := Value div Format^.nBlockAlign * Format^.nBlockAlign;
FPosition := Value;
if Playing then
begin
try
FBuffer.Stop;
FBufferPos := 0;
FPlayBufferPos := 0;
FWritePosition := Value;
WriteWave(FBufferSize);
FBuffer.Position := 0;
FBuffer.Play(True);
except
Stop;
raise;
end;
end;
end;
procedure TAudioStream.SetVolume(Value: Integer);
begin
FBuffer.Volume := Value;
end;
procedure TAudioStream.SetWaveStream(Value: TCustomWaveStream);
var
BufferDesc: TDSBufferDesc;
begin
Stop;
FWaveStream := nil;
FBufferPos := 0;
FPosition := 0;
FWritePosition := 0;
if (Value<>nil) and (FBufferLength>0) then
begin
FBufferSize := FBufferLength * Integer(Value.Format^.nAvgBytesPerSec) div 1000;
FillChar(BufferDesc, SizeOf(BufferDesc), 0);
with BufferDesc do
begin
dwSize := SizeOf(TDSBufferDesc);
dwFlags := DSBCAPS_CTRLDEFAULT or DSBCAPS_GETCURRENTPOSITION2;
if FDSound.FStickyFocus then
dwFlags := dwFlags or DSBCAPS_STICKYFOCUS
else if FDSound.FGlobalFocus then
dwFlags := dwFlags or DSBCAPS_GLOBALFOCUS;
dwBufferBytes := FBufferSize;
lpwfxFormat := Value.Format;
end;
if not FBuffer.CreateBuffer(BufferDesc) then
raise EDirectSoundBufferError.CreateFmt(SCannotMade, [SDirectSoundBuffer]);
end else
begin
FBuffer.IDSBuffer := nil;
FBufferSize := 0;
end;
FWaveStream := Value;
end;
procedure TAudioStream.Stop;
begin
if FPlaying then
begin
FPlaying := False;
FBuffer.Stop;
FNotifyThread.Free;
end;
end;
procedure TAudioStream.Update;
begin
Update2(False);
end;
procedure TAudioStream.Update2(InThread: Boolean);
var
WriteSize: Integer;
begin
if not FPlaying then Exit;
try
UpdatePlayedSize;
if Size<0 then
begin
WriteSize := GetWriteSize;
if WriteSize>0 then
begin
WriteSize := WriteWave(WriteSize);
FPosition := FPosition + WriteSize;
end;
end else
begin
if FLooped then
begin
WriteSize := GetWriteSize;
if WriteSize>0 then
begin
WriteWave(WriteSize);
FPosition := (FPosition + WriteSize) mod Size;
end;
end else
begin
if FPosition<Size then
begin
WriteSize := GetWriteSize;
if WriteSize>0 then
begin
WriteWave(WriteSize);
FPosition := FPosition + WriteSize;
if FPosition>Size then FPosition := Size;
end;
end else
begin
if InThread then
SetEvent(FNotifyEvent)
else
Stop;
end;
end;
end;
except
if InThread then
SetEvent(FNotifyEvent)
else
Stop;
raise;
end;
end;
function TAudioStream.WriteWave(WriteSize: Integer): Integer;
procedure WriteData(Size: Integer);
var
Data1, Data2: Pointer;
Data1Size, Data2Size: Longint;
begin
if FBuffer.Lock(FBufferPos, Size, Data1, Data1Size, Data2, Data2Size) then
begin
try
FWaveStream.Position := FWritePosition;
FWaveStream.ReadBuffer(Data1^, Data1Size);
FWritePosition := FWritePosition + Data1Size;
if Data2<>nil then
begin
FWaveStream.ReadBuffer(Data2^, Data2Size);
FWritePosition := FWritePosition + Data2Size;
end;
FBufferPos := (FBufferPos + DWORD(Data1Size) + DWORD(Data2Size)) mod FBufferSize;
finally
FBuffer.UnLock;
end;
end;
end;
procedure WriteData2(Size: Integer);
var
Data1, Data2: Pointer;
Data1Size, Data2Size, s1, s2: Longint;
begin
if FBuffer.Lock(FBufferPos, Size, Data1, Data1Size, Data2, Data2Size) then
begin
try
FWaveStream.Position := FWritePosition;
s1 := FWaveStream.Read(Data1^, Data1Size);
FWritePosition := FWritePosition + s1;
FBufferPos := (FBufferPos + DWORD(s1)) mod FBufferSize;
Inc(Result, s1);
if (Data2<>nil) and (s1=Data1Size) then
begin
s2 := FWaveStream.Read(Data2^, Data2Size);
FWritePosition := FWritePosition + s2;
FBufferPos := (FBufferPos + DWORD(s2)) mod FBufferSize;
Inc(Result, s2);
end;
finally
FBuffer.UnLock;
end;
end;
end;
procedure WriteSilence(Size: Integer);
var
C: Byte;
Data1, Data2: Pointer;
Data1Size, Data2Size: Longint;
begin
if Format^.wBitsPerSample=8 then C := $80 else C := 0;
if FBuffer.Lock(FBufferPos, Size, Data1, Data1Size, Data2, Data2Size) then
begin
try
FillChar(Data1^, Data1Size, C);
if Data2<>nil then
FillChar(Data2^, Data2Size, C);
finally
FBuffer.UnLock;
end;
FBufferPos := (FBufferPos + DWORD(Data1Size) + DWORD(Data2Size)) mod FBufferSize;
FWritePosition := FWritePosition + Data1Size + Data2Size;
end;
end;
var
DataSize: Integer;
begin
if Size>=0 then
begin
Result := WriteSize;
if FLooped then
begin
while WriteSize>0 do
begin
DataSize := Min(Size-FWritePosition, WriteSize);
WriteData(DataSize);
FWritePosition := FWritePosition mod Size;
Dec(WriteSize, DataSize);
end;
end else
begin
DataSize := Size-FWritePosition;
if DataSize<=0 then
begin
WriteSilence(WriteSize);
end else
if DataSize>=WriteSize then
begin
WriteData(WriteSize);
end else
begin
WriteData(DataSize);
WriteSilence(WriteSize-DataSize);
end;
end;
end else
begin
Result := 0;
WriteData2(WriteSize);
end;
end;
{ TAudioFileStream }
destructor TAudioFileStream.Destroy;
begin
inherited Destroy;
FWaveFileStream.Free;
end;
procedure TAudioFileStream.SetFileName(const Value: string);
begin
if FFileName=Value then Exit;
FFileName := Value;
if FWaveFileStream<>nil then
begin
WaveStream := nil;
FWaveFileStream.Free;
FWaveFileStream := nil;
end;
if Value<>'' then
begin
try
FWaveFileStream := TWaveFileStream.Create(Value, fmOpenRead or fmShareDenyWrite);
FWaveFileStream.Open(False);
WaveStream := FWaveFileStream;
except
WaveStream := nil;
FFileName := '';
raise;
end;
end;
end;
{ TSoundCaptureFormats }
constructor TSoundCaptureFormats.Create;
begin
inherited Create(TSoundCaptureFormat);
end;
function TSoundCaptureFormats.GetItem(Index: Integer): TSoundCaptureFormat;
begin
Result := TSoundCaptureFormat(inherited Items[Index]);
end;
function TSoundCaptureFormats.IndexOf(ASamplesPerSec, ABitsPerSample, AChannels: Integer): Integer;
var
i: Integer;
begin
Result := -1;
for i:=0 to Count-1 do
with Items[i] do
if (FSamplesPerSec=ASamplesPerSec) and (FBitsPerSample=ABitsPerSample) and (FChannels=AChannels) then
begin
Result := i;
Break;
end;
end;
{ TSoundCaptureStream }
type
TSoundCaptureStreamNotify = class(TThread)
private
FCapture: TSoundCaptureStream;
FSleepTime: Integer;
constructor Create(Capture: TSoundCaptureStream);
destructor Destroy; override;
procedure Execute; override;
procedure Update;
end;
constructor TSoundCaptureStreamNotify.Create(Capture: TSoundCaptureStream);
begin
FCapture := Capture;
FCapture.FNotifyEvent := CreateEvent(nil, False, False, nil);
FSleepTime := Min(FCapture.FBufferLength div 4, 1000 div 20);
FreeOnTerminate := True;
inherited Create(True);
end;
destructor TSoundCaptureStreamNotify.Destroy;
begin
FreeOnTerminate := False;
SetEvent(FCapture.FNotifyEvent);
?? 快捷鍵說(shuō)明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號(hào)
Ctrl + =
減小字號(hào)
Ctrl + -