再加60分，找到高人代码，却不会用，各位指点一下

wenqy01 2012-06-21 07:53:50
“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
...全文
410 15 打赏 收藏 转发到动态 举报
写回复
用AI写文章
15 条回复
切换为时间正序
请发表友善的回复…
发表回复
hongss 2013-03-16
  • 打赏
  • 举报
 回复
有名的bass.dll去度娘一下看看
天剑68 2013-03-16
  • 打赏
  • 举报
 回复
http://www.torry.net/ 上有很多VCL控件，可以去找找看
spr2372 2013-03-16
  • 打赏
  • 举报
 回复
留着，，，，，，，，，
wenqy01 2012-06-23
  • 打赏
  • 举报
 回复
dll没有接触过！
Frank.WU 2012-06-22
  • 打赏
  • 举报
 回复
vista/win7 一些功能架构已经完全改变。这个是 XP 以下的代码，控制 vista/win7 外国论坛有，或者去看 MS 的开发帮助文档。
haitao 2012-06-22
  • 打赏
  • 举报
 回复
可能是设备的名字不一样了？
wenqy01 2012-06-22
  • 打赏
  • 举报
 回复
谁有控制win7音量的源码或者控件，支持一下！
wenqy01 2012-06-22
  • 打赏
  • 举报
 回复
谢谢，我就是这样弄的，但是音量控制不起作用！我是Win7系统，在“音量合成器-扬声器”中，可以看到原先有两个“控制条”，名字是“扬声器”和“系统声音”，软件启动后，又自行打开一个“控制条”，不能控制原先两个。好像只能在xp中控制！
Oraclers 2012-06-22
  • 打赏
  • 举报
 回复
楼主是不会用吧？把这个单元放到你项目中，在你的TForm1中引用这个单元，你自已加些按钮一类的控件，在控件事件中，如点击事件调用这些函数就可以了。
d-ok 2012-06-22
  • 打赏
  • 举报
 回复
调了呀，你看备注内容，是我认为几种情况都试了一下，全部失败！我很菜，调用dll是先蒸现卖，你说的我看资料没有注意到，请教怎么改。有的资料说，还要用到.lib文件，请坚持用dll的高手支个招！
mdejtod 2012-06-22
  • 打赏
  • 举报
 回复
dll函数不需要加参数调用规则声明么？stdcall,cdecl
d-ok 2012-06-22
  • 打赏
  • 举报
 回复
该dll还带有vol.lib，不知有无关系
d-ok 2012-06-22
  • 打赏
  • 举报
 回复
找到一个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.
Frank.WU 2012-06-21
  • 打赏
  • 举报
 回复
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);

还要改什么鸟有窗体的。。。
Frank.WU 2012-06-21
  • 打赏
  • 举报
 回复
这个。。。这个是类单元，要改成有窗体？
on my god...
Qt5 多线程职场技能知几何
根据多年工作经验，总结Qt线程开发所需的各项技术及需要深入理解的各个技能知识点，结合硬件cpu及操作系统两个角色和Qt编码规则精心打造多线程编程知己何这次视频课程，希望帮助那些被Qt多线程困扰的同学少走弯路快速理解及掌握线程编程。希望此次课程不足之处得到高人进一步指点，后续更新继续为Qt编码从业者提供便利，以求共勉。
Ext 拖动的选项卡
用ext 实现 类似360浏览器上面的选项卡，可以前后移动，可以新建（次要）， 或能实现当选项卡移动时空出位置的也可以 如能实现再加分， 希望有兴趣研究的网站前端开发人员和网页设计人员，能针对...
三面阿里失败，幸获高人指点缺陷所在，奋战三个月成功入职字节
BlockingQueue的使用 Java内存分代模型，GC算法，JVM常见的启动参数； CMS算法的过程。 volatile关键字有什么用（包括底层原理） 线程池的调优策略 spring cloud的服务注册与发现是怎么设计的？ 分布式系统的全局id...
水波纹屏保原理
这里我将陆续发布一些我自己做的小程序，有些程序可能有点粗糙，希望各位高人多加指点！首先把我今年3月份作的一个程序，拿来晾一下。本程序实现对水波折射等物理现象的模拟。 水波纹屏保 程序效果图：   ...
关于本人自学Java的一点经验（一）
关于本人自学Java的一点经验（一） ... 本文章初次发表于本人的Java自学群里...欢迎各位高人指点！   鉴于本人自学Java已经找到工作，特鼓起勇气将我的一点自学经验写出来与同是自学Java的朋友一起分享． 首先，我想...
Windows SDK/API

1,183

社区成员

22,335

社区内容

发帖
与我相关
我的任务
社区描述
Delphi Windows SDK/API
社区管理员
  • Windows SDK/API社区
加入社区
  • 近7日
  • 近30日
  • 至今

加载中

查看更多榜单
社区公告
暂无公告

试试用AI创作助手写篇文章吧

+ 用AI写文章