如題,
開發環境 D7,W10
目前可在W7,W10測試成功,
但XP執行時失敗.

要求:
不是取得音量設定值,
而是取得輸出時(喇叭播放)的即時音量(請看附件裡的圖檔),

可參考附件裡的程式碼.
使用物件只有 Timer,ProgressBar .Label

請問,XP可否做得到?
(因為,有些因素,所以只能使用XP的環境)

[code delphi]
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, ComCtrls,MMSystem,ActiveX,ComObj,StdCtrls;

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;
TForm1 = class(TForm)
ProgressBar1: TProgressBar;
Timer1: TTimer;
Label1: TLabel;
Label2: TLabel;
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
Temp: Single;
begin

peak.GetPeakValue(Temp);
ProgressBar1.position := Round(Temp * 65535);
Label1.Caption :=InttoStr(ProgressBar1.position);
Application.ProcessMessages ;
end;

end.

[/code]

PS:勿在XP直接執行.exe,會一直跳錯誤視窗.

附加檔案：5ea903814efd8_getsound.RAR

編輯記錄

找到一個別人的程式,可以在XP跑,沒問題.
http://www.pablosoftwaresolutions.com/example.php?id=27
只是不知他怎寫的?
有人可以幫忙嗎?