VPF::Изменить громкость - Форум программистов

Sergey89

Дата 6.12.2004, 16:46 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 122
Регистрация: 14.9.2004

Репутация: нет
Всего: нет

Как сделать регулятор громкости в Delphi? Громкость должна изменяться только для TMediaPlayer, а не для всей ситемы!

--------------------

mlib.com.ru

Sergey89

Дата 8.12.2004, 18:55 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 122
Регистрация: 14.9.2004

Репутация: нет
Всего: нет

--------------------

mlib.com.ru

Albinos_x

Дата 15.12.2004, 11:09 (ссылка)

(нет голосов)

Загрузка ...

Evil Skynet

Профиль
Группа: Комодератор
Сообщений: 3288
Регистрация: 28.5.2004
Где: X-6120400 Y-1 4624650

Репутация: 1
Всего: 108

если не ошибаюсь это есть в DRKB

--------------------

"Кто владеет информацией, тот владеет миром"
Уинстон Черчилль

Illusion Dolphin

Дата 15.12.2004, 11:46 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 1198
Регистрация: 3.5.2003

Репутация: 13
Всего: 63

DRKB :

Цитата

Эта программа увеличивает громкость выбранного канала на 1000:

Код


uses MMSystem; 

procedure TForm1.Button1Click(Sender: TObject); 
var 
  vol: longint; 
  LVol, RVol: integer; 
begin 
  AuxGetVolume(ListBox1.ItemIndex, @Vol); 
  LVol := Vol shr 16; 
  if LVol < MaxWord - 1000 then 
    LVol := LVol + 1000 
  else 
    LVol := MaxWord; 
  RVol := (Vol shl 16) shr 16; 
  if RVol < MaxWord - 1000 then 
    RVol := RVol + 1000 
  else 
    RVol := MaxWord; 
  AuxSetVolume(ListBox1.ItemIndex, LVol shl 16 + RVol); 
end; 

procedure TForm1.FormCreate(Sender: TObject); 
var 
  i: integer; 
  cap: TAuxCaps; 
begin 
  for i := 0 to auxGetNumDevs - 1 do 
  begin 
    auxGetDevCaps(i, Addr(cap), SizeOf(cap)); 
    ListBox1.Items.Add(cap.szPname) 
  end; 
end; 

--------------------------------------------------------------------------------

procedure SetVolume(X: Word); 
var 
  iErr: Integer; 
  i: integer; 
  a: TAuxCaps; 
begin 
  for i := 0 to auxGetNumDevs do 
  begin 
    auxGetDevCaps(i, Addr(a), SizeOf(a)); 
    if a.wTechnology = AUXCAPS_CDAUDIO then 
      break; 
  end; 

  // Устанавливаем одинаковую громкость для левого и правого каналов. 
  // VOLUME := LEFT*$10000 + RIGHT*1 

  iErr := auxSetVolume(i, (X * $10001)); 
  if (iErr‹›0) then 
    ShowMessage('No audio devices are available!'); 
end; 

function GetVolume: Word; 
var 
  iErr: Integer; 
  i: integer; 
  a: TAuxCaps; 
  vol: word; 
begin 
  for i := 0 to auxGetNumDevs do 
  begin 
    auxGetDevCaps(i, Addr(a), SizeOf(a)); 
    if a.wTechnology = AUXCAPS_CDAUDIO then 
      break; 
  end; 
  iErr := auxGetVolume(i, addr(vol)); 
  GetVolume := vol; 
  if (iErr‹›0) then 
    ShowMessage('No audio devices are available!'); 
end; 

--------------------------------------------------------------------------------

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[I])  
      then FTrackBars[I] := Nil;  
    end;  
  
    procedure      TVolumeControl.Update(Sender: TObject);  
    var I: Integer;  
    begin  
      for I := 0 to 2 do  
      if Assigned(FTrackBars[I]) then 
      with FTrackBars[I] 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[I]) then  
      FTrackBars[I].OnChange := Nil;  
      inherited Destroy; 
    end;  
  
    procedure      TVolumeControl.Changed(Sender: TObject);  
    var I: Integer;  
    begin  
      for I := 0 to 2 do  
      if Sender = FTrackBars[I] then  
      with FTrackBars[I] 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.

--------------------------------------------------------------------------------

Выставь на форму 2 тракбара и двигай их. Если у тебя звучит музыка, ты должен услышать изменения громкости правого и левого каналов.

Код


procedure TForm1.TrackBar1Change(Sender: TObject); 
var 
 s: dword; 
 a,b: word; 
 h: hWnd; 
begin 
 a:=trackbar1.position; 
 b:=trackbar2.position; 
 s:=(a shl 16) or b; 
 waveOutSetVolume(h,s); 
end;

свойство Max в каждом TrackBar'e должно равняться 65535 (то есть MaxWord)

Взято с www.delphiworld.narod.ru

Это сообщение отредактировал(а) Alexeis - 27.8.2007, 23:08

--------------------

В мире всего две бесконечности: вселенная и человеческая глупость... На счёт вселенной я не уверен.
Шифрование и организация фотографий - Photo Database 4.5

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Звук, графика и видео \| Следующая тема »