如何用程序实现对系统声卡--录音控制中的Stereo Mix和麦克风等的相互切换?(100分)

  • 主题发起人 jiangsir_xjtu
  • 开始时间
J

jiangsir_xjtu

Unregistered / Unconfirmed
GUEST, unregistred user!
我的声卡支持windows系统声音的同步录制,即可以通过录音工具(比如录音机)直接将winamp的音乐录下来,但是这必须在 录音控制中选择 Stereo Mix选项,我的程序必要的时候要对这个进行多次切换,如何通过Delphi用On-Off来切换?请高手指教。新手100分奉送。
 
用混音组件。
请参考以下代码:

unit Mixer;

interface
uses Windows, Messages, SysUtils, Classes, Forms, MMSystem;

type
TMeterData = class;

TMeterControl = class(TObject)
private
Owner: TMeterData;
Control: TMixerControl;
LineID: Integer;
Device: Integer;
fActive: Boolean;

function GetMeterName: string;
procedure SetActive(Value: Boolean);
function GetLevelL: Integer;
function GetLevelR: Integer;
function GetMin: Integer;
function GetMax: Integer;
procedure Open;
procedure Close;
public
constructor Create (AOwner: TMeterData;
aDevice, aLineID: Integer;
const aControl: TMixerControl);
destructor Destroy;
override;
property MeterName: string read GetMeterName;
property Active: Boolean read fActive write SetActive;
property LevelL: Integer read GetLevelL;
property LevelR: Integer read GetLevelR;
property Min: Integer read GetMin;
property Max: Integer read GetMax;
procedure GetLevelLR(var L, R: Integer);
end;


TMeterData = class(TObject)
private
fOnLineChange: TNotifyEvent;
fMixerHandle: HMIXER;
fHandle: HWND;
fActive: boolean;
fMeterControls: TList;
procedure WndProc (var Msg: TMessage);
procedure MmMixmControlChange (var Msg: TMessage);
message MM_MIXM_CONTROL_CHANGE;
procedure MmMixmLineChange (var Msg: TMessage);
message MM_MIXM_LINE_CHANGE;
function GetMeterCount: Integer;
function GetMeter(AIndex: Integer) : TMeterControl;
procedure SetActive(Value: Boolean);
procedure Open;
procedure Close;
procedure OpenDevice(MeterIdx: Integer);
procedure CloseDevice(MeterIdx: Integer);
protected
public
constructor Create (AOwner: TComponent);
destructor Destroy;
override;
property MeterCount: Integer read GetMeterCount;
property Meters[AIndex: Integer]: TMeterControl read GetMeter;
published
property Active: Boolean read fActive write SetActive;
property OnLineChange: TNotifyEvent read fOnLineChange write fOnLineChange;
end;


implementation

constructor TMeterControl.Create (AOwner : TMeterData;
aDevice, aLineID : Integer;
const aControl : TMixerControl);
begin

owner := AOwner;
device := aDevice;
lineId := aLineID;
control := aControl;
end;


destructor TMeterControl.Destroy;
begin

Close;
inherited
end;


function TMeterControl.GetMeterName : string;
begin

result := control.szName
end;


procedure TMeterControl.SetActive (value : boolean);
begin

if fActive <> value then

begin

if value then
Open else
Close;
fActive := value
end
end;


procedure TMeterControl.Open;
begin

owner.OpenDevice (owner.fMeterControls.IndexOf(self));
end;


procedure TMeterControl.Close;
begin

if fActive then

owner.CloseDevice (owner.fMeterControls.IndexOf (self));
end;


function TMeterControl.GetMin : Integer;
begin

result := control.Bounds.lMinimum
end;


function TMeterControl.GetMax : Integer;
begin

result := control.Bounds.lMaximum
end;


function TMeterControl.GetLevelL : Integer;
var
mixerControlDetails : TMixerControlDetails;
nChannels: Integer;
buffer : array [0..128] of Integer;
begin

nChannels := 2;
FillChar (mixerControlDetails, sizeof (mixerControlDetails), 0);
mixerControlDetails.cbStruct := sizeof (mixerControlDetails);
mixerControlDetails.dwControlID := control.dwControlID;
mixerControlDetails.cChannels := nChannels;
mixerControlDetails.cMultipleItems := control.cMultipleItems;
mixerControlDetails.cbDetails := sizeof (Integer);
mixerControlDetails.paDetails := @buffer;
if mixerGetControlDetails (owner.fMixerHandle, @mixerControlDetails, MIXER_GETCONTROLDETAILSF_VALUE) = MMSYSERR_NOERROR then

result := buffer [0]
else

result := 0
end;


function TMeterControl.GetLevelR : Integer;
var
mixerControlDetails : TMixerControlDetails;
nChannels: Integer;
buffer : array [0..128] of Integer;
begin

nChannels := 2;
FillChar(mixerControlDetails, sizeof (mixerControlDetails), 0);
mixerControlDetails.cbStruct := sizeof (mixerControlDetails);
mixerControlDetails.dwControlID := control.dwControlID;
mixerControlDetails.cChannels := nChannels;
mixerControlDetails.cMultipleItems := control.cMultipleItems;
mixerControlDetails.cbDetails := sizeof (Integer);
mixerControlDetails.paDetails := @buffer;
if mixerGetControlDetails (owner.fMixerHandle, @mixerControlDetails, MIXER_GETCONTROLDETAILSF_VALUE) = MMSYSERR_NOERROR then

result := buffer [1]
else

result := 0
end;


procedure TMeterControl.GetLevelLR(var L,R : Integer);
var
mixerControlDetails : TMixerControlDetails;
nChannels: Integer;
buffer : array [0..128] of Integer;
begin

nChannels := 2;
FillChar (mixerControlDetails, sizeof (mixerControlDetails), 0);
mixerControlDetails.cbStruct := sizeof (mixerControlDetails);
mixerControlDetails.dwControlID := control.dwControlID;
mixerControlDetails.cChannels := nChannels;
mixerControlDetails.cMultipleItems := control.cMultipleItems;
mixerControlDetails.cbDetails := sizeof (Integer);
mixerControlDetails.paDetails := @buffer;
if mixerGetControlDetails (owner.fMixerHandle, @mixerControlDetails, MIXER_GETCONTROLDETAILSF_VALUE) = MMSYSERR_NOERROR then
begin

L := Buffer [0];
R := Buffer [1];
end else
begin

L := 0;
R := 0;
end;

end;


constructor TMeterData.Create (AOwner : TComponent);
begin

inherited Create;
fMeterControls := TList.Create;
fHandle := AllocateHWND (WndProc);
end;


destructor TMeterData.Destroy;
begin

Close;
DeallocateHWND (fHandle);
inherited
end;


procedure TMeterData.WndProc (var Msg : TMessage);
begin

try
Dispatch (Msg);
except
Application.HandleException (self)
end
end;


procedure TMeterData.MmMixmControlChange (var Msg : TMessage);
begin

Windows.Beep (440, 100);
end;


procedure TMeterData.MmMixmLineChange (var Msg : TMessage);
begin

if Assigned(fOnLineChange) then

OnLineChange (self);
end;


function TMeterData.GetMeterCount : Integer;
begin

result := fMeterControls.Count;
end;


procedure TMeterData.SetActive (Value: Boolean);
begin

if value <> fActive then

begin

if value then

Open
else

Close;
fActive := value
end
end;


procedure TMeterData.Open;
var
i, j, k, numDevs : Integer;
caps : TMixerCaps;
mixerLine, sourceLine : TMixerLine;

procedure AddControlInfo (device : Integer;
const line : TMixerLine);
var
i : Integer;
lineControls : TMixerLineControls;
controls, p : PMixerControl;
begin

GetMem (Controls, sizeof (TMixerControl) * line.cControls);
try
FillChar (lineControls, SizeOf (lineControls), 0);
lineControls.cbStruct := sizeof (lineControls);
lineControls.dwLineID := line.dwLineID;
lineControls.cControls := line.cControls;
lineControls.cbmxctrl := sizeof (TMixerControl);
lineControls.pamxctrl := controls;

mixerGetLineControls (device, @lineControls, MIXER_GETLINECONTROLSF_ALL or MIXER_OBJECTF_MIXER);

p := controls;
for i := 0 to lineControls.cControls - 1do

begin

if (p^.dwControlType and MIXERCONTROL_CT_CLASS_MASK) = MIXERCONTROL_CT_CLASS_METER then

fMeterControls.Add (TMeterControl.Create (self, device, line.dwLineID, p^));
Inc (p);
end
finally
FreeMem (controls)
end
end;


begin

numDevs := mixerGetNumDevs;
for i := 0 to numDevs - 1do

begin

if mixerGetDevCaps (i, @caps, sizeof (caps)) = MMSYSERR_NOERROR then

begin

for j := 0 to caps.cDestinations - 1do

begin

FillChar (mixerLine, sizeof (mixerLine), 0);
mixerLine.cbStruct := sizeof (mixerLine);
mixerLine.dwDestination := j;
mixerGetLineInfo (i, @mixerLine, MIXER_GETLINEINFOF_DESTINATION or MIXER_OBJECTF_MIXER);

AddControlInfo (i, mixerLine);

for k := 0 to mixerLine.cConnections - 1do

begin

FillChar (sourceLine, sizeof (sourceLine), 0);
sourceLine.cbStruct := sizeof (sourceLine);
sourceLine.dwDestination := j;
sourceLine.dwSource := k;

mixerGetLineInfo (i, @sourceLine, MIXER_GETLINEINFOF_SOURCE or MIXER_OBJECTF_MIXER);

AddControlInfo (i, sourceLine);
end
end
end
end
end;


procedure TMeterData.Close;
begin

while fMeterControls.Count > 0do

begin

TMeterControl (fMeterControls [0]).Free;
fMeterControls.Delete (0)
end;

fMeterControls.Free;
end;


function TMeterData.GetMeter (AIndex : Integer) : TMeterControl;
begin

result := TMeterControl (fMeterControls [AIndex]);
end;


procedure TMeterData.OpenDevice (meterIdx : Integer);
var
alreadyOpen : boolean;
m : TMeterControl;
i : Integer;
begin

alreadyOpen := False;
for i := 0 to MeterCount - 1do

if meterIdx <> i then

begin

m := Meters ;
if m.Active and (m.device = Meters [meterIdx].device) then

begin

alreadyOpen := True;
break
end
end;


if not alreadyOpen then

mixerOpen (@fMixerHandle, Meters [meterIdx].device, fHandle, 0, CALLBACK_WINDOW or MIXER_OBJECTF_MIXER);
end;


procedure TMeterData.CloseDevice (meterIdx : Integer);
var
m : TMeterControl;
othersOpen : boolean;
i : Integer;
begin

m := Meters [meterIdx];
othersOpen := False;
for i := 0 to MeterCount - 1do

if i <> meterIdx then

if Meters .Active and (m.device = Meters .device) then

begin

othersOpen := True;
break
end;


if not othersOpen then

begin

mixerClose (fMixerHandle);
fMixerHandle := 0
end
end;


end.


 
谢谢xwings,能具体介绍一下这个组件吗?
 
好像给错了。 :(
给我你的mail。我发一个给你。
 
thank u too!

my email: jiangpijun@163.com
 
接受答案了.
 

Similar threads

S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
I
回复
0
查看
665
import
I
I
回复
0
查看
610
import
I
顶部