unit AMixer; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, MMSystem; (* * TAudioMixer v1.11 (FREEWARE component) * ----------------- * Released 4 Jan 1999 * * This component can cache data from audio mixer. It has direct support for * getting/setting volume of any control (It can set also set state of that * "Selected" CheckBox in standard Windows Volume Control program). You can * better use other features of mixer, but that's more difficult than volume * setting and you must know something about audio mixer. * * The mixer has following structure (as it is in this component) : * * Destinations (destinations should be for example: Playback, Recording and Voice commands) * | * |--Destination[0] (if you want to get volume of this call GeVolume (,-1,...)) * | | (=0) ---- * | |--Data:TMixerLine * | |--Controls (controls of the line, ex: Master volume, master mute) * | | | * | | |--Control[0] * | | |--Control[1] * | | |--Control[..] * | | * | |--Connections (ex: Wave, MIDI, CD Audio, Line-In,...) * | | * | |--Connection[0] (GetVolume (,,...)) * | | | (=0) (=0) * | | |--Data:TMixerLine * | | |--Controls (here can be volume and mute) * | | | * | | |--Control[0] * | | |--Control[1] * | | |--Control[..] * | | * | |--Connection[1] * | |--Connection[..] * | * |--Destination[1] * |--Destination[..] * * * There are many types of controls - checkbox, list, slider,... they are * described in Windows help. Common ones are volume slider, mute checkbox or * volume meter. * * This component is universal, so you can work with all controls through it, * but this is difficult. You can simply get/set volume level by procedures * GetVolume or SetVolume (description is near their declaration; use - see * example program). * * * What's New * ---------- * 1.11 (4 Jan 1999) * - now it supports also MIXERCONTROL_CONTROLTYPE_MUX flag * (I got SB Live! for Christmas (:-)) and my component didn't work * properly, this corrects that problem) * 1.1 (16 Nov 1998) * - made compatible with Delphi 4 * - corrected memory leaks (by Ishida Wataru) * - some another minor changes (by Ishida Wataru) * - added another example * - added AMixer.dcr * 1.0 (18 Aug 1998) * - initial version * * * You can use this component freely in your programs. But if you do so, please * send me an e-mail. I would like to know if it is useful. * * ?Vit Kovalcik * * e-mail: vkovalcik@iname.com * WWW: http://www.geocities.com/SiliconValley/Hills/1335/ *) {Note: When no mixer is present TAudioMixer.Destinations will be nil. If you then check Destinations.Count it will raise exception, so be sure to check TAudioMixer.MixerCount first.} type TAudioMixer=class; TPListFreeItemNotify=procedure (Pntr:Pointer) of object; TMixerChange=procedure (Sender:TObject;MixerH:HMixer;ID:Integer) of object; {MixerH is handle of mixer, which sent this message. ID is ID of changed item (line or control).} TPointerList=class(TObject) private FOnFreeItem:TPListFreeItemNotify; Items:Tlist; protected function GetPointer (Ind:Integer):Pointer; function GetCount :integer; public constructor Create; destructor Destroy; override; procedure Clear; procedure Add (Pntr:Pointer); property Count:Integer read GetCount; property Pointer[Ind:Integer]:Pointer read GetPointer; default; property OnFreeItem:TPListFreeItemNotify read FOnFreeItem write FOnFreeItem; end; TMixerControls=class(TObject) private heap:pointer; FControls:TPointerList; protected function GetControl (Ind:Integer):PMixerControl; function GetCount:Integer; public constructor Create (AMixer:TAudioMixer;AData:TMixerLine); destructor Destroy; override; property Control[Ind:Integer]:PMixerControl read GetControl; default; property Count:Integer read GetCount; end; TMixerConnection=class(TObject) private XMixer:TAudioMixer; FData:TMixerLine; FControls:TMixerControls; public constructor Create (AMixer:TAudioMixer;AData:TMixerLine); destructor Destroy; override; property Controls:TMixerControls read FControls; property Data:TMixerLine read FData; end; TMixerConnections=class(TObject) private XMixer:TAudioMixer; FConnections:TPointerList; protected procedure DoFreeItem (Pntr:Pointer); function GetConnection (Ind:Integer):TMixerConnection; function GetCount:Integer; public constructor Create (AMixer:TAudioMixer;AData:TMixerLine); destructor Destroy; override; property Connection[Ind:Integer]:TMixerConnection read GetConnection; default; property Count:Integer read GetCount; end; TMixerDestination=class(TObject) private XMixer:TAudioMixer; FData:TMixerLine; FControls:TMixerControls; FConnections:TMixerConnections; public constructor Create (AMixer:TAudioMixer;AData:TMixerLine); destructor Destroy; override; property Connections:TMixerConnections read FConnections; property Controls:TMixerControls read FControls; property Data:TMixerLine read FData; end; TMixerDestinations=class(TObject) private FDestinations:TPointerList; protected function GetDestination (Ind:Integer):TMixerDestination; procedure DoFreeItem (Pntr:Pointer); function GetCount:Integer; public constructor Create (AMixer:TAudioMixer); destructor Destroy; override; property Count:Integer read GetCount; property Destination[Ind:Integer]:TMixerDestination read GetDestination; default; end; TAudioMixer = class(TComponent) private XWndHandle:HWnd; FDestinations:TMixerDestinations; FMixersCount:Integer; FMixerHandle:HMixer; FMixerID:Integer; FMixerCaps:TMixerCaps; FOnLineChange:TMixerChange; FOnControlChange:TMixerChange; protected procedure SetMixerID (Value:Integer); procedure MixerCallBack (var Msg:TMessage); procedure CloseMixer; published constructor Create (AOwner:TComponent); override; destructor Destroy; override; property MixerID:Integer read FMixerID write SetMixerID; {Opened mixer - value must be in range 0..MixersCount-1 If no mixer is opened this value is -1} property OnLineChange:TMixerChange read FOnLineChange write FOnLineChange; property OnControlChange:TMixerChange read FOnControlChange write FOnControlChange; public function GetVolume (ADestination,AConnection:Integer;var LeftVol,RightVol,Mute:Integer;var VolDisabled,MuteDisabled:Boolean):Boolean; {This function return volume of selected Destination and Connection. ADestination must be from range 0..Destinations.Count-1 AConnection must be in range 0..Destinations[ADestination].Connections.Count-1 If you want to read master volume of some Destination, you have to set AConnection to -1. If LeftVol, RightVol or Mute is not supported by queried connection, it's return value will be -1. LeftVol and RightVol are in range 0..65536 If Mute is non-zero then the connection is silent. If specified line is recording source then Mute specifies if programs will record from this connection (it is copy of "Select" Checkbox in standard Windows Volume Control program) VolDisabled or MuteDisabled is True when you cannot apply settings to this control (but can read it). Return value of the function is True if no error has occured, otherwise it returns False.} function SetVolume (ADestination,AConnection:Integer;LeftVol,RightVol,Mute:Integer):Boolean; {This function sets volume. If you set RightVol to -1 and connection is stereo then LeftVol will be copied to RightVol. If LeftVol or Mute is -1 then this value will not be set. Return value is True if ADestination and AConnection ar correct, otherwise False.} property Destinations:TMixerDestinations read FDestinations; {Ind must be in range 0..DestinationsCount-1} property MixerCaps:TMixerCaps read FMixerCaps; property MixerCount:Integer read FMixersCount; {Number of mixers present in system; mostly 1} property MixerHandle:HMixer read FMixerHandle; {Handle of opened mixer} end; procedure Register; implementation {------------} {TPointerList} {------------} constructor TPointerList.Create; begin items:=tlist.create; end; destructor TPointerList.Destroy; begin Clear; items.destroy; end; procedure TPointerList.Add (Pntr:Pointer); begin items.add(Pntr); end; function TPointerList.GetPointer (Ind:Integer):Pointer; begin result:=items[Ind]; end; procedure TPointerList.Clear; var i:integer; begin for i:=0 to items.count-1 do begin If Assigned (FOnFreeItem) then FOnFreeItem (items[i]) end; items.clear; end; function TPointerList.GetCount:Integer; begin result:=items.count; end; {--------------} {TMixerControls} {--------------} constructor TMixerControls.Create (AMixer:TAudioMixer;AData:TMixerLine); var MLC:TMixerLineControls; A,B:Integer; P:PMixerControl; begin FControls:=TPointerList.Create; MLC.cbStruct:=SizeOf(MLC); MLC.dwLineID:=AData.dwLineID; MLC.cControls:=AData.cControls; MLC.cbmxctrl:=SizeOf(TMixerControl); GetMem (P,SizeOf(TMixerControl)*AData.cControls); heap:=P; MLC.pamxctrl:=P; A:=MixerGetLineControls(AMixer.MixerHandle,@MLC, MIXER_GETLINECONTROLSF_ALL); If A=MMSYSERR_NOERROR then begin For B:=0 to AData.cControls-1 do begin FControls.Add (P); Inc (P); end; end; end; destructor TMixerControls.Destroy; begin FControls.free; freemem(heap); inherited; end; function TMixerControls.GetControl (Ind:Integer):PMixerControl; begin Result:=FControls.Pointer[Ind]; end; function TMixerControls.GetCount:Integer; begin Result:=FControls.Count; end; {----------------} {TMixerConnection} {----------------} constructor TMixerConnection.Create (AMixer:TAudioMixer;AData:TMixerLine); begin FData:=AData; XMixer:=AMixer; FControls:=TMixerControls.Create (AMixer,AData); end; destructor TMixerConnection.Destroy; begin FControls.Free; inherited; end; {-----------------} {TMixerConnections} {-----------------} constructor TMixerConnections.Create (AMixer:TAudioMixer;AData:TMixerLine); var A,B:Integer; ML:TMixerLine; begin XMixer:=AMixer; FConnections:=TPointerList.Create; FConnections.OnFreeItem:=Dofreeitem; ML.cbStruct:=SizeOf(TMixerLine); ML.dwDestination:=AData.dwDestination; For A:=0 to AData.cConnections-1 do begin ML.dwSource:=A; B:=MixerGetLineInfo (AMixer.MixerHandle,@ML,MIXER_GETLINEINFOF_SOURCE); If B=MMSYSERR_NOERROR then FConnections.Add(Pointer(TMixerConnection.Create (XMixer,ML))); end; end; destructor TMixerConnections.Destroy; begin FConnections.Free; inherited; end; procedure TMixerConnections.DoFreeItem (Pntr:Pointer); begin TMixerConnection(Pntr).Free; end; function TMixerConnections.GetConnection (Ind:Integer):TMixerConnection; begin Result:=FConnections.Pointer[Ind]; end; function TMixerConnections.GetCount:Integer; begin Result:=FConnections.Count; end; {-----------------} {TMixerDestination} {-----------------} constructor TMixerDestination.Create (AMixer:TAudioMixer;AData:TMixerLine); begin FData:=AData; XMixer:=AMixer; FConnections:=TMixerConnections.Create (XMixer,FData); FControls:=TMixerControls.Create (XMixer,AData); end; destructor TMixerDestination.Destroy; begin Fcontrols.free; FConnections.Free; inherited; end; {------------------} {TMixerDestinations} {------------------} constructor TMixerDestinations.Create (AMixer:TAudioMixer); var A,B:Integer; ML:TMixerLine; begin FDestinations:=TPointerList.Create; FDestinations.OnFreeItem:=DoFreeItem; For A:=0 to AMixer.MixerCaps.cDestinations-1 do begin ML.cbStruct:=SizeOf(TMixerLine); ML.dwDestination:=A; B:=MixerGetLineInfo (AMixer.MixerHandle,@ML,MIXER_GETLINEINFOF_DESTINATION); If B=MMSYSERR_NOERROR then FDestinations.Add(Pointer(TMixerDestination.Create (AMixer,ML))); end; end; procedure TMixerDestinations.DoFreeItem (Pntr:Pointer); begin TMixerDestination(Pntr).Free; end; destructor TMixerDestinations.Destroy; begin FDestinations.Free; inherited; end; function TMixerDestinations.GetDestination (Ind:Integer):TMixerDestination; begin Result:=FDestinations.Pointer[Ind]; end; function TMixerDestinations.GetCount:Integer; begin Result:=FDestinations.Count; end; {-----------} {TAudioMixer} {-----------} constructor TAudioMixer.Create (AOwner:TComponent); begin inherited Create (AOwner); FDestinations:=nil; XWndHandle:=AllocateHWnd (MixerCallBack); FMixersCount:=mixerGetNumDevs; FMixerID:=-1; If FMixersCount>0 then SetMixerID (0); end; destructor TAudioMixer.Destroy; begin closemixer; if XWndHandle<>0 then DeAllocateHwnd(XWndHandle); inherited; end; procedure TAudioMixer.CloseMixer; begin If FMixerID>=0 then begin mixerClose (FMixerHandle); FMixerID:=-1; end; FDestinations.Free; FDestinations:=nil; end; procedure TAudioMixer.SetMixerID (Value:Integer); begin If Value>=FMixersCount then Exit; CloseMixer; If Value>=0 then If mixerOpen (@FMixerHandle,Value,XWndHandle,0,CALLBACK_WINDOW OR MIXER_OBJECTF_MIXER)=MMSYSERR_NOERROR then begin FMixerID:=Value; mixerGetDevCaps (MixerID,@FMixerCaps,SizeOf (TMixerCaps)); FDestinations:=TMixerDestinations.Create (Self); end; end; procedure TAudioMixer.MixerCallBack (var Msg:TMessage); begin case Msg.Msg of MM_MIXM_LINE_CHANGE: If Assigned (OnLineChange) then OnLineChange (Self,Msg.wParam,Msg.lParam); MM_MIXM_CONTROL_CHANGE: If Assigned (OnControlChange) then OnControlChange (Self,Msg.wParam,Msg.lParam); end; end; function TAudioMixer.GetVolume (ADestination,AConnection:Integer;var LeftVol,RightVol,Mute:Integer;var VolDisabled,MuteDisabled:Boolean):Boolean; var MD:TMixerDestination; MC:TMixerConnection; Cntrls:TMixerControls; MCD:TMixerControlDetails; Cntrl:PMixerControl; A,B:Integer; ML:TMixerLine; details:array [0..30] of Integer; begin Result:=False; MD:=Destinations[ADestination]; If MD<>nil then begin If AConnection=-1 then begin Cntrls:=MD.Controls; ML:=MD.Data; end else begin MC:=MD.Connections[AConnection]; If MC<>nil then begin Cntrls:=MC.Controls; ML:=MC.Data; end else Cntrls:=nil; end; If Cntrls<>nil then begin A:=0; Result:=True; LeftVol:=-1; RightVol:=-1; Mute:=-1; while ((LeftVol=-1) OR (Mute=-1)) AND (Anil then begin If ((Cntrl.dwControlType=MIXERCONTROL_CONTROLTYPE_VOLUME) OR (Cntrl.dwControlType=MIXERCONTROL_CONTROLTYPE_MUTE)) AND (Cntrl.fdwControl AND MIXERCONTROL_CONTROLF_MULTIPLE<>MIXERCONTROL_CONTROLF_MULTIPLE) then begin MCD.cbStruct:=SizeOf(TMixerControlDetails); MCD.dwControlID:=Cntrl.dwControlID; If Cntrl.fdwControl AND MIXERCONTROL_CONTROLF_UNIFORM>0 then MCD.cChannels:=1 else MCD.cChannels:=ML.cChannels; MCD.cMultipleItems:=0; MCD.cbDetails:=SizeOf(Integer); MCD.paDetails:=@details; B:=mixerGetControlDetails (FMixerHandle,@MCD,MIXER_GETCONTROLDETAILSF_VALUE); If B=MMSYSERR_NOERROR then begin If (Cntrl.dwControlType=MIXERCONTROL_CONTROLTYPE_VOLUME) AND (LeftVol=-1) then begin VolDisabled:=Cntrl.fdwControl AND MIXERCONTROL_CONTROLF_DISABLED>0; If not VolDisabled then begin LeftVol:=details[0]; If MCD.cChannels>1 then RightVol:=Details[1]; end; end else If (Cntrl.dwControlType=MIXERCONTROL_CONTROLTYPE_MUTE) AND (Mute=-1) then begin MuteDisabled:=Cntrl.fdwControl AND MIXERCONTROL_CONTROLF_DISABLED>0; If not MuteDisabled then begin If Details[0]<>0 then Mute:=1 else Mute:=0; end; end; end; end; end; Inc (A); end; If Mute=-1 then begin If AConnection<>-1 then begin Cntrls:=MD.Controls; ML:=MD.Data; If Cntrls<>nil then begin A:=0; while (Mute=-1) AND (A0 then MCD.cChannels:=1 else MCD.cChannels:=ML.cChannels; If Cntrl.fdwControl AND MIXERCONTROL_CONTROLF_MULTIPLE=MIXERCONTROL_CONTROLF_MULTIPLE then MCD.cMultipleItems:=Cntrl.cMultipleItems else MCD.cMultipleItems:=0; MCD.cbDetails:=4; MCD.paDetails:=@Details; B:=mixerGetControlDetails (FMixerHandle,@MCD,MIXER_GETCONTROLDETAILSF_VALUE); If B=MMSYSERR_NOERROR then Mute:=Details[AConnection]; end; Inc (A); end; end; end; end; If LeftVol=-1 then VoldIsabled:=True; If Mute=-1 then MuteDisabled:=True; end; end; end; function TAudioMixer.SetVolume (ADestination,AConnection:Integer;LeftVol,RightVol,Mute:Integer):Boolean; var MD:TMixerDestination; MC:TMixerConnection; Cntrls:TMixerControls; MCD:TMixerControlDetails; Cntrl:PMixerControl; A,B:Integer; ML:TMixerLine; details:array [0..30] of Integer; VolSet,MuteSet:Boolean; begin Result:=False; MD:=Destinations[ADestination]; If MD<>nil then begin If AConnection=-1 then begin Cntrls:=MD.Controls; ML:=MD.Data; end else begin MC:=MD.Connections[AConnection]; If MC<>nil then begin Cntrls:=MC.Controls; ML:=MC.Data; end else Cntrls:=nil; end; If Cntrls<>nil then begin A:=0; VolSet:=LeftVol=-1; MuteSet:=Mute=-1; Result:=True; while (not VolSet OR not MuteSet) AND (Anil then begin If ((Cntrl.dwControlType=MIXERCONTROL_CONTROLTYPE_VOLUME) OR (Cntrl.dwControlType=MIXERCONTROL_CONTROLTYPE_MUTE)) AND (Cntrl.fdwControl AND MIXERCONTROL_CONTROLF_MULTIPLE<>MIXERCONTROL_CONTROLF_MULTIPLE) then begin MCD.cbStruct:=SizeOf(TMixerControlDetails); MCD.dwControlID:=Cntrl.dwControlID; If Cntrl.fdwControl AND MIXERCONTROL_CONTROLF_UNIFORM>0 then MCD.cChannels:=1 else MCD.cChannels:=ML.cChannels; MCD.cMultipleItems:=0; MCD.cbDetails:=SizeOf(Integer); MCD.paDetails:=@Details; If (Cntrl.dwControlType=MIXERCONTROL_CONTROLTYPE_VOLUME) AND not VolSet then begin Details[0]:=LeftVol; If RightVol=-1 then Details[1]:=LeftVol else Details[1]:=RightVol; VolSet:=True; end else If (Cntrl.dwControlType=MIXERCONTROL_CONTROLTYPE_MUTE) AND not MuteSet then begin Details[0]:=Mute; MuteSet:=True; end; mixerSetControlDetails (FMixerHandle,@MCD,MIXER_GETCONTROLDETAILSF_VALUE); end; end; Inc (A); end; If not MuteSet then begin If AConnection<>-1 then begin Cntrls:=MD.Controls; ML:=MD.Data; If Cntrls<>nil then begin A:=0; while not MuteSet AND (A0 then MCD.cChannels:=1 else MCD.cChannels:=ML.cChannels; If Cntrl.fdwControl AND MIXERCONTROL_CONTROLF_MULTIPLE=MIXERCONTROL_CONTROLF_MULTIPLE then MCD.cMultipleItems:=Cntrl.cMultipleItems else MCD.cMultipleItems:=0; MCD.cbDetails:=4; MCD.paDetails:=@Details; MuteSet:=True; mixerGetControlDetails (FMixerHandle,@MCD,MIXER_GETCONTROLDETAILSF_VALUE); For B:=0 to Cntrl.cMultipleItems-1 do Details[B]:=0; Details[AConnection]:=Mute; mixerSetControlDetails (FMixerHandle,@MCD,MIXER_GETCONTROLDETAILSF_VALUE); end; Inc (A); end; end; end; end; end; end; end; procedure Register; begin RegisterComponents('Samples', [TAudioMixer]); end; end.