“delphi內進行音量控制及靜音”是一位資深人士房子博客的 .他的代碼不會錯的,但由于沒有表單,沒搞過,不知咋弄,誰能把它改成有表單的代碼,兩貼一起結!謝謝
unit UMute;
interface
uses MMSystem, Dialogs;
Type
TDeviceName = (Master, Microphone, WaveOut, Synth);
function GetVolume(DN:TDeviceName) : Word ;
procedure SetVolume(DN:TDeviceName; Value:Word);
function GetVolumeMute(DN:TDeviceName) : Boolean;
procedure SetVolumeMute(DN:TDeviceName; Value:Boolean);
implementation
//獲取音量
function GetVolume(DN:TDeviceName) : Word;
var
hMix: HMIXER;
mxlc: MIXERLINECONTROLS;
mxcd: TMIXERCONTROLDETAILS;
vol: TMIXERCONTROLDETAILS_UNSIGNED;
mxc: MIXERCONTROL;
mxl: TMixerLine;
intRet: Integer;
nMixerDevs: Integer;
begin
Result:=0;
// Check if Mixer is available
nMixerDevs := mixerGetNumDevs();
if (nMixerDevs < 1) then Exit;
// open the mixer
intRet := mixerOpen(@hMix, 0, 0, 0, 0);
if intRet = MMSYSERR_NOERROR then begin
case DN of
Master : mxl.dwComponentType := MIXERLINE_COMPONENTTYPE_DST_SPEAKERS;
Microphone : mxl.dwComponentType := MIXERLINE_COMPONENTTYPE_SRC_MICROPHONE;
WaveOut : mxl.dwComponentType := MIXERLINE_COMPONENTTYPE_SRC_WAVEOUT;
Synth : mxl.dwComponentType := MIXERLINE_COMPONENTTYPE_SRC_SYNTHESIZER;
end;
mxl.cbStruct := SizeOf(mxl);
// get line info
intRet := mixerGetLineInfo(hMix, @mxl, MIXER_GETLINEINFOF_COMPONENTTYPE);
if intRet = MMSYSERR_NOERROR then begin
FillChar(mxlc, SizeOf(mxlc),0);
mxlc.cbStruct := SizeOf(mxlc);
mxlc.dwLineID := mxl.dwLineID;
mxlc.dwControlType := MIXERCONTROL_CONTROLTYPE_VOLUME;
mxlc.cControls := 1;
mxlc.cbmxctrl := SizeOf(mxc);
mxlc.pamxctrl := @mxc;
intRet := mixerGetLineControls(hMix, @mxlc, MIXER_GETLINECONTROLSF_ONEBYTYPE);
if intRet = MMSYSERR_NOERROR then begin
FillChar(mxcd, SizeOf(mxcd),0);
mxcd.dwControlID := mxc.dwControlID;
mxcd.cbStruct := SizeOf(mxcd);
mxcd.cMultipleItems := 0;
mxcd.cbDetails := SizeOf(Vol);
mxcd.paDetails := @vol;
mxcd.cChannels := 1;
intRet := mixerGetControlDetails(hMix, @mxcd,MIXER_SETCONTROLDETAILSF_VALUE);
Result := vol.dwValue ;
if intRet <> MMSYSERR_NOERROR then
ShowMessage('GetControlDetails Error');
end else
ShowMessage('GetLineInfo Error');
end;
mixerClose(hMix);
end;
end;
//設定音量
procedure setVolume(DN:TDeviceName; Value : Word);
var
hMix: HMIXER;
mxlc: MIXERLINECONTROLS;
mxcd: TMIXERCONTROLDETAILS;
vol: TMIXERCONTROLDETAILS_UNSIGNED;
mxc: MIXERCONTROL;
mxl: TMixerLine;
intRet: Integer;
nMixerDevs: Integer;
begin
// Check if Mixer is available
nMixerDevs := mixerGetNumDevs();
if (nMixerDevs < 1) then Exit;
// open the mixer
intRet := mixerOpen(@hMix, 0, 0, 0, 0);
if intRet = MMSYSERR_NOERROR then begin
case DN of
Master : mxl.dwComponentType := MIXERLINE_COMPONENTTYPE_DST_SPEAKERS;
Microphone : mxl.dwComponentType := MIXERLINE_COMPONENTTYPE_SRC_MICROPHONE;
WaveOut : mxl.dwComponentType := MIXERLINE_COMPONENTTYPE_SRC_WAVEOUT;
Synth : mxl.dwComponentType := MIXERLINE_COMPONENTTYPE_SRC_SYNTHESIZER;
end;
mxl.cbStruct := SizeOf(mxl);
// get line info
intRet := mixerGetLineInfo(hMix, @mxl, MIXER_GETLINEINFOF_COMPONENTTYPE);
if intRet = MMSYSERR_NOERROR then begin
FillChar(mxlc, SizeOf(mxlc),0);
mxlc.cbStruct := SizeOf(mxlc);
mxlc.dwLineID := mxl.dwLineID;
mxlc.dwControlType := MIXERCONTROL_CONTROLTYPE_VOLUME;
mxlc.cControls := 1;
mxlc.cbmxctrl := SizeOf(mxc);
mxlc.pamxctrl := @mxc;
intRet := mixerGetLineControls(hMix, @mxlc, MIXER_GETLINECONTROLSF_ONEBYTYPE);
if intRet = MMSYSERR_NOERROR then begin
FillChar(mxcd, SizeOf(mxcd),0);
mxcd.dwControlID := mxc.dwControlID;
mxcd.cbStruct := SizeOf(mxcd);
mxcd.cMultipleItems := 0;
mxcd.cbDetails := SizeOf(Vol);
mxcd.paDetails := @vol;
mxcd.cChannels := 1;
vol.dwValue := Value;
intRet := mixerSetControlDetails(hMix, @mxcd,MIXER_SETCONTROLDETAILSF_VALUE);
if intRet <> MMSYSERR_NOERROR then
ShowMessage('SetControlDetails Error');
end else
ShowMessage('GetLineInfo Error');
end;
mixerClose(hMix);
end;
end;
//獲取靜音
function GetVolumeMute(DN:TDeviceName) : Boolean;
var
hMix: HMIXER;
mxlc: MIXERLINECONTROLS;
mxcd: TMIXERCONTROLDETAILS;
mxc: MIXERCONTROL;
mxl: TMixerLine;
intRet: Integer;
nMixerDevs: Integer;
mcdMute: MIXERCONTROLDETAILS_BOOLEAN;
begin
// Check if Mixer is available
nMixerDevs := mixerGetNumDevs();
Result:=False;
if (nMixerDevs < 1) then Exit;
// open the mixer
intRet := mixerOpen(@hMix, 0, 0, 0, 0);
if intRet = MMSYSERR_NOERROR then begin
case DN of
Master : mxl.dwComponentType := MIXERLINE_COMPONENTTYPE_DST_SPEAKERS;
Microphone : mxl.dwComponentType := MIXERLINE_COMPONENTTYPE_SRC_MICROPHONE;
WaveOut : mxl.dwComponentType := MIXERLINE_COMPONENTTYPE_SRC_WAVEOUT;
Synth : mxl.dwComponentType := MIXERLINE_COMPONENTTYPE_SRC_SYNTHESIZER;
end;
mxl.cbStruct := SizeOf(mxl);
// mixerline info
intRet := mixerGetLineInfo(hMix, @mxl, MIXER_GETLINEINFOF_COMPONENTTYPE);
if intRet = MMSYSERR_NOERROR then begin
FillChar(mxlc, SizeOf(mxlc),0);
mxlc.cbStruct := SizeOf(mxlc);
mxlc.dwLineID := mxl.dwLineID;
mxlc.dwControlType := MIXERCONTROL_CONTROLTYPE_MUTE;
mxlc.cControls := 1;
mxlc.cbmxctrl := SizeOf(mxc);
mxlc.pamxctrl := @mxc;
// Get the mute control
intRet := mixerGetLineControls(hMix, @mxlc, MIXER_GETLINECONTROLSF_ONEBYTYPE);
if intRet = MMSYSERR_NOERROR then begin
FillChar(mxcd, SizeOf(mxcd),0);
mxcd.cbStruct := SizeOf(TMIXERCONTROLDETAILS);
mxcd.dwControlID := mxc.dwControlID;
mxcd.cChannels := 1;
mxcd.cbDetails := SizeOf(MIXERCONTROLDETAILS_BOOLEAN);
mxcd.paDetails := @mcdMute;
// Get mute
intRet := mixerGetControlDetails(hMix, @mxcd, MIXER_SETCONTROLDETAILSF_VALUE);
if mcdMute.fValue = 0 then
Result:=false
else
Result := True;
if intRet <> MMSYSERR_NOERROR then
ShowMessage('SetControlDetails Error');
end else
ShowMessage('GetLineInfo Error');
end;
end;
end;
//獲取靜音
procedure SetVolumeMute(DN:TDeviceName; Value:Boolean);
var
hMix: HMIXER;
mxlc: MIXERLINECONTROLS;
mxcd: TMIXERCONTROLDETAILS;
mxc: MIXERCONTROL;
mxl: TMixerLine;
intRet: Integer;
nMixerDevs: Integer;
mcdMute: MIXERCONTROLDETAILS_BOOLEAN;
begin
// Check if Mixer is available
nMixerDevs := mixerGetNumDevs();
if (nMixerDevs < 1) then Exit;
// open the mixer
intRet := mixerOpen(@hMix, 0, 0, 0, 0);
if intRet = MMSYSERR_NOERROR then begin
case DN of
Master : mxl.dwComponentType := MIXERLINE_COMPONENTTYPE_DST_SPEAKERS;
Microphone : mxl.dwComponentType := MIXERLINE_COMPONENTTYPE_SRC_MICROPHONE;
WaveOut : mxl.dwComponentType := MIXERLINE_COMPONENTTYPE_SRC_WAVEOUT;
Synth : mxl.dwComponentType := MIXERLINE_COMPONENTTYPE_SRC_SYNTHESIZER;
end;
mxl.cbStruct := SizeOf(mxl);
// mixerline info
intRet := mixerGetLineInfo(hMix, @mxl, MIXER_GETLINEINFOF_COMPONENTTYPE);
if intRet = MMSYSERR_NOERROR then begin
FillChar(mxlc, SizeOf(mxlc),0);
mxlc.cbStruct := SizeOf(mxlc);
mxlc.dwLineID := mxl.dwLineID;
mxlc.dwControlType := MIXERCONTROL_CONTROLTYPE_MUTE;
mxlc.cControls := 1;
mxlc.cbmxctrl := SizeOf(mxc);
mxlc.pamxctrl := @mxc;
// Get the mute control
intRet := mixerGetLineControls(hMix, @mxlc, MIXER_GETLINECONTROLSF_ONEBYTYPE);
if intRet = MMSYSERR_NOERROR then begin
FillChar(mxcd, SizeOf(mxcd),0);
mxcd.cbStruct := SizeOf(TMIXERCONTROLDETAILS);
mxcd.dwControlID := mxc.dwControlID;
mxcd.cChannels := 1;
mxcd.cbDetails := SizeOf(MIXERCONTROLDETAILS_BOOLEAN);
mxcd.paDetails := @mcdMute;
if Value then
mcdMute.fValue:=1
else
mcdMute.fValue:=0;
// Get mute
intRet := mixerSetControlDetails(hMix, @mxcd, MIXER_SETCONTROLDETAILSF_VALUE);
if intRet <> MMSYSERR_NOERROR then
ShowMessage('SetControlDetails Error');
end else
ShowMessage('GetLineInfo Error');
end;
end;
end;
end
uj5u.com熱心網友回復:
這個。。。這個是類單元,要改成有表單?on my god...
uj5u.com熱心網友回復:
function GetVolume(DN:TDeviceName) : Word ;procedure SetVolume(DN:TDeviceName; Value:Word);
function GetVolumeMute(DN:TDeviceName) : Boolean;
procedure SetVolumeMute(DN:TDeviceName; Value:Boolean);
人家寫函式和方法,都給出來了,你只需要呼叫就好,
其中 TDeviceName 是:
TDeviceName = (Master, Microphone, WaveOut, Synth);
還要改什么鳥有表單的。。。
uj5u.com熱心網友回復:
樓主是不會用吧?把這個單元放到你專案中,在你的TForm1中參考這個單元,你自已加些按鈕一類的控制元件,在控制元件事件中,如點擊事件呼叫這些函式就可以了。uj5u.com熱心網友回復:
謝謝,我就是這樣弄的,但是音量控制不起作用!我是Win7系統,在“音量合成器-揚聲器”中,可以看到原先有兩個“控制條”,名字是“揚聲器”和“系統聲音”,軟體啟動后,又自行打開一個“控制條”,不能控制原先兩個。好像只能在xp中控制!uj5u.com熱心網友回復:
誰有控制win7音量的原始碼或者控制元件,支持一下!uj5u.com熱心網友回復:
可能是設備的名字不一樣了?uj5u.com熱心網友回復:
vista/win7 一些功能架構已經完全改變。這個是 XP 以下的代碼,控制 vista/win7 外國論壇有,或者去看 MS 的開發幫助檔案。uj5u.com熱心網友回復:
找到一個vol.dll,評論說win7效果可以函式也已提供:
GetVolume = Function(): Integer; cdecl;
SetVolume = Function(nVol: Integer): Boolean; cdecl;
但試用每次都失敗,自動進入debug
dll很少用,請高人看看錯在哪里?
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Label1: TLabel;
Edit1: TEdit;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
nVol,aa1: Integer;
function GetVolume(): Integer; stdcall;
function SetVolume(nVol: Integer):boolean;stdcall;
implementation
{$R *.dfm}
function GetVolume(): Integer; external 'vol.dll ' ;
function SetVolume(nVol: Integer): Boolean; external 'vol.dll ' ;
//function SetVolume(nVol: Integer): Boolean;stdcall; external 'vol.dll ' ;
procedure TForm1.Button1Click(Sender: TObject);
begin
aa1:=GetVolume;
label1.Caption:=inttostr(aa1);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
nVol:=strtoint(edit1.text);
If SetVolume(nVol) then
//If SetVolume(strtoint(edit1.text)) then
//If SetVolume(8) then
label1.Caption:='系統音量設定成功'
else
label1.Caption:='系統音量設定失敗' ;
end;
end.
uj5u.com熱心網友回復:
該dll還帶有vol.lib,不知有無關系uj5u.com熱心網友回復:
dll函式不需要加引數呼叫規則宣告么?stdcall,cdecluj5u.com熱心網友回復:
調了呀,你看備注內容,是我認為幾種情況都試了一下,全部失敗!我很菜,呼叫dll是先蒸現賣,你說的我看資料沒有注意到,請教怎么改。有的資料說,還要用到.lib檔案,請堅持用dll的高手支個招!uj5u.com熱心網友回復:
dll沒有接觸過!uj5u.com熱心網友回復:
留著,,,,,,,,,uj5u.com熱心網友回復:
http://www.torry.net/ 上有很多VCL控制元件,可以去找找看uj5u.com熱心網友回復:
有名的bass.dll去度娘一下看看轉載請註明出處,本文鏈接:https://www.uj5u.com/houduan/140939.html
上一篇:北京有delphi的程式員嗎!
下一篇:如何控制(切換)其他程式的輸入法
