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

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

Delphi.int.ru Expert

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

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

#   

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


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

Подробнее »

Вопрос # 1 461

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

Здравствуйте! У меня такой вопрос:
Я хочу написать аналог виндосовского регулятора громкости но без всяких настроек звучания и тд,то есть просто шкалу с громкостью колонок,и галочку для вкл/выкл микрофона.
Просто стандартный слишком долго открывается и сидит в трее.

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

Вопрос задал: Дмитрий С. - 1148 (статус: Посетитель)
Вопрос отправлен: 31 марта 2008, 11:44
Состояние вопроса: открыт, ответов: 2.

Ответ #1. Отвечает эксперт: ANBsoft

Здравствуйте, Дмитрий С. - 1148!
Существует замечательный сборник ответов на многие вопросы по делфи под названием Kuliba.
Найти его в интернете не составит труда.
Просто копирую отрывок оттуда (см. приложение).

Приложение:
  1.  
  2.  
  3.  
  4.  
  5.  
  6. INT GetMasterVolumeControlID()
  7. {
  8. // get dwLineID
  9. MIXERLINE mxl;
  10. mxl.cbStruct = sizeof(MIXERLINE);
  11. mxl.dwComponentType = MIXERLINE_COMPONENTTYPE_DST_SPEAKERS;
  12. if (::mixerGetLineInfo((HMIXEROBJ)ghmx, &mxl,
  13. MIXER_OBJECTF_HMIXER | MIXER_GETLINEINFOF_COMPONENTTYPE)
  14. != MMSYSERR_NOERROR)
  15. return 34;
  16. // get dwControlID
  17. MIXERCONTROL mxc;
  18. MIXERLINECONTROLS mxlc;
  19. mxlc.cbStruct = sizeof(MIXERLINECONTROLS);
  20. mxlc.dwLineID = mxl.dwLineID;
  21. mxlc.dwControlType = MIXERCONTROL_CONTROLTYPE_VOLUME;
  22. mxlc.cControls = 1;
  23. mxlc.cbmxctrl = sizeof(MIXERCONTROL);
  24. mxlc.pamxctrl = &mxc;
  25. if (::mixerGetLineControls((HMIXEROBJ)ghmx, &mxlc,
  26. MIXER_OBJECTF_HMIXER | MIXER_GETLINECONTROLSF_ONEBYTYPE)
  27. != MMSYSERR_NOERROR)
  28. return 34;
  29. return mxc.dwControlID;
  30. }
  31.  
  32. BOOL SetMasterVolume(DWORD dwVolume)
  33. {
  34. MIXERCONTROLDETAILS mxcd;
  35. MIXERCONTROLDETAILS_UNSIGNED mxcd_u;
  36. mxcd.cbStruct = sizeof(mxcd);
  37. mxcd.dwControlID = MasterVolumeControlID;
  38. mxcd.cChannels = 1;
  39. mxcd.cMultipleItems = 0;
  40. mxcd.cbDetails = 4;
  41. mxcd.paDetails = &mxcd_u;
  42. mmr = mixerGetControlDetails((HMIXEROBJ)ghmx, &mxcd, 0L);
  43. if (MMSYSERR_NOERROR != mmr) return FALSE;
  44. mxcd_u.dwValue = dwVolume;
  45. mmr = mixerSetControlDetails((HMIXEROBJ)ghmx, &mxcd, 0L);
  46. if (MMSYSERR_NOERROR != mmr) return FALSE;
  47. return TRUE;
  48. }
  49.  
  50.  


Ответ отправил: ANBsoft (статус: Студент)
Время отправки: 1 апреля 2008, 02:09
Оценка за ответ: 4

Комментарий к оценке: Так это по Си этот сборник?
А по делфи подобный не посоветуете?

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

Здравствуйте, Дмитрий С. - 1148!
Держите в Приложении несколько примеров по вкл/выкл громкости устройст и регулированию громкости.
Желаю удачи.

Приложение:
  1.  
  2. {********************************************************}
  3. // Enable/disable "Mute" for several mixer line sources.
  4. uses
  5. MMSystem;
  6.  
  7. type
  8. TMixerLineSourceType = (lsDigital, lsLine, lsMicrophone, lsCompactDisk, lsTelephone,
  9. lsWaveOut, lsAuxiliary, lsAnalog, lsLast);
  10.  
  11. function SetMixerLineSourceMute(AMixerLineSourceType: TMixerLineSourceType; bMute: Boolean): Boolean;
  12. var
  13. hMix: HMIXER;
  14. mxlc: MIXERLINECONTROLS;
  15. mxcd: TMIXERCONTROLDETAILS;
  16. vol: TMIXERCONTROLDETAILS_UNSIGNED;
  17. mxc: MIXERCONTROL;
  18. mxl: TMixerLine;
  19. intRet: Integer;
  20. nMixerDevs: Integer;
  21. mcdMute: MIXERCONTROLDETAILS_BOOLEAN;
  22. begin
  23. Result := False;
  24. // Check if Mixer is available
  25. nMixerDevs := mixerGetNumDevs();
  26. if (nMixerDevs < 1) then
  27. begin
  28. Exit;
  29. end;
  30.  
  31. // open the mixer
  32. intRet := mixerOpen(@hMix, 0, 0, 0, 0);
  33. if intRet = MMSYSERR_NOERROR then
  34. begin
  35. ZeroMemory(@mxl, SizeOf(mxl));
  36. case AMixerLineSourceType of
  37. lsDigital: mxl.dwComponentType :=MIXERLINE_COMPONENTTYPE_SRC_DIGITAL;
  38. lsLine: mxl.dwComponentType := MIXERLINE_COMPONENTTYPE_SRC_LINE;
  39. lsMicrophone: mxl.dwComponentType :=MIXERLINE_COMPONENTTYPE_SRC_MICROPHONE;
  40. lsCompactDisk: mxl.dwComponentType :=MIXERLINE_COMPONENTTYPE_SRC_COMPACTDISC;
  41. lsTelephone: mxl.dwComponentType :=MIXERLINE_COMPONENTTYPE_SRC_TELEPHONE;
  42. lsWaveOut: mxl.dwComponentType :=MIXERLINE_COMPONENTTYPE_SRC_WAVEOUT;
  43. lsAuxiliary: mxl.dwComponentType :=MIXERLINE_COMPONENTTYPE_SRC_AUXILIARY;
  44. lsAnalog : mxl.dwComponentType :=MIXERLINE_COMPONENTTYPE_SRC_ANALOG;
  45. lsLast: mxl.dwComponentType :=MIXERLINE_COMPONENTTYPE_SRC_LAST;
  46. end;
  47.  
  48. // mixerline info
  49. mxl.cbStruct := SizeOf(mxl);
  50. intRet := mixerGetLineInfo(hMix, @mxl, MIXER_GETLINEINFOF_COMPONENTTYPE);
  51.  
  52. if intRet = MMSYSERR_NOERROR then
  53. begin
  54. ZeroMemory(@mxlc, SizeOf(mxlc));
  55. mxlc.cbStruct := SizeOf(mxlc);
  56. mxlc.dwLineID := mxl.dwLineID;
  57. mxlc.dwControlType := MIXERCONTROL_CONTROLTYPE_MUTE;
  58. mxlc.cControls := 1;
  59. mxlc.cbmxctrl := SizeOf(mxc);
  60. mxlc.pamxctrl := @mxc;
  61.  
  62. // Get the mute control
  63. intRet := mixerGetLineControls(hMix, @mxlc, MIXER_GETLINECONTROLSF_ONEBYTYPE);
  64.  
  65. if intRet = MMSYSERR_NOERROR then
  66. begin
  67. ZeroMemory(@mxcd, SizeOf(mxcd));
  68. mxcd.cbStruct := SizeOf(TMIXERCONTROLDETAILS);
  69. mxcd.dwControlID := mxc.dwControlID;
  70. mxcd.cChannels := 1;
  71. mxcd.cbDetails := SizeOf(MIXERCONTROLDETAILS_BOOLEAN);
  72. mxcd.paDetails := @mcdMute;
  73.  
  74. mcdMute.fValue := Ord(bMute);
  75.  
  76. // set, unset mute
  77. intRet := mixerSetControlDetails(hMix, @mxcd, MIXER_SETCONTROLDETAILSF_VALUE);
  78. {
  79. mixerGetControlDetails(hMix, @mxcd, IXER_GETCONTROLDETAILSF_VALUE);
  80. Result := Boolean(mcdMute.fValue);
  81. }
  82. Result := intRet = MMSYSERR_NOERROR;
  83.  
  84. if intRet <> MMSYSERR_NOERROR then
  85. ShowMessage('SetControlDetails Error');
  86. end
  87. else
  88. ShowMessage('GetLineInfo Error');
  89. end;
  90. intRet := mixerClose(hMix);
  91. end;
  92. end;
  93.  
  94. // Example Call;
  95.  
  96. procedure TForm1.Button1Click(Sender: TObject);
  97. begin
  98. SetMixerLineSourceMute(lsLine, True);
  99. end;
  100.  
  101.  
  102.  
  103.  
  104. procedure SetVolume(X: Word);
  105. var
  106. iErr: Integer;
  107. i: integer;
  108. a: TAuxCaps;
  109. begin
  110. for i := 0 to auxGetNumDevs do
  111. begin
  112. auxGetDevCaps(i, Addr(a), SizeOf(a));
  113. if a.wTechnology = AUXCAPS_CDAUDIO then
  114. break;
  115. end;
  116.  
  117.  
  118. // VOLUME := LEFT*$10000 + RIGHT*1
  119.  
  120. iErr := auxSetVolume(i, (X * $10001));
  121.  
  122. ShowMessage('No audio devices are available!');
  123. end;
  124.  
  125. function GetVolume: Word;
  126. var
  127. iErr: Integer;
  128. i: integer;
  129. a: TAuxCaps;
  130. vol: word;
  131. begin
  132. for i := 0 to auxGetNumDevs do
  133. begin
  134. auxGetDevCaps(i, Addr(a), SizeOf(a));
  135. if a.wTechnology = AUXCAPS_CDAUDIO then
  136. break;
  137. end;
  138. iErr := auxGetVolume(i, addr(vol));
  139. GetVolume := vol;
  140.  
  141. ShowMessage('No audio devices are available!');
  142. end;
  143.  
  144.  
  145. unit Volumes;
  146.  
  147. interface
  148.  
  149. uses
  150. Windows, Messages, Classes, ExtCtrls, ComCtrls, MMSystem;
  151.  
  152. const
  153. CDVolume = 0;
  154. WaveVolume = 1;
  155. MidiVolume = 2;
  156.  
  157. type
  158. TVolumeControl = class(TComponent)
  159. private
  160. FDevices : array[0..2] of Integer;
  161. FTrackBars : array[0..2] of TTrackBar;
  162. FTimer : TTimer;
  163. function GetInterval: Integer;
  164. procedure SetInterval(AInterval: Integer);
  165. function GetVolume(AIndex: Integer): Byte;
  166. procedure SetVolume(AIndex: Integer; aVolume: Byte);
  167. procedure InitVolume;
  168. procedure SetTrackBar(AIndex: Integer; ATrackBar: TTrackBar);
  169. { Private declarations }
  170. procedure Update(Sender: TObject);
  171. procedure Changed(Sender: TObject);
  172. protected
  173. { Protected declarations }
  174. procedure Notification(AComponent: TComponent; AOperation:
  175. TOperation); override;
  176. public
  177. { Public declarations }
  178. constructor Create(AOwner: TComponent); override;
  179. destructor Destroy; override;
  180. published
  181. { Published declarations }
  182. property Interval: Integer read GetInterval write SetInterval default
  183. 500;
  184. property CDVolume: Byte index 0 read GetVolume write SetVolume stored
  185. False;
  186. property CDTrackBar: TTrackBar index 0 read FTrackBars[0] write
  187. SetTrackBar;
  188. property WaveVolume: Byte index 1 read GetVolume write SetVolume
  189. stored False;
  190. property WaveTrackBar: TTrackBar index 1 read FTrackBars[1] write
  191. SetTrackBar;
  192. property MidiVolume: Byte index 2 read GetVolume write SetVolume
  193. stored False;
  194. property MidiTrackBar: TTrackBar index 2 read FTrackBars[2] write
  195. SetTrackBar;
  196. end;
  197.  
  198. procedure Register;
  199.  
  200. implementation
  201.  
  202. procedure Register;
  203. begin
  204. RegisterComponents('Any', [TVolumeControl]);
  205. end;
  206.  
  207. type
  208. TVolumeRec = record
  209. case Integer of
  210. 0: (LongVolume: Longint);
  211. 1: (LeftVolume,
  212. RightVolume : Word);
  213. end;
  214.  
  215. function TVolumeControl.GetInterval: Integer;
  216. begin
  217. Result := FTimer.Interval;
  218. end;
  219.  
  220. procedure TVolumeControl.SetInterval(AInterval: Integer);
  221. begin
  222. FTimer.Interval := AInterval;
  223. end;
  224.  
  225. function TVolumeControl.GetVolume(AIndex: Integer): Byte;
  226. var Vol: TVolumeRec;
  227. begin
  228. Vol.LongVolume := 0;
  229. if FDevices[AIndex] < > -1 then
  230. case AIndex of
  231. 0: auxGetVolume(FDevices[AIndex], @Vol.LongVolume);
  232. 1: waveOutGetVolume(FDevices[AIndex], @Vol.LongVolume);
  233. 2: midiOutGetVolume(FDevices[AIndex], @Vol.LongVolume);
  234. end;
  235. Result := (Vol.LeftVolume + Vol.RightVolume) shr 9;
  236. end;
  237.  
  238. procedure TVolumeControl.SetVolume(aIndex: Integer; aVolume: Byte);
  239. var Vol: TVolumeRec;
  240. begin
  241. if FDevices[AIndex] < > -1 then
  242. begin
  243. Vol.LeftVolume := aVolume shl 8;
  244. Vol.RightVolume := Vol.LeftVolume;
  245. case AIndex of
  246. 0: auxSetVolume(FDevices[AIndex], Vol.LongVolume);
  247. 1: waveOutSetVolume(FDevices[AIndex], Vol.LongVolume);
  248. 2: midiOutSetVolume(FDevices[AIndex], Vol.LongVolume);
  249. end;
  250. end;
  251. end;
  252.  
  253. procedure TVolumeControl.SetTrackBar(AIndex: Integer; ATrackBar:
  254. TTrackBar);
  255. begin
  256. if ATrackBar < > FTrackBars[AIndex] then
  257. begin
  258. FTrackBars[AIndex] := ATrackBar;
  259. Update(Self);
  260. end;
  261. end;
  262.  
  263. AOperation: TOperation);
  264. var I: Integer;
  265. begin
  266. inherited Notification(AComponent, AOperation);
  267. if (AOperation = opRemove) then
  268. for I := 0 to 2 do if (AComponent = FTrackBars[I])
  269. then FTrackBars[I] := Nil;
  270. end;
  271.  
  272. procedure TVolumeControl.Update(Sender: TObject);
  273. var I: Integer;
  274. begin
  275. for I := 0 to 2 do
  276. if Assigned(FTrackBars[I]) then
  277. with FTrackBars[I] do
  278. begin
  279. Min := 0;
  280. Max := 255;
  281. if Orientation = trVertical
  282. then Position := 255 - GetVolume(I)
  283. else Position := GetVolume(I);
  284. OnChange := Self.Changed;
  285. end;
  286. end;
  287.  
  288. constructor TVolumeControl.Create(AOwner: TComponent);
  289. begin
  290. inherited Create(AOwner);
  291. FTimer := TTimer.Create(Self);
  292. FTimer.OnTimer := Update;
  293. FTimer.Interval := 500;
  294. InitVolume;
  295. end;
  296.  
  297. destructor TVolumeControl.Destroy;
  298. var I: Integer;
  299. begin
  300. FTimer.Free;
  301. for I := 0 to 2 do
  302. if Assigned(FTrackBars[I]) then
  303. FTrackBars[I].OnChange := Nil;
  304. inherited Destroy;
  305. end;
  306.  
  307. procedure TVolumeControl.Changed(Sender: TObject);
  308. var I: Integer;
  309. begin
  310. for I := 0 to 2 do
  311. if Sender = FTrackBars[I] then
  312. with FTrackBars[I] do
  313. begin
  314. if Orientation = trVertical
  315. then SetVolume(I, 255 - Position)
  316. else SetVolume(I, Position);
  317. end;
  318. end;
  319.  
  320. procedure TVolumeControl.InitVolume;
  321. var AuxCaps : TAuxCaps;
  322. WaveOutCaps : TWaveOutCaps;
  323. MidiOutCaps : TMidiOutCaps;
  324. I,J : Integer;
  325. begin
  326. FDevices[0] := -1;
  327. for I := 0 to auxGetNumDevs - 1 do
  328. begin
  329. auxGetDevCaps(I, @AuxCaps, SizeOf(AuxCaps));
  330. if (AuxCaps.dwSupport and AUXCAPS_VOLUME) < > 0 then
  331. begin
  332. FTimer.Enabled := True;
  333. FDevices[0] := I;
  334. break;
  335. end;
  336. end;
  337. FDevices[1] := -1;
  338. for I := 0 to waveOutGetNumDevs - 1 do
  339. begin
  340. waveOutGetDevCaps(I, @WaveOutCaps, SizeOf(WaveOutCaps));
  341. if (WaveOutCaps.dwSupport and WAVECAPS_VOLUME) < > 0 then
  342. begin
  343. FTimer.Enabled := True;
  344. FDevices[1] := I;
  345. break;
  346. end;
  347. end;
  348. FDevices[2] := -1;
  349. for I := 0 to midiOutGetNumDevs - 1 do
  350. begin
  351. MidiOutGetDevCaps(I, @MidiOutCaps, SizeOf(MidiOutCaps));
  352. if (MidiOutCaps.dwSupport and MIDICAPS_VOLUME) < > 0 then
  353. begin
  354. FTimer.Enabled := True;
  355. FDevices[2] := I;
  356. break;
  357. end;
  358. end;
  359. end;
  360.  
  361. end.
  362.  
  363.  
  364.  
  365. procedure TForm1.TrackBar1Change(Sender: TObject);
  366. var
  367. s: dword;
  368. a,b: word;
  369. h: hWnd;
  370. begin
  371. a:=trackbar1.position;
  372. b:=trackbar2.position;
  373. s:=(a shl 16) or b;
  374. waveOutSetVolume(h,s);
  375. end;


Ответ отправил: Feniks (статус: Бакалавр)
Время отправки: 2 апреля 2008, 17:03


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

Всего сообщений: 4; последнее сообщение — 22 апреля 2008, 20:33; участников в обсуждении: 2.
Вадим К

Вадим К (статус: Академик), 1 апреля 2008, 00:10 [#1]:

Слишком долго запускается? У вас что, процессор 166? Или машина в плачебном состоянии - мне случались такие ситуации, когда достаточно мощная машина работала еле-еле. И вся проблема была в огромном количестве вирусов.
Помните, что наличие антивируса и свежих баз для него абсолютно не означает, что у вас нет вирусов. Скорее всего нет вирусов, которые знает антивирус.
А если просто не нравиться то, что он есть в трее - так это легко отключается.

Я не думаю, что ваша программа будет быстрее запускаться, чем стандартная.

P.S. Кстати, не Vista ли у вас?
Галочка "подтверждения прочтения" - вселенское зло.
Дмитрий С. - 1148

Дмитрий С. - 1148 (статус: Посетитель), 1 апреля 2008, 17:11 [#2]:

Нет,не виста.А процессор 730
Просто я купил наушники без регулятора громкости и играю в игры,когда игру сворачиваешь,регулятор открывается слишком долго.
А чтобы микрофон вкл/выкл нужно еще весь регулятор открыть,галочки там ставить,бесит вобщем.
Я надеюсь,что моя прога будет открываться немного быстрее :)
а может я ее и закрывать не буду,пока играю

А что,сложный код?
Вадим К

Вадим К (статус: Академик), 2 апреля 2008, 01:50 [#3]:

Тормозит не регулятор, а игра. Не думаю, что ваша софтина тут поможет.
Есть юнит, который поможет регулировать громкость. Сюда не вылаживаю - многовато будет. Надо - стучитесь в асю.
Галочка "подтверждения прочтения" - вселенское зло.
Дмитрий С. - 1148

Дмитрий С. - 1148 (статус: Посетитель), 22 апреля 2008, 20:33 [#4]:

Большое спасибо,думаю теперь я что-нибудь сделаю.

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