Работа со звуком

Тема в разделе "Delphi - Multimedia, Графика, Игры", создана пользователем DCoder, 16 июн 2006.

Статус темы:
Закрыта.
  1. DCoder

    DCoder Гость

    Как изменить громкость воспроизводимого звука, если я работаю с TMediaPlayer? Или хотя бы общую громкость в системе... Да и вообще, с помощью чего лучше работать со звуком?
     
  2. Barmutik

    Barmutik Гость

    Смотря какие возможности Вы хотите использовать при работе .. отсюда следует и варинаты .. как самый простой наверное DirectSound...
     
  3. DCoder

    DCoder Гость

    Где я могу узнать о DirectSound?
     
  4. vital

    vital Больной Компом Детектед
    Команда форума Web Team

    Регистрация:
    29 янв 2006
    Сообщения:
    2.474
    Симпатии:
    27
    function GetWaveVolume: DWord;
    var Woc : TWaveOutCaps;
    Volume : DWord;
    begin
    result:=0;
    if WaveOutGetDevCaps(WAVE_MAPPER, @Woc, sizeof(Woc)) =
    MMSYSERR_NOERROR then begin
    if Woc.dwSupport and WAVECAPS_VOLUME = WAVECAPS_VOLUME then begin
    WaveOutGetVolume(WAVE_MAPPER,@Volume);
    Result := Volume;
    end;
    end;
    end;

    procedure SetWaveVolume(const AVolume: DWord);
    var Woc : TWaveOutCaps;
    begin
    if WaveOutGetDevCaps(WAVE_MAPPER, @Woc, sizeof(Woc)) =
    MMSYSERR_NOERROR then begin
    if Woc.dwSupport and WAVECAPS_VOLUME = WAVECAPS_VOLUME then
    WaveOutSetVolume(WAVE_MAPPER,AVolume);
    end;
    end;
     
  5. DCoder

    DCoder Гость

    vital:
    а какие границы устанавливаемой громкости? Верхняя, как я понял, - это MaxInt. Или нет?
     
  6. vital

    vital Больной Компом Детектед
    Команда форума Web Team

    Регистрация:
    29 янв 2006
    Сообщения:
    2.474
    Симпатии:
    27
    минимальная-0, максимальная-молодец, можешь сьесть пирожок.

    пс.
    забыл сказать..
    Функция эта работает, но очень криво. Побалуйся с изменением громкости и всё поймешь..
     
  7. DCoder

    DCoder Гость

    Ну я попробовал изменять громкость, вроде всё нормально... никаких кривостей.
     
  8. vital

    vital Больной Компом Детектед
    Команда форума Web Team

    Регистрация:
    29 янв 2006
    Сообщения:
    2.474
    Симпатии:
    27
    ну..а мне не нравітся..
    Try this..

    unit Volumes;

    interface

    uses
    Windows, Messages, Classes, ExtCtrls, ComCtrls, MMSystem;

    const
    CDVolume = 0;
    WaveVolume = 1;
    MidiVolume = 2;

    type
    TVolumeControl = class(TComponent)
    private
    FDevices : array[0..2] of Integer;
    FTrackBars : array[0..2] of TTrackBar;
    FTimer : TTimer;
    function GetInterval: Integer;
    procedure SetInterval(AInterval: Integer);
    function GetVolume(AIndex: Integer): Byte;
    procedure SetVolume(AIndex: Integer; aVolume: Byte);
    procedure InitVolume;
    procedure SetTrackBar(AIndex: Integer; ATrackBar: TTrackBar);
    { Private declarations }
    procedure Update(Sender: TObject);
    procedure Changed(Sender: TObject);
    protected
    { Protected declarations }
    procedure Notification(AComponent: TComponent; AOperation:
    TOperation); override;
    public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    published
    { Published declarations }
    property Interval: Integer read GetInterval write SetInterval default
    500;
    property CDVolume: Byte index 0 read GetVolume write SetVolume stored
    False;
    property CDTrackBar: TTrackBar index 0 read FTrackBars[0] write
    SetTrackBar;
    property WaveVolume: Byte index 1 read GetVolume write SetVolume
    stored False;
    property WaveTrackBar: TTrackBar index 1 read FTrackBars[1] write
    SetTrackBar;
    property MidiVolume: Byte index 2 read GetVolume write SetVolume
    stored False;
    property MidiTrackBar: TTrackBar index 2 read FTrackBars[2] write
    SetTrackBar;
    end;

    procedure Register;

    implementation

    procedure Register;
    begin
    RegisterComponents('Any', [TVolumeControl]);
    end;

    type
    TVolumeRec = record
    case Integer of
    0: (LongVolume: Longint);
    1: (LeftVolume,
    RightVolume : Word);
    end;

    function TVolumeControl.GetInterval: Integer;
    begin
    Result := FTimer.Interval;
    end;

    procedure TVolumeControl.SetInterval(AInterval: Integer);
    begin
    FTimer.Interval := AInterval;
    end;

    function TVolumeControl.GetVolume(AIndex: Integer): Byte;
    var Vol: TVolumeRec;
    begin
    Vol.LongVolume := 0;
    if FDevices[AIndex] < > -1 then
    case AIndex of
    0: auxGetVolume(FDevices[AIndex], @Vol.LongVolume);
    1: waveOutGetVolume(FDevices[AIndex], @Vol.LongVolume);
    2: midiOutGetVolume(FDevices[AIndex], @Vol.LongVolume);
    end;
    Result := (Vol.LeftVolume + Vol.RightVolume) shr 9;
    end;

    procedure TVolumeControl.SetVolume(aIndex: Integer; aVolume: Byte);
    var Vol: TVolumeRec;
    begin
    if FDevices[AIndex] < > -1 then
    begin
    Vol.LeftVolume := aVolume shl 8;
    Vol.RightVolume := Vol.LeftVolume;
    case AIndex of
    0: auxSetVolume(FDevices[AIndex], Vol.LongVolume);
    1: waveOutSetVolume(FDevices[AIndex], Vol.LongVolume);
    2: midiOutSetVolume(FDevices[AIndex], Vol.LongVolume);
    end;
    end;
    end;

    procedure TVolumeControl.SetTrackBar(AIndex: Integer; ATrackBar:
    TTrackBar);
    begin
    if ATrackBar < > FTrackBars[AIndex] then
    begin
    FTrackBars[AIndex] := ATrackBar;
    Update(Self);
    end;
    end;

    AOperation: TOperation);
    var I: Integer;
    begin
    inherited Notification(AComponent, AOperation);
    if (AOperation = opRemove) then
    for I := 0 to 2 do if (AComponent = FTrackBars)
    then FTrackBars := Nil;
    end;

    procedure TVolumeControl.Update(Sender: TObject);
    var I: Integer;
    begin
    for I := 0 to 2 do
    if Assigned(FTrackBars) then
    with FTrackBars do
    begin
    Min := 0;
    Max := 255;
    if Orientation = trVertical
    then Position := 255 - GetVolume(I)
    else Position := GetVolume(I);
    OnChange := Self.Changed;
    end;
    end;

    constructor TVolumeControl.Create(AOwner: TComponent);
    begin
    inherited Create(AOwner);
    FTimer := TTimer.Create(Self);
    FTimer.OnTimer := Update;
    FTimer.Interval := 500;
    InitVolume;
    end;

    destructor TVolumeControl.Destroy;
    var I: Integer;
    begin
    FTimer.Free;
    for I := 0 to 2 do
    if Assigned(FTrackBars) then
    FTrackBars.OnChange := Nil;
    inherited Destroy;
    end;

    procedure TVolumeControl.Changed(Sender: TObject);
    var I: Integer;
    begin
    for I := 0 to 2 do
    if Sender = FTrackBars then
    with FTrackBars do
    begin
    if Orientation = trVertical
    then SetVolume(I, 255 - Position)
    else SetVolume(I, Position);
    end;
    end;

    procedure TVolumeControl.InitVolume;
    var AuxCaps : TAuxCaps;
    WaveOutCaps : TWaveOutCaps;
    MidiOutCaps : TMidiOutCaps;
    I,J : Integer;
    begin
    FDevices[0] := -1;
    for I := 0 to auxGetNumDevs - 1 do
    begin
    auxGetDevCaps(I, @AuxCaps, SizeOf(AuxCaps));
    if (AuxCaps.dwSupport and AUXCAPS_VOLUME) < > 0 then
    begin
    FTimer.Enabled := True;
    FDevices[0] := I;
    break;
    end;
    end;
    FDevices[1] := -1;
    for I := 0 to waveOutGetNumDevs - 1 do
    begin
    waveOutGetDevCaps(I, @WaveOutCaps, SizeOf(WaveOutCaps));
    if (WaveOutCaps.dwSupport and WAVECAPS_VOLUME) < > 0 then
    begin
    FTimer.Enabled := True;
    FDevices[1] := I;
    break;
    end;
    end;
    FDevices[2] := -1;
    for I := 0 to midiOutGetNumDevs - 1 do
    begin
    MidiOutGetDevCaps(I, @MidiOutCaps, SizeOf(MidiOutCaps));
    if (MidiOutCaps.dwSupport and MIDICAPS_VOLUME) < > 0 then
    begin
    FTimer.Enabled := True;
    FDevices[2] := I;
    break;
    end;
    end;
    end;

    end.
     
Загрузка...
Статус темы:
Закрыта.

Поделиться этой страницей