dxsounds.pas

传奇源代码的delphi版本

    end;
end;

{  TCustomDXSound  }

type
  TDXSoundDirectSound = class(TDirectSound)
  private
    FDXSound: TCustomDXSound;
  protected
    procedure DoRestoreBuffer; override;
  end;

procedure TDXSoundDirectSound.DoRestoreBuffer;
begin
  inherited DoRestoreBuffer;
  FDXSound.Restore;
end;

constructor TCustomDXSound.Create(AOwner: TComponent);
begin
  FNotifyEventList := TList.Create;
  inherited Create(AOwner);
  FAutoInitialize := True;
  Options := [];
end;

destructor TCustomDXSound.Destroy;
begin
  Finalize;
  NotifyEventList(dsntDestroying);
  FNotifyEventList.Free;
  inherited Destroy;
end;

type
  PDXSoundNotifyEvent = ^TDXSoundNotifyEvent;

procedure TCustomDXSound.RegisterNotifyEvent(NotifyEvent: TDXSoundNotifyEvent);
var
  Event: PDXSoundNotifyEvent;
begin
  UnRegisterNotifyEvent(NotifyEvent);

  New(Event);
  Event^ := NotifyEvent;
  FNotifyEventList.Add(Event);

  if Initialized then
  begin
    NotifyEvent(Self, dsntInitialize);
    NotifyEvent(Self, dsntRestore);
  end;
end;

procedure TCustomDXSound.UnRegisterNotifyEvent(NotifyEvent: TDXSoundNotifyEvent);
var
  Event: PDXSoundNotifyEvent;
  i: Integer;
begin
  for i:=0 to FNotifyEventList.Count-1 do
  begin
    Event := FNotifyEventList[i];
    if (TMethod(Event^).Code = TMethod(NotifyEvent).Code) and
      (TMethod(Event^).Data = TMethod(NotifyEvent).Data) then
    begin
      Dispose(Event);
      FNotifyEventList.Delete(i);

      if Initialized then
        NotifyEvent(Self, dsntFinalize);

      Break;
    end;
  end;
end;

procedure TCustomDXSound.NotifyEventList(NotifyType: TDXSoundNotifyType);
var
  i: Integer;
begin
  for i:=FNotifyEventList.Count-1 downto 0 do
    PDXSoundNotifyEvent(FNotifyEventList[i])^(Self, NotifyType);
end;

procedure TCustomDXSound.FormWndProc(var Message: TMessage; DefWindowProc: TWndMethod);
begin
  case Message.Msg of
    WM_CREATE:
        begin
          DefWindowProc(Message);
          SetForm(FForm);
          Exit;
        end;
  end;
  DefWindowProc(Message);
end;

class function TCustomDXSound.Drivers: TDirectXDrivers;
begin
  Result := EnumDirectSoundDrivers;
end;

procedure TCustomDXSound.DoFinalize;
begin
  if Assigned(FOnFinalize) then FOnFinalize(Self);
end;

procedure TCustomDXSound.DoInitialize;
begin
  if Assigned(FOnInitialize) then FOnInitialize(Self);
end;

procedure TCustomDXSound.DoInitializing;
begin
  if Assigned(FOnInitializing) then FOnInitializing(Self);
end;

procedure TCustomDXSound.DoRestore;
begin
  if Assigned(FOnRestore) then FOnRestore(Self);
end;

procedure TCustomDXSound.Finalize;
begin
  if FInternalInitialized then
  begin
    try
      FSubClass.Free; FSubClass := nil;

      try
        if FCalledDoInitialize then
        begin
          FCalledDoInitialize := False;
          DoFinalize;
        end;
      finally
        NotifyEventList(dsntFinalize);
      end;
    finally
      FInitialized := False;
      FInternalInitialized := False;

      SetOptions(FOptions);

      FPrimary.Free; FPrimary := nil;
      FDSound.Free;  FDSound := nil;
    end;
  end;
end;

procedure TCustomDXSound.Initialize;
const
  PrimaryDesc: TDSBufferDesc = (
      dwSize: SizeOf (PrimaryDesc);
      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.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.GetPlaying : boolean;
var
  Buffer : TDirectSoundBuffer;
  index : integer;
begin
Result := false;
if not FInitialized then Exit;
assert(GetBuffer <> nil);
assert(FBufferList <> nil);
if FLooped then
  begin
  Buffer := GetBuffer;
  assert(Buffer <> nil);
  result := Buffer.Playing;
  end
else
  begin
  for index := 0 to FBufferList.Count - 1  do
    begin
    result := TDirectSoundBuffer(FBufferList[index]).Playing;
    if result then
      Break;
    end;
  end;
end; {GetPlaying}

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
    FMaxPlay