mmmixer.pas

一套及时通讯的原码

   for Result:= Low(TMMControlClass) to High(TMMControlClass) do
   if (CT and MIXERCONTROL_CT_CLASS_MASK) = CClasses[Result] then
       Exit;
   { TODO: Should be resource id }
   raise EMMMixerServiceError.Create('Undefined API control class');
end;

{------------------------------------------------------------------------}
function IsControlTypeSingleSelect(CT: DWORD): Boolean;
begin
    Result := MIXERCONTROL_CT_SC_LIST_SINGLE =
              (MIXERCONTROL_CT_SUBCLASS_MASK and CT);
end;

{== TMMMixerDevice ======================================================}
constructor TMMMixerDevice.Create(AOwner: TComponent);
begin
   inherited Create(AOwner);

   FObserver          := TMMObserver.Create;
   FObserver.OnNotify := DeviceNotify;
   FObservable        := TMMObservable.Create;
   DeviceType         := dtMixer;
end;

{-- TMMMixerDevice ------------------------------------------------------}
destructor TMMMixerDevice.Destroy;
begin
   Device := nil;
   FObserver.Free;
   FObservable.Free;

   inherited Destroy;
end;

{-- TMMMixerDevice ------------------------------------------------------}
procedure TMMMixerDevice.SetDevice(Value: TMMCustomAudioDevice);
var
    WasActive: Boolean;
begin
   if (Value <> nil) then
      if (Value.GetDeviceType = dtMixer) then
         { TODO: Should be resource id }
         raise EMMMixerDeviceError.Create('Mixer can''t reference mixer');

   if (Value <> FDevice) then
   begin
      WasActive:= Active;
      Close;
      if (FDevice <> nil) then
          FDevice.RemoveObserver(FObserver);
      FDevice:= Value;
      if (FDevice <> nil) then
      begin
         FDevice.AddObserver(FObserver);
         FDevice.FreeNotification(Self);
      end;
      UpdateDevice;
      Active:= WasActive;
   end;
end;

{-- TMMMixerDevice ------------------------------------------------------}
procedure TMMMixerDevice.DeviceNotify(Sender, Data: TObject);
begin
   UpdateDevice;
end;

{-- TMMMixerDevice ------------------------------------------------------}
procedure TMMMixerDevice.Notification(AComponent: TComponent; Operation: TOperation);
begin
   inherited Notification(AComponent,Operation);

   if (Operation = opRemove) and (AComponent = FDevice) then
       Device := nil;
end;

{-- TMMMixerDevice ------------------------------------------------------}
procedure TMMMixerDevice.UpdateDevice;
begin
   if (FDevice <> nil) then
       DeviceId:= FDevice.MixerId;

   inherited UpdateDevice;
end;

{-- TMMMixerDevice ------------------------------------------------------}
procedure TMMMixerDevice.Changed;
var
   UpdChange: TMMDeviceChange;
begin
   UpdChange:= TMMDeviceChange.Create;
   try
      FObservable.NotifyObservers(UpdChange);
   finally
      UpdChange.Free;
   end;
   inherited;
end;

{-- TMMMixerDevice ------------------------------------------------------}
function TMMMixerDevice.StoreDeviceId: Boolean;
begin
   if (FDevice <> nil) then
       Result := FDevice.MixerId <> MixerId
   else
       Result := DeviceId <> 0;
end;

{-- TMMMixerDevice ------------------------------------------------------}
function TMMMixerDevice.GetDestinations: TMMLineIndex;
var
   Caps: TMixerCaps;
begin
   if ValidDevice then
   begin
      Check(mixerGetDevCaps(DeviceId, @Caps, SizeOf(Caps)));
      Result:= Caps.cDestinations;
   end
   else Result := 0;
end;

{-- TMMMixerDevice ------------------------------------------------------}
procedure   TMMMixerDevice.Open;
begin
   if ValidDevice then
   begin
      FCBWnd:= AllocateHWnd(MixerWndProc);
      try
         Check(mixerOpen(@FHandle,DeviceId,FCBWnd,0,CALLBACK_WINDOW or MIXER_OBJECTF_MIXER));
         inherited Open;

      except
         DeAllocateHWnd(FCBWnd);
         FCBWnd:= 0;
      end
   end
   else
      { TODO: Should be resource id }
      raise EMMMixerDeviceError.Create('Device not valid');
end;

{-- TMMMixerDevice ------------------------------------------------------}
procedure TMMMixerDevice.Close;
begin
   if FHandle <> 0 then
   begin
      Check(mixerClose(FHandle));
      FHandle:= 0;
   end;

   if FCBWnd <> 0 then
   begin
      DeAllocateHWnd(FCBWnd);
      FCBWnd:= 0;
   end;

   inherited Close;
end;

{-- TMMMixerDevice ------------------------------------------------------}
procedure TMMMixerDevice.MixerWndProc(var Msg: TMessage);
begin
   with Msg do
   begin
      try
         if (Msg = MM_MIXM_LINE_CHANGE) and (wParam = FHandle) then
             LineChanged(lParam)
         else if (Msg = MM_MIXM_CONTROL_CHANGE) and (wParam = FHandle) then
             ControlChanged(lParam)
         else
             Result:= DefWindowProc(FCBWnd, Msg, wParam, lParam);
      except
         Application.HandleException(Self);
      end;
   end;
end;

{-- TMMMixerDevice ------------------------------------------------------}
procedure TMMMixerDevice.LineChanged(LineId: TMMLineId);
var
    Chg: TMMLineChange;
begin
   Chg:= TMMLineChange.Create;
   try
      Chg.LineId := LineId;
      FObservable.NotifyObservers(Chg);
   finally
      Chg.Free;
   end;
   DoLineChange(LineId);
end;

{-- TMMMixerDevice ------------------------------------------------------}
procedure TMMMixerDevice.ControlChanged(CtlId: TMMControlId);
var
    Chg   : TMMControlChange;
    LineId: TMMLineId;
begin
   LineId := GetLineOfControl(CtlId);

   Chg := TMMControlChange.Create;
   try
      Chg.ControlId:= CtlId;
      Chg.LineId   := LineId;
      FObservable.NotifyObservers(Chg);
   finally
      Chg.Free;
   end;
   DoControlChange(LineId,CtlId);
end;

{-- TMMMixerDevice ------------------------------------------------------}
procedure TMMMixerDevice.DoLineChange(LineId: TMMLineId);
begin
   if Assigned(FOnLineChange) then FOnLineChange(Self,LineId);
end;

{-- TMMMixerDevice ------------------------------------------------------}
procedure TMMMixerDevice.DoControlChange(LineId: TMMLineId; CtlId: TMMControlId);
begin
   if Assigned(FOnControlChange) then FOnControlChange(Self,LineId,CtlId);
end;

{-- TMMMixerDevice ------------------------------------------------------}
function TMMMixerDevice.GetMixerId: TMMDeviceId;
var
   Res: UINT;

begin
   if FHandle <> 0 then
   begin
      Check(mixerGetId(FHandle, Res, MIXER_OBJECTF_HMIXER));
      Result := Res;
      { If device id was changed, FHandle will be still correct but }
      { we should check for id }
      if (Result <> DeviceId) then
      begin
         { Just update class member }
         SetDeviceIdDirect(Result);
         { Notify updates }
         Changed;
      end;
   end
   else Result := DeviceId;
end;

{-- TMMMixerDevice ------------------------------------------------------}
procedure TMMMixerDevice.AddObserver(O: TMMObserver);
begin
   FObservable.AddObserver(O);
end;

{-- TMMMixerDevice ------------------------------------------------------}
procedure TMMMixerDevice.RemoveObserver(O: TMMObserver);
begin
   if (FObservable <> nil) then
       FObservable.RemoveObserver(O);
end;

{-- TMMMixerDevice ------------------------------------------------------}
function TMMMixerDevice.GetLineOfControl(CtlId: TMMControlId): TMMLineId;
var
   Ctls: TMixerLineControls;
   Ctl : TMixerControl;
begin
   { We should do this call manually instead of use GetControlInfoById
     because we need to access dwLineId member of TMixerLineControls record }
   Ctls.cbStruct      := SizeOf(Ctls);
   Ctls.dwControlId   := CtlId;
   Ctls.cControls     := 1;
   Ctls.cbmxCtrl      := sizeof(TMixerControl);
   Ctls.pamxCtrl      := @Ctl;
   Check(mixerGetLineControls(MixerId, @Ctls, MIXER_GETLINECONTROLSF_ONEBYID or MIXER_OBJECTF_MIXER));
   Result             := Ctls.dwLineId;
end;

{-- TMMMixerDevice ------------------------------------------------------}
function TMMMixerDevice.GetLineInfoById(LineId: TMMLineId; var Info: TMixerLine): Boolean;
begin
   Info.dwLineId := LineId;
   Result        := GetLineInfo(Info,MIXER_GETLINEINFOF_LINEID);
end;

{-- TMMMixerDevice ------------------------------------------------------}
function TMMMixerDevice.GetLineInfoByCompType(CompType: TMMComponentType; var Info: TMixerLine): Boolean;
begin
   Info.dwComponentType:= CompTypeToAPI(CompType);
   Result              := GetLineInfo(Info,MIXER_GETLINEINFOF_COMPONENTTYPE);
end;

{-- TMMMixerDevice ------------------------------------------------------}
function TMMMixerDevice.GetLineInfoByDestination(Dest: TMMLineIndex; var Info: TMixerLine): Boolean;
begin
   Info.dwDestination := Dest;
   Result             := GetLineInfo(Info,MIXER_GETLINEINFOF_DESTINATION);
end;

{-- TMMMixerDevice ------------------------------------------------------}
function TMMMixerDevice.GetLineInfoBySource(Dest, Src: TMMLineIndex; var Info: TMixerLine): Boolean;
begin
   Info.dwDestination := Dest;
   Info.dwSource      := Src;
   Result             := GetLineInfo(Info,MIXER_GETLINEINFOF_SOURCE);
end;

{-- TMMMixerDevice ------------------------------------------------------}
function TMMMixerDevice.GetLineInfo(var Info: TMixerLine; Flags: DWORD): Boolean;
begin
   Info.cbStruct:= SizeOf(Info);
   Result:= CheckExcl(mixerGetLineInfo(MixerId, @Info, MIXER_OBJECTF_MIXER or Flags), [MIXERR_INVALLINE,MMSYSERR_NODRIVER,MMSYSERR_INVALPARAM])
            = MMSYSERR_NOERROR;
end;

{-- TMMMixerDevice ------------------------------------------------------}
function TMMMixerDevice.GetLineInfoByTarget(Device: TMMCustomAudioDevice; var Info: TMixerLine): Boolean;
begin
   with Device.DeviceCaps do
   begin
      Info.Target.dwType         := DeviceTypeToTarget(Device.GetDeviceType);
      Info.Target.wMid           := ManufacturerId;
      Info.Target.wPid           := ProductId;
      Info.Target.vDriverVersion := MakeVersion(VerMajor,VerMinor);
      StrPLCopy(Info.Target.szPName, ProductName, MAXPNAMELEN);
      Result:= GetLineInfo(Info, MIXER_GETLINEINFOF_TARGETTYPE);
   end;
end;

{-- TMMMixerDevice ------------------------------------------------------}
function TMMMixerDevice.GetControlInfoById(ControlId: TMMControlId; var Info: TMixerControl): Boolean;
var
    Ctls: TMixerLineControls;
begin
   Ctls.dwControlId:= ControlId;
   Ctls.cControls  := 1;
   Ctls.cbmxCtrl   := SizeOf(Info);
   Ctls.pamxCtrl   := @Info;
   Result:= GetControlInfo(Ctls, MIXER_GETLINECONTROLSF_ONEBYID);
end;

{-- TMMMixerDevice ------------------------------------------------------}
function TMMMixerDevice.GetControlInfoByType(LineId: TMMLineId; ControlType: TMMControlType; var Info: TMixerControl): Boolean;
var
    Ctls: TMixerLineControls;
begin
   Ctls.dwLineId      := LineId;
   Ctls.dwControlType := ControlTypeToAPI(ControlType);
   Ctls.cControls     := 1;
   Ctls.cbmxCtrl      := SizeOf(Info);
   Ctls.pamxCtrl      := @Info;
   Result:= GetControlInfo(Ctls, MIXER_GETLINECONTROLSF_ONEBYTYPE);
end;

{-- TMMMixerDevice ------------------------------------------------------}
procedure TMMMixerDevice.GetAllControls(LineId: TMMLineId; Controls: TMMControlIndex; P: PMixerControl);
var
   Ctls: TMixerLineControls;
begin
   Ctls.dwLineId      := LineId;
   Ctls.cControls     := Controls;
   Ctls.cbmxCtrl      := SizeOf(P^);
   Ctls.pamxCtrl      := PMixerControlA(P);

   if not GetControlInfo(Ctls, MIXER_GETLINECONTROLSF_ALL) then
      { TODO: Should be resource id }