Witam.
Problem jak w temacie.
Próbuję zrobić program który zmienia głośność systemu.
Nie wiem czy to sprawka Visty czy czegoś innego, ale po prostu funkcja WaveOutSetVolume nie działa.
Szukałem prawie wszędzie, ale znalazłem tylko jeden program dzięki któremu regulacja działa, lecz z tego kodu nic się nie wyznam. Oto on:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, OleCtrls, MMsystem;
type
TForm1 = class(TForm)
CheckBox1: TCheckBox;
Button1: TButton;
Edit1: TEdit;
Button2: TButton;
procedure Button2Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure FormClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure BtnVocalClick(Sender: TObject);
private
{ Private 錾 }
public
{ Public 錾}
end;
var
Form1: TForm1;
OS: String;
implementation
{$R *.dfm}
uses MMDeviceApi, ActiveX, ComObj, StdConvs;
procedure SetVolumeChannel(Channel:byte);
var Lvol, RVol, LValue, RValue, temp: DWord;
begin
// WaveoutGetVolume() retrieves the current volume
WaveoutGetVolume(WAVE_MAPPER, @temp);
Lvol := Loword(temp);
Rvol := hiword(temp);
if channel = 0 then
begin //Left Channel
LValue := 65535;
RValue := 0;
end else if channel = 1 then begin //Right Channel
LValue := 0;
RValue := 65535;
end else if channel = 2 then begin //Stereo Channel
LValue := 65535;
RValue := 65535;
end else begin //Wrong Channel
ShowMessage('Channel Salah');
end;
asm
shl Lvalue,16
shl Rvalue,16
end;
LValue := LValue and $ffff0000;
LValue := RValue and $ffff0000;
WaveoutSetVolume(WAVE_MAPPER, LValue or Lvol);
WaveoutSetVolume(WAVE_MAPPER, RValue or Rvol);
end;
function GetWinVersion: String;
var
osVerInfo: TOSVersionInfo;
majorVersion, minorVersion: Integer;
begin
Result := 'wvUnknown';
osVerInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo) ;
if GetVersionEx(osVerInfo) then
begin
minorVersion := osVerInfo.dwMinorVersion;
majorVersion := osVerInfo.dwMajorVersion;
case osVerInfo.dwPlatformId of
VER_PLATFORM_WIN32_NT:
begin
if majorVersion <= 4 then
Result := 'wvWinNT'
else if (majorVersion = 5) and (minorVersion = 0) then
Result := 'wvWin2000'
else if (majorVersion = 5) and (minorVersion = 1) then
Result := 'wvWinXP'
else if (majorVersion = 6) then
Result := 'wvWinVista';
end;
VER_PLATFORM_WIN32_WINDOWS:
begin
if (majorVersion = 4) and (minorVersion = 0) then
Result := 'wvWin95'
else if (majorVersion = 4) and (minorVersion = 10) then
begin
if osVerInfo.szCSDVersion[1] = 'A' then
Result := 'wvWin98SE'
else
Result := 'wvWin98';
end
else if (majorVersion = 4) and (minorVersion = 90) then
Result := 'wvWinME'
else
Result := 'wvUnknown';
end;
end;
end;
end;
function GetAudioEndpointVolume:IAudioEndpointVolume;
var
Enumerator: IMMDeviceEnumerator;
Endpoint: IMMDevice;
clsid: TGUID;
begin
Result := nil;
Enumerator := CreateComObject(CLASS_IMMDeviceEnumerator) as IMMDeviceEnumerator;
if Failed( Enumerator.GetDefaultAudioEndpoint(eRender, eConsole, Endpoint)) then Exit;
clsid := IID_IAudioEndpointVolume;
if Failed( Endpoint.Activate(clsid, CLSCTX_ALL, nil, IUnknown(Result))) then Exit;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
AudioEndVol: IAudioEndpointVolume;
Vol: Single;
Mute: LongBool;
begin
AudioEndVol := GetAudioEndpointVolume;
if not Assigned(AudioEndVol) then Exit;
if Failed( AudioEndVol.GetMasterVolumeLevelScalar(Vol)) then Exit;
Edit1.Text := FloatToStr(Vol);
if Failed( AudioEndVol.GetMute(Mute)) then Exit;
CheckBox1.Checked := Mute;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
AudioEndVol: IAudioEndpointVolume;
begin
AudioEndVol := GetAudioEndpointVolume;
if not Assigned(AudioEndVol) then Exit;
if Failed( AudioEndVol.SetMasterVolumeLevelScalar(StrToFloat(Edit1.Text), @GUID_NULL)) then Exit;
if Failed( AudioEndVol.SetMute(LongBool(CheckBox1.Checked), @GUID_NULL)) then Exit;
end;
procedure TForm1.FormClick(Sender: TObject);
var
AudioEndVol: IAudioEndpointVolume;
begin
AudioEndVol := GetAudioEndpointVolume;
if not Assigned(AudioEndVol) then Exit;
AudioEndVol.SetChannelVolumeLevel(0,0,@GUID_NULL);
AudioEndVol.SetChannelVolumeLevel(1,0,@GUID_NULL);
end;
procedure TForm1.FormCreate(Sender: TObject);
var
AudioEndVol: IAudioEndpointVolume;
saluran:cardinal;
i : byte;
begin
OS := GetWinVersion();
if (OS='wvWinVista') then
begin
AudioEndVol := GetAudioEndpointVolume;
if not Assigned(AudioEndVol) then Exit;
AudioEndVol.GetChannelCount(saluran);
CBChannel.Clear;
for i := 0 to saluran-1 do
begin
CBChannel.Items.Add(inttostr(i));
end;
end else
GBSound.Enabled := false;
end;
procedure TForm1.BtnVocalClick(Sender: TObject);
var
AudioEndVol: IAudioEndpointVolume;
begin
if BtnVocal.Caption = 'Vocal ON' then
begin
BtnVocal.Caption := 'Vocal OFF';
if OS = 'wvWinVista' then
begin
AudioEndVol := GetAudioEndpointVolume;
if not Assigned(AudioEndVol) then Exit;
AudioEndVol.SetChannelVolumeLevel(1,-64,@GUID_NULL);
end else begin
SetVolumeChannel(1);
end;
end else if BtnVocal.Caption = 'Vocal OFF' then
begin
BtnVocal.Caption := 'Vocal ON';
if OS = 'wvWinVista' then
begin
AudioEndVol := GetAudioEndpointVolume;
if not Assigned(AudioEndVol) then Exit;
AudioEndVol.SetChannelVolumeLevel(1,0,@GUID_NULL);
end else begin
SetVolumeChannel(2);
end;
end;
end;
Z góry dziękuję za pomoc.
Pozdrawiam
RampleR