Экспертная система Delphi.int.ru

Сообщество программистов
Общение, помощь, обмен опытом
Логин:
Пароль:
Регистрация | Забыли пароль?

Delphi.int.ru Expert

Другие разделы портала

Переход к вопросу:

#   

Статистика за сегодня:  


Лучшие эксперты

Подробнее »

Вопрос # 1 145

Раздел: Delphi » Мультимедийные приложения
/ вопрос открыт /

Приветствую, уважаемые эксперты! Есть ли в Delphi функция управления громкостью динамиков?

Leonardo Вопрос ожидает решения (принимаются ответы, доступен мини-форум)

Вопрос задал: Leonardo (статус: Посетитель)
Вопрос отправлен: 27 ноября 2007, 20:58
Состояние вопроса: открыт, ответов: 2.

Ответ #1. Отвечает эксперт: min@y™

Почитай хэлп по функции из модуля mmsystem.pas:

function auxSetVolume; external mmsyst name 'auxSetVolume';

В Delphi World есть несколько примеров её использования. Вот один из них:

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;

Ответ отправил: min@y™ (статус: Доктор наук)
Время отправки: 28 ноября 2007, 08:28

Ответ #2. Отвечает эксперт: Feniks

Здравствуйте, Leonardo!
Дополнение к min@y™.
В Приложении еще пару способов и целый компонент... ;-)

Приложение:
  1. function GetVolume: Word;
  2. var
  3. iErr : Integer;
  4. i: integer;
  5. a: TAuxCaps;
  6. vol: word;
  7. begin
  8. for i := 0 to auxGetNumDevs do begin
  9. auxGetDevCaps(i,Addr(a),SizeOf(a));
  10. If a.wTechnology = AUXCAPS_CDAUDIO Then break;
  11. end;
  12. iErr:=auxGetVolume(i,addr(vol));
  13. GetVolume := vol;
  14.  
  15. end;
  16.  
  17.  
  18. procedure GetVolume(var volL, volR: Word);
  19. var
  20. hWO: HWAVEOUT;
  21. waveF: TWAVEFORMATEX;
  22. vol: DWORD;
  23. begin
  24. volL := 0;
  25. volR := 0;
  26. // init TWAVEFORMATEX
  27. FillChar(waveF, SizeOf(waveF), 0);
  28. // open WaveMapper = std output of playsound
  29. waveOutOpen(@hWO, WAVE_MAPPER, @waveF, 0, 0, 0);
  30. // get volume
  31. waveOutGetVolume(hWO, @vol);
  32. volL := vol and $FFFF;
  33. volR := vol shr 16;
  34. waveOutClose(hWO);
  35. end;
  36.  
  37. procedure SetVolume(const volL, volR: Word);
  38. var
  39. hWO: HWAVEOUT;
  40. waveF: TWAVEFORMATEX;
  41. vol: DWORD;
  42. begin
  43. // init TWAVEFORMATEX
  44. FillChar(waveF, SizeOf(waveF), 0);
  45. // open WaveMapper = std output of playsound
  46. waveOutOpen(@hWO, WAVE_MAPPER, @waveF, 0, 0, 0);
  47. vol := volL + volR shl 16;
  48. // set volume
  49. waveOutSetVolume(hWO, vol);
  50. waveOutClose(hWO);
  51. end;
  52.  
  53.  
  54. uses mmsystem;
  55.  
  56. function GetWaveVolume: DWord;
  57. var
  58. Woc : TWAVEOUTCAPS;
  59. Volume : DWord;
  60. begin
  61. result:=0;
  62. if WaveOutGetDevCaps(WAVE_MAPPER, @Woc, sizeof(Woc)) = MMSYSERR_NOERROR then
  63. if Woc.dwSupport and WAVECAPS_VOLUME = WAVECAPS_VOLUME then
  64. begin
  65. WaveOutGetVolume(WAVE_MAPPER, @Volume);
  66. Result := Volume;
  67. end;
  68. end;
  69.  
  70. procedure SetWaveVolume(const AVolume: DWord);
  71. var Woc : TWAVEOUTCAPS;
  72. begin
  73. if WaveOutGetDevCaps(WAVE_MAPPER, @Woc, sizeof(Woc)) = MMSYSERR_NOERROR then
  74. if Woc.dwSupport and WAVECAPS_VOLUME = WAVECAPS_VOLUME then WaveOutSetVolume(WAVE_MAPPER, AVolume);
  75. end;
  76.  
  77. procedure TForm1.Button1Click(Sender: TObject);
  78. begin
  79. Beep;
  80. end;
  81.  
  82. procedure TForm1.Button2Click(Sender: TObject);
  83. var
  84. LeftVolume: Word;
  85. RightVolume: Word;
  86. begin
  87. LeftVolume := StrToInt(Edit1.Text);
  88. RightVolume := StrToInt(Edit2.Text);
  89. SetWaveVolume(MakeLong(LeftVolume, RightVolume));
  90. end;
  91.  
  92. procedure TForm1.Button3Click(Sender: TObject);
  93. begin
  94. Caption := IntToStr(GetWaveVolume);
  95. end;
  96.  
  97.  
  98. unit Volumes;
  99.  
  100. interface
  101.  
  102. uses
  103. Windows, Messages, Classes, ExtCtrls, ComCtrls, MMSystem;
  104.  
  105. const
  106. CDVolume = 0;
  107. WaveVolume = 1;
  108. MidiVolume = 2;
  109.  
  110. type
  111. TVolumeControl = class(TComponent)
  112. private
  113. FDevices : array[0..2] of Integer;
  114. FTrackBars : array[0..2] of TTrackBar;
  115. FTimer : TTimer;
  116. function GetInterval: Integer;
  117. procedure SetInterval(AInterval: Integer);
  118. function GetVolume(AIndex: Integer): Byte;
  119. procedure SetVolume(AIndex: Integer; aVolume: Byte);
  120. procedure InitVolume;
  121. procedure SetTrackBar(AIndex: Integer; ATrackBar: TTrackBar);
  122. { Private declarations }
  123. procedure Update(Sender: TObject);
  124. procedure Changed(Sender: TObject);
  125. protected
  126. { Protected declarations }
  127. procedure Notification(AComponent: TComponent; AOperation:
  128. TOperation); override;
  129. public
  130. { Public declarations }
  131. constructor Create(AOwner: TComponent); override;
  132. destructor Destroy; override;
  133. published
  134. { Published declarations }
  135. property Interval: Integer read GetInterval write SetInterval default
  136. 500;
  137. property CDVolume: Byte index 0 read GetVolume write SetVolume stored
  138. False;
  139. property CDTrackBar: TTrackBar index 0 read FTrackBars[0] write
  140. SetTrackBar;
  141. property WaveVolume: Byte index 1 read GetVolume write SetVolume
  142. stored False;
  143. property WaveTrackBar: TTrackBar index 1 read FTrackBars[1] write
  144. SetTrackBar;
  145. property MidiVolume: Byte index 2 read GetVolume write SetVolume
  146. stored False;
  147. property MidiTrackBar: TTrackBar index 2 read FTrackBars[2] write
  148. SetTrackBar;
  149. end;
  150.  
  151. procedure Register;
  152.  
  153. implementation
  154.  
  155. procedure Register;
  156. begin
  157. RegisterComponents('Any', [TVolumeControl]);
  158. end;
  159.  
  160. type
  161. TVolumeRec = record
  162. case Integer of
  163. 0: (LongVolume: Longint);
  164. 1: (LeftVolume,
  165. RightVolume : Word);
  166. end;
  167.  
  168. function TVolumeControl.GetInterval: Integer;
  169. begin
  170. Result := FTimer.Interval;
  171. end;
  172.  
  173. procedure TVolumeControl.SetInterval(AInterval: Integer);
  174. begin
  175. FTimer.Interval := AInterval;
  176. end;
  177.  
  178. function TVolumeControl.GetVolume(AIndex: Integer): Byte;
  179. var Vol: TVolumeRec;
  180. begin
  181. Vol.LongVolume := 0;
  182. if FDevices[AIndex] < > -1 then
  183. case AIndex of
  184. 0: auxGetVolume(FDevices[AIndex], @Vol.LongVolume);
  185. 1: waveOutGetVolume(FDevices[AIndex], @Vol.LongVolume);
  186. 2: midiOutGetVolume(FDevices[AIndex], @Vol.LongVolume);
  187. end;
  188. Result := (Vol.LeftVolume + Vol.RightVolume) shr 9;
  189. end;
  190.  
  191. procedure TVolumeControl.SetVolume(aIndex: Integer; aVolume: Byte);
  192. var Vol: TVolumeRec;
  193. begin
  194. if FDevices[AIndex] < > -1 then
  195. begin
  196. Vol.LeftVolume := aVolume shl 8;
  197. Vol.RightVolume := Vol.LeftVolume;
  198. case AIndex of
  199. 0: auxSetVolume(FDevices[AIndex], Vol.LongVolume);
  200. 1: waveOutSetVolume(FDevices[AIndex], Vol.LongVolume);
  201. 2: midiOutSetVolume(FDevices[AIndex], Vol.LongVolume);
  202. end;
  203. end;
  204. end;
  205.  
  206. procedure TVolumeControl.SetTrackBar(AIndex: Integer; ATrackBar:
  207. TTrackBar);
  208. begin
  209. if ATrackBar < > FTrackBars[AIndex] then
  210. begin
  211. FTrackBars[AIndex] := ATrackBar;
  212. Update(Self);
  213. end;
  214. end;
  215.  
  216. AOperation: TOperation);
  217. var I: Integer;
  218. begin
  219. inherited Notification(AComponent, AOperation);
  220. if (AOperation = opRemove) then
  221. for I := 0 to 2 do if (AComponent = FTrackBars[I])
  222. then FTrackBars[I] := Nil;
  223. end;
  224.  
  225. procedure TVolumeControl.Update(Sender: TObject);
  226. var I: Integer;
  227. begin
  228. for I := 0 to 2 do
  229. if Assigned(FTrackBars[I]) then
  230. with FTrackBars[I] do
  231. begin
  232. Min := 0;
  233. Max := 255;
  234. if Orientation = trVertical
  235. then Position := 255 - GetVolume(I)
  236. else Position := GetVolume(I);
  237. OnChange := Self.Changed;
  238. end;
  239. end;
  240.  
  241. constructor TVolumeControl.Create(AOwner: TComponent);
  242. begin
  243. inherited Create(AOwner);
  244. FTimer := TTimer.Create(Self);
  245. FTimer.OnTimer := Update;
  246. FTimer.Interval := 500;
  247. InitVolume;
  248. end;
  249.  
  250. destructor TVolumeControl.Destroy;
  251. var I: Integer;
  252. begin
  253. FTimer.Free;
  254. for I := 0 to 2 do
  255. if Assigned(FTrackBars[I]) then
  256. FTrackBars[I].OnChange := Nil;
  257. inherited Destroy;
  258. end;
  259.  
  260. procedure TVolumeControl.Changed(Sender: TObject);
  261. var I: Integer;
  262. begin
  263. for I := 0 to 2 do
  264. if Sender = FTrackBars[I] then
  265. with FTrackBars[I] do
  266. begin
  267. if Orientation = trVertical
  268. then SetVolume(I, 255 - Position)
  269. else SetVolume(I, Position);
  270. end;
  271. end;
  272.  
  273. procedure TVolumeControl.InitVolume;
  274. var AuxCaps : TAuxCaps;
  275. WaveOutCaps : TWaveOutCaps;
  276. MidiOutCaps : TMidiOutCaps;
  277. I,J : Integer;
  278. begin
  279. FDevices[0] := -1;
  280. for I := 0 to auxGetNumDevs - 1 do
  281. begin
  282. auxGetDevCaps(I, @AuxCaps, SizeOf(AuxCaps));
  283. if (AuxCaps.dwSupport and AUXCAPS_VOLUME) < > 0 then
  284. begin
  285. FTimer.Enabled := True;
  286. FDevices[0] := I;
  287. break;
  288. end;
  289. end;
  290. FDevices[1] := -1;
  291. for I := 0 to waveOutGetNumDevs - 1 do
  292. begin
  293. waveOutGetDevCaps(I, @WaveOutCaps, SizeOf(WaveOutCaps));
  294. if (WaveOutCaps.dwSupport and WAVECAPS_VOLUME) < > 0 then
  295. begin
  296. FTimer.Enabled := True;
  297. FDevices[1] := I;
  298. break;
  299. end;
  300. end;
  301. FDevices[2] := -1;
  302. for I := 0 to midiOutGetNumDevs - 1 do
  303. begin
  304. MidiOutGetDevCaps(I, @MidiOutCaps, SizeOf(MidiOutCaps));
  305. if (MidiOutCaps.dwSupport and MIDICAPS_VOLUME) < > 0 then
  306. begin
  307. FTimer.Enabled := True;
  308. FDevices[2] := I;
  309. break;
  310. end;
  311. end;
  312. end;
  313.  
  314. end.


Ответ отправил: Feniks (статус: Бакалавр)
Время отправки: 28 ноября 2007, 10:09
Оценка за ответ: 5


Мини-форум вопроса

Мини-форум пуст.

Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.
Версия движка: 2.6+ (26.01.2011)
© 2005-2025
Текущее время: 22 февраля 2025, 11:58
Выполнено за 0.03 сек.