用混音组件。
请参考以下代码:
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.