dxsounds.pas

为delphi量身打造的 direct x控件代码

      dwFlags: DSBCAPS_PRIMARYBUFFER);
var
  Component: TComponent;
begin
  Finalize;

  Component := Owner;
  while (Component<>nil) and (not (Component is TCustomForm)) do
    Component := Component.Owner;
  if Component=nil then
    raise EDXSoundError.Create(SNoForm);

  NotifyEventList(dsntInitializing);
  DoInitializing;

  FInternalInitialized := True;
  try
    {  DirectSound initialization.  }
    FDSound := TDXSoundDirectSound.Create(Driver);
    TDXSoundDirectSound(FDSound).FDXSound := Self;

    FDSound.GlobalFocus := 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
    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 soWritePrimary in FNowOptions then
      Level := DSSCL_WRITEPRIMARY
    else 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, soWritePrimary];
  InitOptions: TDXSoundOptions = [soExclusive, soWritePrimary];
var
  OldOptions: TDXSoundOptions;
begin
  FOptions := Value;

  if Initialized then
  begin
    OldOptions := FNowOptions;

    FNowOptions := (FNowOptions - (DXSoundOptions - InitOptions)) +
      (Value - InitOptions);

    FDSound.GlobalFocus := soGlobalFocus in FNowOptions;
    FDSound.StickyFocus := soStickyFocus in FNowOptions;
  end else
    FNowOptions := FOptions;
end;

{  TWaveCollectionItem  }

constructor TWaveCollectionItem.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  FWave := TWave.Create;
end;

destructor TWaveCollectionItem.Destroy;
begin
  Finalize;
  FWave.Free;
  inherited Destroy;
end;

function TWaveCollectionItem.GetBuffer: TDirectSoundBuffer;
begin
  if (WaveCollection.DXSound.Initialized) 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.Free;
  FBuffer.Free; FBuffer := nil;
end;

procedure TWaveCollectionItem.Initialize;
begin
  Finalize;

  if not WaveCollection.Initialized then
    raise EWaveCollectionError.CreateFmt(SCannotInitialized, [ClassName]);

  FInitialized := True;

  FBuffer := TDirectSoundBuffer.Create(WaveCollection.DXSound.DSound);
  FBufferList := TList.Create;
end;

function TWaveCollectionItem.CreateBuffer: TDirectSoundBuffer;
begin
  if Buffer=nil then
    raise EWaveCollectionError.CreateFmt(SCannotInitialized, [ClassName]);

  Result := TDirectSoundBuffer.Create(WaveCollection.DXSound.DSound);
  try
    if Buffer.Status and DSBSTATUS_BUFFERLOST<>0 then
      Restore;
    Result.Assign(Buffer);
  except
    Result.Free;
    raise;
  end;
end;

procedure TWaveCollectionItem.Play(Wait: Boolean);
var
  NewBuffer: TDirectSoundBuffer;
  i: Integer;
begin
  if not WaveCollection.Initialized then Exit;
  if not FInitialized then Initialize;
         
  if FLooped then
  begin   
    Buffer.Stop;
    Buffer.Position := 0;
    Buffer.Play(DSBPLAY_LOOPING);
  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.Play(0);

    if Wait then
    begin
      try
        while NewBuffer.Playing do
          Sleep(10);
      finally
        NewBuffer.Free;
      end;
    end;
  end;
end;

procedure TWaveCollectionItem.Restore;
begin
  if not WaveCollection.Initialized then Exit;
  if not FInitialized then Initialize;

  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
    Buffer.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
    Buffer.Pan := Value;
end;

procedure TWaveCollectionItem.SetVolume(Value: Integer);
begin
  FVolume := Value;
  if FInitialized then
    Buffer.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.