Форум программистов
 
Регистрация на форуме тут, о проблемах пишите сюда - alarforum@yandex.ru, проверяйте папку спам! Обязательно пройдите активизацию e-mail, а тут можно восстановить пароль.

Как купить рекламу на форуме


Вернуться   Форум программистов > Низкоуровневое программирование > Win Api
Регистрация

Восстановить пароль
Повторная активизация e-mail


Ответ
 
Опции темы Поиск в этой теме
Старый 14.08.2020, 01:16   #1
stlcrash
Форумчанин
 
Регистрация: 04.07.2010
Сообщений: 131
По умолчанию Отследить Появление звука в колонках

Как узнать появления звука в колонках? Пока нашел только winApi функция, как изменить текущую громкость главного канала, но это не совсем то.

[SPOILER]
Код:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls,
  ActiveX, MMDevApi;

type
  TTrackBar = class(ComCtrls.TTrackBar);

  TForm1 = class(TForm)
    TrackBar1: TTrackBar;
    procedure FormCreate(Sender: TObject);
    procedure TrackBar1Change(Sender: TObject);
    procedure TrackBarMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  EndPointVolume: IAudioEndpointVolume = nil;
  VolumeLevel: Single;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
  DeviceEnumerator: IMMDeviceEnumerator;
  DefaultDevice: IMMDevice;
begin
  CoCreateInstance(CLASS_IMMDeviceEnumerator, nil, CLSCTX_INPROC_SERVER, IID_IMMDeviceEnumerator, DeviceEnumerator);
  DeviceEnumerator.GetDefaultAudioEndpoint(eRender, eConsole, DefaultDevice);
  DefaultDevice.Activate(IID_IAudioEndpointVolume, CLSCTX_INPROC_SERVER, nil, EndPointVolume);

  if EndPointVolume = nil then Halt;

  EndPointVolume.GetMasterVolumeLevelScaler(VolumeLevel);
  TrackBar1.Position := Round(VolumeLevel * 100);
  Caption := Format('Volume = %d', [TrackBar1.Position]);

  TrackBar1.OnMouseUp := TrackBarMouseUp;
end;

procedure TForm1.TrackBar1Change(Sender: TObject);
begin
  EndPointVolume.SetMasterVolumeLevelScalar(TrackBar1.Position / 100, nil);
  Caption := Format('Volume = %d', [TrackBar1.Position]);
end;

procedure TForm1.TrackBarMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then Beep;
end;

end.
[/SPOILER]
Изображения
Тип файла: jpg Безымянный.jpg (22.2 Кб, 39 просмотров)

Последний раз редактировалось stlcrash; 14.08.2020 в 01:22.
stlcrash вне форума Ответить с цитированием
Старый 14.08.2020, 12:06   #2
waleri
Старожил
 
Регистрация: 13.07.2012
Сообщений: 6,326
По умолчанию

Вам надо:
IAudioSessionEvents
IAudioSessionControl
IAudioSessionNotification
waleri вне форума Ответить с цитированием
Старый 14.08.2020, 20:58   #4
stlcrash
Форумчанин
 
Регистрация: 04.07.2010
Сообщений: 131
По умолчанию

Код:
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs,Winapi.ActiveX, System.Win.ComObj, MMSystem,
  Vcl.ComCtrls, Vcl.ExtCtrls;

  type
  EDATAFLOW = TOleEnum;
  EROLE = TOleEnum;

  IMMDevice = interface(IUnknown)
    ['{D666063F-1587-4E43-81F1-B948E807363F}']
    function Activate(const iid: TGUID; const dwClsCtx: UINT; const pActivationParams: PPropVariant; out ppInterface: IUnknown)
      : HRESULT; stdcall;
  end;

  IMMDeviceCollection = interface(IUnknown)
    ['{0BD7A1BE-7A1A-44DB-8397-CC5392387B5E}']
  end;

  IMMDeviceEnumerator = interface(IUnknown)
    ['{A95664D2-9614-4F35-A746-DE8DB63617E6}']
    function EnumAudioEndpoints(const dataFlow: EDATAFLOW; const dwStateMask: DWORD; out ppDevices: IMMDeviceCollection): HRESULT; stdcall;
    function GetDefaultAudioEndpoint(const dataFlow: EDATAFLOW; const role: EROLE; out ppEndpoint: IMMDevice): HRESULT; stdcall;
  end;

  IAudioMeterInformation = interface(IUnknown)
    ['{C02216F6-8C67-4B5B-9D00-D008E73E0064}']
    function GetPeakValue(out pfPeak: Single): HRESULT; stdcall;
    function GetMeteringChannelCount(out pnChannelCount: UINT): HRESULT; stdcall;
    function GetChannelsPeakValues(u32ChannelCount: UINT; out afPeakValues: pSingle): HRESULT; stdcall;
    function QueryHardwareSupport(out pdwHardwareSupportMask: UINT): HRESULT; stdcall;
  end;

type
  TForm1 = class(TForm)
    ProgressBar1: TProgressBar;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  const
  IID_IMMDeviceEnumerator: TGUID = '{A95664D2-9614-4F35-A746-DE8DB63617E6}';
  CLASS_IMMDeviceEnumerator: TGUID = '{BCDE0395-E52F-467C-8E3D-C4579291692E}';
  IID_IAudioMeterInformation: TGUID = '{C02216F6-8C67-4B5B-9D00-D008E73E0064}';
  eRender = $00000000;
  eConsole = $00000000;


var
  Form1: TForm1;
  peak: IAudioMeterInformation = nil;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
  device: IMMDevice;
  deviceEnumerator: IMMDeviceEnumerator;
begin
  Timer1.Enabled := False;
  ProgressBar1.Max := 65535;
  CoCreateInstance(CLASS_IMMDeviceEnumerator, nil, CLSCTX_ALL, IID_IMMDeviceEnumerator, deviceEnumerator);
  deviceEnumerator.GetDefaultAudioEndpoint(eRender, eConsole, device);
  device.Activate(IID_IAudioMeterInformation, CLSCTX_ALL, nil, IUnknown(peak));
  Timer1.Enabled := true;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  device: IMMDevice;
  deviceEnumerator: IMMDeviceEnumerator;
begin
  Timer1.Enabled := False;
  ProgressBar1.Max := 65535;
  CoCreateInstance(CLASS_IMMDeviceEnumerator, nil, CLSCTX_ALL, IID_IMMDeviceEnumerator, deviceEnumerator);
  deviceEnumerator.GetDefaultAudioEndpoint(eRender, eConsole, device);
  device.Activate(IID_IAudioMeterInformation, CLSCTX_ALL, nil, IUnknown(peak));
  Timer1.Enabled := true;
end;

end.
Нашел такой код, но он не работает, прогрессбар стоит на месте, в чем проблема непонятно (
stlcrash вне форума Ответить с цитированием
Старый 16.08.2020, 22:34   #5
stlcrash
Форумчанин
 
Регистрация: 04.07.2010
Сообщений: 131
По умолчанию

Код:
Unit Unit1;
 
Interface
 
Uses
  Winapi.Windows,
  Winapi.Messages,
  System.SysUtils,
  System.Variants,
  System.Classes,
  Vcl.Graphics,
  Vcl.Controls,
  Vcl.Forms,
  Vcl.Dialogs,
  Winapi.ActiveX,
  System.Win.ComObj,
  MMSystem,
  Vcl.ComCtrls,
  Vcl.ExtCtrls;
 
Type
  EDATAFLOW = TOleEnum;
  EROLE     = TOleEnum;
 
  IMMDevice = Interface(IUnknown)
    ['{D666063F-1587-4E43-81F1-B948E807363F}']
    Function Activate(Const iid: TGUID; Const dwClsCtx: UINT; Const pActivationParams: PPropVariant; Out ppInterface: IUnknown): HRESULT; Stdcall;
  End;
 
  IMMDeviceCollection = Interface(IUnknown)
    ['{0BD7A1BE-7A1A-44DB-8397-CC5392387B5E}']
  End;
 
  IMMDeviceEnumerator = Interface(IUnknown)
    ['{A95664D2-9614-4F35-A746-DE8DB63617E6}']
    Function EnumAudioEndpoints(Const dataFlow: EDATAFLOW; Const dwStateMask: DWORD; Out ppDevices: IMMDeviceCollection): HRESULT; Stdcall;
    Function GetDefaultAudioEndpoint(Const dataFlow: EDATAFLOW; Const role: EROLE; Out ppEndpoint: IMMDevice): HRESULT; Stdcall;
  End;
 
  IAudioMeterInformation = Interface(IUnknown)
    ['{C02216F6-8C67-4B5B-9D00-D008E73E0064}']
    Function GetPeakValue(Out pfPeak: Single): HRESULT; Stdcall;
    Function GetMeteringChannelCount(Out pnChannelCount: UINT): HRESULT; Stdcall;
    Function GetChannelsPeakValues(u32ChannelCount: UINT; Out afPeakValues: pSingle): HRESULT; Stdcall;
    Function QueryHardwareSupport(Out pdwHardwareSupportMask: UINT): HRESULT; Stdcall;
  End;
 
Type
  TForm1 = Class(TForm)
    ProgressBar1: TProgressBar;
    Timer1: TTimer;
    Procedure FormCreate(Sender: TObject);
    Procedure FormDestroy(Sender: TObject);
    Procedure Timer1Timer(Sender: TObject);
  Private
    Enumerator: IMMDeviceEnumerator;
    Device: IMMDevice;
    Meter: IAudioMeterInformation;
  End;
 
Const
  IID_IMMDeviceEnumerator: TGUID    = '{A95664D2-9614-4F35-A746-DE8DB63617E6}';
  CLASS_IMMDeviceEnumerator: TGUID  = '{BCDE0395-E52F-467C-8E3D-C4579291692E}';
  IID_IAudioMeterInformation: TGUID = '{C02216F6-8C67-4B5B-9D00-D008E73E0064}';
  eRender                           = $00000000;
  eConsole                          = $00000000;
 
Var
  Form1: TForm1;
 
Implementation
 
{$R *.dfm}
 
Procedure TForm1.FormCreate(Sender: TObject);
Begin
Timer1.Enabled := False;
// CoInitialize(Nil);
// ProgressBar1.Max := 40;
OleCheck(CoCreateInstance(CLASS_IMMDeviceEnumerator, Nil, CLSCTX_ALL, IID_IMMDeviceEnumerator, Enumerator));
OleCheck(Enumerator.GetDefaultAudioEndpoint(eRender, eConsole, Device));
OleCheck(Device.Activate(IID_IAudioMeterInformation, CLSCTX_ALL, Nil, IUnknown(Meter)));
Timer1.Enabled := True;
End;
 
Procedure TForm1.FormDestroy(Sender: TObject);
Begin
Meter := Nil;
Device := Nil;
Enumerator := Nil;
End;
 
Procedure TForm1.Timer1Timer(Sender: TObject);
Var
  Ret: HRESULT;
  PeakVal: Single;
Begin
Ret := Meter.GetPeakValue(PeakVal);
If Succeeded(Ret) Then
  ProgressBar1.Position := Round(ProgressBar1.Max * PeakVal)
Else
  Caption := SysErrorMessage(Cardinal(Ret));
End;
 
End.
Всем спасибо, решение выше.
stlcrash вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме 20000 рублей в месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Программа-синтезатор + исходники на гитхаб - как пример использования вывода звука через ASIO, вообще генерации звука как такового zx3267 Visual C++ 0 09.02.2020 10:05
отследить появление процесса Artem0801 Общие вопросы .NET 1 16.12.2019 12:36
Отследить появление DOM 7in JavaScript, Ajax 15 27.01.2016 17:54
Отследить появление новой записи в БД alekslep БД в Delphi 0 18.10.2010 12:38
Как отследить появление нового диска? 54rus Помощь студентам 13 10.02.2010 16:26


Проекты отопления, пеллетные котлы, бойлеры, радиаторы
интернет магазин respective.ru
Пеллетный котёл Emtas
котлы EMTAS