?? dxsounds.pas
字號(hào):
NotifyEventList(dsntInitializing);
DoInitializing;
FInternalInitialized := True;
try
{ DirectSound initialization. }
FDSound := TDXSoundDirectSound.Create(Driver);
TDXSoundDirectSound(FDSound).FDXSound := Self;
FDSound.FGlobalFocus := soGlobalFocus in FNowOptions;
{ Primary buffer made. }
FPrimary := TDirectSoundBuffer.Create(FDSound);
if not FPrimary.CreateBuffer(PrimaryDesc) then
raise EDXSoundError.CreateFmt(SCannotMade, [SDirectSoundPrimaryBuffer]);
FInitialized := True;
SetForm(TCustomForm(Component));
except
Finalize;
raise;
end;
NotifyEventList(dsntInitialize);
FCalledDoInitialize := True; DoInitialize;
Restore;
end;
procedure TCustomDXSound.Loaded;
begin
inherited Loaded;
if FAutoInitialize and (not (csDesigning in ComponentState)) then
begin
try
Initialize;
except
on E: EDirectSoundError do ;
else raise;
end;
end;
end;
procedure TCustomDXSound.Restore;
begin
if FInitialized then
begin
NotifyEventList(dsntRestore);
DoRestore;
end;
end;
procedure TCustomDXSound.SetDriver(Value: PGUID);
begin
if not IsBadHugeReadPtr(Value, SizeOf(TGUID)) then
begin
FDriverGUID := Value^;
FDriver := @FDriverGUID;
end else
FDriver := Value;
end;
procedure TCustomDXSound.SetForm(Value: TCustomForm);
var
Level: Integer;
begin
FForm := Value;
FSubClass.Free;
FSubClass := TControlSubClass.Create(FForm, FormWndProc);
if FInitialized then
begin
if soExclusive in FNowOptions then
Level := DSSCL_EXCLUSIVE
else
Level := DSSCL_NORMAL;
FDSound.DXResult := FDSound.ISound.SetCooperativeLevel(FForm.Handle, Level);
end;
end;
procedure TCustomDXSound.SetOptions(Value: TDXSoundOptions);
const
DXSoundOptions = [soGlobalFocus, soStickyFocus, soExclusive];
InitOptions: TDXSoundOptions = [soExclusive];
var
OldOptions: TDXSoundOptions;
begin
FOptions := Value;
if Initialized then
begin
OldOptions := FNowOptions;
FNowOptions := (FNowOptions - (DXSoundOptions - InitOptions)) +
(Value - InitOptions);
FDSound.FGlobalFocus := soGlobalFocus in FNowOptions;
FDSound.FStickyFocus := soStickyFocus in FNowOptions;
end else
FNowOptions := FOptions;
end;
{ TWaveCollectionItem }
constructor TWaveCollectionItem.Create(Collection: TCollection);
begin
inherited Create(Collection);
FWave := TWave.Create;
FBufferList := TList.Create;
end;
destructor TWaveCollectionItem.Destroy;
begin
Finalize;
FWave.Free;
FBufferList.Free;
inherited Destroy;
end;
procedure TWaveCollectionItem.Assign(Source: TPersistent);
var
PrevInitialized: Boolean;
begin
if Source is TWaveCollectionItem then
begin
PrevInitialized := Initialized;
Finalize;
FLooped := TWaveCollectionItem(Source).FLooped;
Name := TWaveCollectionItem(Source).Name;
FMaxPlayingCount := TWaveCollectionItem(Source).FMaxPlayingCount;
FFrequency := TWaveCollectionItem(Source).FFrequency;
FPan := TWaveCollectionItem(Source).FPan;
FVolume := TWaveCollectionItem(Source).FVolume;
FWave.Assign(TWaveCollectionItem(Source).FWave);
if PrevInitialized then
Restore;
end else
inherited Assign(Source);
end;
function TWaveCollectionItem.GetBuffer: TDirectSoundBuffer;
begin
if FInitialized and (FBuffer=nil) then
Restore;
Result := FBuffer;
end;
function TWaveCollectionItem.GetWaveCollection: TWaveCollection;
begin
Result := Collection as TWaveCollection;
end;
procedure TWaveCollectionItem.Finalize;
var
i: Integer;
begin
if not FInitialized then Exit;
FInitialized := False;
for i:=0 to FBufferList.Count-1 do
TDirectSoundBuffer(FBufferList[i]).Free;
FBufferList.Clear;
FBuffer.Free; FBuffer := nil;
end;
procedure TWaveCollectionItem.Initialize;
begin
Finalize;
FInitialized := WaveCollection.Initialized;
end;
function TWaveCollectionItem.CreateBuffer: TDirectSoundBuffer;
begin
Result := nil;
if GetBuffer=nil then Exit;
Result := TDirectSoundBuffer.Create(WaveCollection.DXSound.DSound);
try
Result.Assign(GetBuffer);
except
Result.Free;
raise;
end;
end;
procedure TWaveCollectionItem.Play(Wait: Boolean);
var
NewBuffer: TDirectSoundBuffer;
i: Integer;
begin
if not FInitialized then Exit;
if FLooped then
begin
GetBuffer.Stop;
GetBuffer.Position := 0;
GetBuffer.Play(True);
end else
begin
NewBuffer := nil;
for i:=0 to FBufferList.Count-1 do
if not TDirectSoundBuffer(FBufferList[i]).Playing then
begin
NewBuffer := FBufferList[i];
Break;
end;
if NewBuffer=nil then
begin
if FMaxPlayingCount=0 then
begin
NewBuffer := CreateBuffer;
if NewBuffer=nil then Exit;
FBufferList.Add(NewBuffer);
end else
begin
if FBufferList.Count<FMaxPlayingCount then
begin
NewBuffer := CreateBuffer;
if NewBuffer=nil then Exit;
FBufferList.Add(NewBuffer);
end else
begin
NewBuffer := FBufferList[0];
FBufferList.Move(0, FBufferList.Count-1);
end;
end;
end;
NewBuffer.Stop;
NewBuffer.Position := 0;
NewBuffer.Frequency := FFrequency;
NewBuffer.Pan := FPan;
NewBuffer.Volume := FVolume;
NewBuffer.Play(False);
if Wait then
begin
while NewBuffer.Playing do
Sleep(10);
end;
end;
end;
procedure TWaveCollectionItem.Restore;
begin
if FWave.Size=0 then Exit;
if not FInitialized then
begin
if WaveCollection.Initialized then
Initialize;
if not FInitialized then Exit;
end;
if FBuffer=nil then
FBuffer := TDirectSoundBuffer.Create(WaveCollection.DXSound.DSound);
FBuffer.LoadFromWave(FWave);
FBuffer.Frequency := FFrequency;
FBuffer.Pan := FPan;
FBuffer.Volume := FVolume;
end;
procedure TWaveCollectionItem.Stop;
var
i: Integer;
begin
if not FInitialized then Exit;
FBuffer.Stop;
for i:=0 to FBufferList.Count-1 do
TDirectSoundBuffer(FBufferList[i]).Stop;
end;
procedure TWaveCollectionItem.SetFrequency(Value: Integer);
begin
FFrequency := Value;
if FInitialized then
GetBuffer.Frequency := Value;
end;
procedure TWaveCollectionItem.SetLooped(Value: Boolean);
begin
if FLooped<>Value then
begin
Stop;
FLooped := Value;
end;
end;
procedure TWaveCollectionItem.SetMaxPlayingCount(Value: Integer);
var
i: Integer;
begin
if Value<0 then Value := 0;
if FMaxPlayingCount<>Value then
begin
FMaxPlayingCount := Value;
if FInitialized then
begin
for i:=0 to FBufferList.Count-1 do
TDirectSoundBuffer(FBufferList[i]).Free;
FBufferList.Clear;
end;
end;
end;
procedure TWaveCollectionItem.SetPan(Value: Integer);
begin
FPan := Value;
if FInitialized then
GetBuffer.Pan := Value;
end;
procedure TWaveCollectionItem.SetVolume(Value: Integer);
begin
FVolume := Value;
if FInitialized then
GetBuffer.Volume := Value;
end;
procedure TWaveCollectionItem.SetWave(Value: TWave);
begin
FWave.Assign(Value);
end;
{ TWaveCollection }
constructor TWaveCollection.Create(AOwner: TPersistent);
begin
inherited Create(TWaveCollectionItem);
FOwner := AOwner;
end;
function TWaveCollection.GetItem(Index: Integer): TWaveCollectionItem;
begin
Result := TWaveCollectionItem(inherited Items[Index]);
end;
function TWaveCollection.GetOwner: TPersistent;
begin
Result := FOwner;
end;
function TWaveCollection.Find(const Name: string): TWaveCollectionItem;
var
i: Integer;
begin
i := IndexOf(Name);
if i=-1 then
raise EWaveCollectionError.CreateFmt(SWaveNotFound, [Name]);
Result := Items[i];
end;
procedure TWaveCollection.Finalize;
var
i: Integer;
begin
for i:=0 to Count-1 do
Items[i].Finalize;
FDXSound := nil;
end;
procedure TWaveCollection.Initialize(DXSound: TCustomDXSound);
var
i: Integer;
begin
Finalize;
FDXSound := DXSound;
for i:=0 to Count-1 do
Items[i].Initialize;
end;
function TWaveCollection.Initialized: Boolean;
begin
Result := (FDXSound<>nil) and (FDXSound.Initialized);
end;
procedure TWaveCollection.Restore;
var
i: Integer;
begin
for i:=0 to Count-1 do
Items[i].Restore;
end;
type
TWaveCollectionComponent = class(TComponent)
private
FList: TWaveCollection;
published
property List: TWaveCollection read FList write FList;
end;
procedure TWaveCollection.LoadFromFile(const FileName: string);
var
Stream: TFileStream;
begin
Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
try
LoadFromStream(Stream);
finally
Stream.Free;
end;
end;
procedure TWaveCollection.LoadFromStream(Stream: TStream);
var
Component: TWaveCollectionComponent;
begin
Clear;
Component := TWaveCollectionComponent.Create(nil);
try
Component.FList := Self;
Stream.ReadComponentRes(Component);
if Initialized then
begin
Initialize(FDXSound);
Restore;
end;
finally
Component.Free;
end;
end;
procedure TWaveCollection.SaveToFile(const FileName: string);
var
Stream: TFileStream;
begin
Stream := TFileStream.Create(FileName, fmCreate);
try
SaveToStream(Stream);
finally
Stream.Free;
end;
end;
procedure TWaveCollection.SaveToStream(Stream: TStream);
var
Component: TWaveCollectionComponent;
begin
Component := TWaveCollectionComponent.Create(nil);
try
Component.FList := Self;
Stream.WriteComponentRes('DelphiXWaveCollection', Component);
finally
Component.Free;
end;
end;
{ TCustomDXWaveList }
constructor TCustomDXWaveList.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FItems := TWaveCollection.Create(Self);
end;
destructor TCustomDXWaveList.Destroy;
begin
DXSound := nil;
FItems.Free;
inherited Destroy;
end;
procedure TCustomDXWaveList.Notification(AComponent: TComponent; Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation=opRemove) and (DXSound=AComponent) then
DXSound := nil;
end;
procedure TCustomDXWaveList.DXSoundNotifyEvent(Sender: TCustomDXSound;
NotifyType: TDXSoundNotifyType);
begin
case NotifyType of
dsntDestroying: DXSound := nil;
dsntInitialize: FItems.Initialize(Sender);
dsntFinalize : FItems.Finalize;
dsntRestore : FItems.Restore;
end;
end;
procedure TCustomDXWaveList.SetDXSound(Value: TCustomDXSound);
begin
if FDXSound<>nil then
FDXSound.UnRegisterNotifyEvent(DXSoundNotifyEvent);
FDXSound := Value;
if FDXSound<>nil then
FDXSound.RegisterNotifyEvent(DXSoundNotifyEvent);
end;
procedure TCustomDXWaveList.SetItems(Value: TWaveCollection);
begin
FItems.Assign(Value);
end;
initialization
finalization
DirectSoundDrivers.Free;
DirectSoundCaptureDrivers.Free;
end.
?? 快捷鍵說(shuō)明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號(hào)
Ctrl + =
減小字號(hào)
Ctrl + -