Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2005.10.23;
Скачать: CL | DM;

Вниз

ПОМОГИТЕ! Как управлять громкостью?   Найти похожие ветки 

 
anamal ©   (2005-03-06 19:44) [0]

Пожалуйста, подскажите как управлять громкостью видео и аудео файла?
Ну, например, на TMediaPlayer что-то проигрывается и нужно изменить громкость?
Заранее благодарен!


 
Narik ©   (2005-03-07 00:16) [1]

unit Main;

interface

uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 ComCtrls, MMSystem, Buttons, ExtCtrls, StdCtrls, ShellAPI;

type
 TMainForm = class(TForm)
   VolumeBar: TProgressBar;
   cmdMinVolume: TSpeedButton;
   cmdMaxVolume: TSpeedButton;
   procedure FormCreate(Sender: TObject);
   procedure VolumeBarMouseDown(Sender: TObject; Button: TMouseButton;
     Shift: TShiftState; X, Y: Integer);
   procedure FormDestroy(Sender: TObject);
   procedure cmdMinVolumeClick(Sender: TObject);
   procedure cmdMaxVolumeClick(Sender: TObject);
 private
   { Private declarations }
   procedure MixCtrlChange(var mess : TMessage); message MM_MIXM_CONTROL_CHANGE;
 public
   { Public declarations }
 end;

var
 MainForm: TMainForm;
 hmix:integer;
 mixcaps:TMixerCaps;
 volumeID,volmin,volmax:integer;
 details:TMixerControlDetails;
 mixctrl:TMixerControl;
 valdets:TMixerControlDetailsUnsigned;
 curvolume:dword;
 svEnable : boolean;

implementation

{$R *.DFM}

procedure TMainForm.MixCtrlChange(var mess : TMessage);
begin
 if not svEnable then Exit;
 if WindowState = wsMinimized Then Exit;
 Details.cbStruct := SizeOf(Details);
 Details.dwControlID := VolumeID;
 Details.cChannels := 1;
 Details.cMultipleItems := 0;
 Details.cbDetails := SizeOf(Valdets);
 Details.paDetails := @valdets;
 mixerGetControlDetails(hmix, @details, MIXER_GETCONTROLDETAILSF_VALUE);
 CurVolume := Valdets.dwValue;
 VolumeBar.Position := CurVolume;
end;

procedure TMainForm.FormCreate(Sender: TObject);
var
 i          : Integer;
 MixLine    : TMixerLine;
 MixLineCtrl: TMixerLineControls;
 MixCtrl    : TMixerControl;
begin
 inherited;
 MixerOpen(@hmix, 0, Handle, 0, MIXER_OBJECTF_MIXER or CALLBACK_WINDOW);
 MixerGetDevCaps(0, @mixcaps, SizeOf(MixCaps));
 For I := 0 to MixCaps.cDestinations - 1 do
  begin
    Mixline.dwDestination := I;
    Mixline.cbStruct := SizeOf(Mixline);
    MixerGetLineInfo(hmix, @mixline, MIXER_GETLINEINFOF_DESTINATION);
    If Mixline.dwComponentType = MIXERLINE_COMPONENTTYPE_DST_SPEAKERS then
        break;
  end;
 if Mixline.dwComponentType <> MIXERLINE_COMPONENTTYPE_DST_SPEAKERS then
  begin
    ShowMessage("Миксер не найден !");
    svEnable := False;
    Exit;
  end
 else
    svEnable := True;
    MixLineCtrl.cbStruct := SizeOf(MixLineCtrl);
    MixLineCtrl.dwControlType := MIXERCONTROL_CONTROLTYPE_VOLUME;
    MixLineCtrl.dwLineID := MixLine.dwLineID;
    MixLineCtrl.cControls := 2;
    MixLineCtrl.cbmxctrl := Sizeof(MixCtrl);
    MixCtrl.dwControlType := MIXERCONTROL_CONTROLTYPE_VOLUME;
    MixLineCtrl.pamxctrl := @MixCtrl;
    MixerGetLineControls(hmix, @mixlinectrl, MIXER_GETLINECONTROLSF_ONEBYTYPE);
    VolumeID := MixCtrl.dwControlID;
    VolMin := MixCtrl.Bounds.dwMinimum;
    VolMax := MixCtrl.Bounds.dwMaximum;
    Details.cbStruct := Sizeof(Details);
    Details.dwControlID := VolumeID;
    Details.cChannels := 1;
    Details.cMultipleItems := 0;
    Details.cbDetails := SizeOf(Valdets);
    Details.paDetails := @valdets;
    MixerGetControlDetails(hmix, @details, MIXER_GETCONTROLDETAILSF_VALUE);
    CurVolume := Valdets.dwValue;
    VolumeBar.Min := VolMin;
    VolumeBar.Max := VolMax;
    VolumeBar.Position := CurVolume;
end;

procedure TMainForm.VolumeBarMouseDown(Sender: TObject;
 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
 if not svEnable Then exit;
 X := Round(X / VolumeBar.Width * (VolumeBar.Max - VolumeBar.Min) + VolumeBar.Min);
 VolumeBar.Position := X;
 Details.cbStruct := Sizeof(Details);
 Details.dwControlID := VolumeID;
 Details.cChannels := 1;
 Details.cMultipleItems := 0;
 Details.cbDetails := Sizeof(Valdets);
 Details.paDetails := @Valdets;
 if X >4000 then
   Valdets.dwValue := VolumeBar.Position
 else
   Valdets.dwValue := 0;
 MixerSetControlDetails(hmix, @details, MIXER_SETCONTROLDETAILSF_VALUE);
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
 if not svEnable then Exit;
 MixerClose(hmix);
 inherited;
end;

procedure TMainForm.cmdMinVolumeClick(Sender: TObject);
begin
 if not svEnable then Exit;
 VolumeBar.Position := VolumeBar.Position - (VolumeBar.Max - VolumeBar.Min) div 10;
 if VolumeBar.Position < VolumeBar.Min then
   VolumeBar.Position := VolumeBar.Min;
 Details.cbStruct := SizeOf(Details);
 Details.dwControlID := VolumeID;
 details.cChannels := 1;
 Details.cMultipleItems := 0;
 Details.cbDetails := SizeOf(Valdets);
 Details.paDetails := @Valdets;
 if VolumeBar.Position > 4000 then
   valdets.dwValue := VolumeBar.Position
 else
   valdets.dwValue := 0;
 MixerSetControlDetails(hmix, @details, MIXER_SETCONTROLDETAILSF_VALUE);
end;

procedure TMainForm.cmdMaxVolumeClick(Sender: TObject);
begin
 if not svEnable then Exit;
 VolumeBar.Position := VolumeBar.Position + (VolumeBar.Max - VolumeBar.Min) div 10;
 if VolumeBar.Position > VolumeBar.Max then
    VolumeBar.Position := VolumeBar.Max;
 Details.cbStruct := SizeOf(Details);
 Details.dwControlID := VolumeID;
 Details.cChannels := 1;
 Details.cMultipleItems := 0;
 Details.cbDetails := SizeOf(Valdets);
 Details.paDetails := @Valdets;
 if VolumeBar.Position > 4000 then
   Valdets.dwValue := VolumeBar.Position
 else
   Valdets.dwValue:=0;
 MixerSetControlDetails(hmix, @details, MIXER_SETCONTROLDETAILSF_VALUE);
end;

end.


 
vakir ©   (2005-03-09 15:13) [2]

бросай на форму TrackBar, на событие onChange пиши:
d1:=trackbar1.position;
d1:=d2; //Оба динамика меняют громкость одинаково
vol:=(a shl 16) or b;
waveOutSetVolume(h,vol);
где, d1,d2:word; vol: dword; h:hWnd;
TrackBar.Max:=65535;


 
Narik ©   (2005-03-16 19:33) [3]

vakir ©   (09.03.05 15:13) [2]

ну да он выдаёт ошибку:
 vol:=(a shl 16) or b;
что такое a???


 
Kair+ ©   (2005-03-17 21:28) [4]


> Narik ©   (16.03.05 19:33) [3]
> vakir ©   (09.03.05 15:13) [2]
>
> ну да он выдаёт ошибку:
>  vol:=(a shl 16) or b;
> что такое a???


это у него правый и левый каналы (баланс):
это типа функция function MakeLong(A, B: Word): LongInt.


 
kai ©   (2005-03-19 00:49) [5]

ну если уж через MCI TMediaPlayer, то можно и попроще:

mciSendstring(PAnsiChar("setaudio "" + MediaPlayer1.FileName +
 "" volume to " + IntToStr(Volume)), nil, 0, 0);

где Volume формируется по правилам [4]


 
andrey12   (2005-05-18 17:23) [6]

Ничего не работает ктонибудь напишите пожалуйста с описанием!!!!!!!!


 
andrey12   (2005-05-19 14:12) [7]

ну если уж через MCI TMediaPlayer, то можно и попроще:

mciSendstring(PAnsiChar("setaudio "" + MediaPlayer1.FileName +
"" volume to " + IntToStr(Volume)), nil, 0, 0);

---куда это лепить????????


 
r13   (2005-05-27 10:03) [8]

найди компонент TAudioMixer v1.4 и не парься


 
MrAndrey_ka   (2005-05-31 11:37) [9]

Попробуй так:

Изменение громкости звуков в Windows
uses MMSystem;

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;

procedure TForm1.Button1Click(Sender: TObject);
begin
 Beep;
end;

procedure TForm1.Button2Click(Sender: TObject);
var LeftVolume: Word;
   RightVolume: Word;
begin
 LeftVolume := StrToInt(Edit1.Text);
 RightVolume := StrToInt(Edit2.Text);
 SetWaveVolume(MakeLong(LeftVolume, RightVolume));
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
 Caption := IntToStr(GetWaveVolume);
end;


 
Alexander Panov ©   (2005-05-31 12:21) [10]

Вообще, помогут и без панических криков в топике...



Страницы: 1 вся ветка

Текущий архив: 2005.10.23;
Скачать: CL | DM;

Наверх




Память: 0.5 MB
Время: 0.038 c
1-1127991488
r9000
2005-09-29 14:58
2005.10.23
Перевод части текста программы на fox в Delphi.


11-1108678731
FreeOne
2005-02-18 01:18
2005.10.23
BHO (aka Browser Helper Objects)


2-1127468702
Киря
2005-09-23 13:45
2005.10.23
Как правильно сдеать запрос?


14-1128118890
Chuvak
2005-10-01 02:21
2005.10.23
spool.exe в папке Windows


2-1127587861
Zico
2005-09-24 22:51
2005.10.23
Базы данных в delphi