mmmixer.pas

一套及时通讯的原码

{-- TMMAudioLine --------------------------------------------------------}
function TMMAudioLine.GetConnections: TMMConnectionIndex;
begin
   Result := LineInfo.Connections;
end;

{-- TMMAudioLine --------------------------------------------------------}
function TMMAudioLine.GetConnection(Index: TMMConnectionIndex): TMMLineId;
var
    Info: TMixerLine;
begin
   if not InRange(Index, 0, Connections - 1) then
      { TODO: Should be resource id }
      raise EMMAudioLineError.Create('Connection index out of range');

   if ValidMixer then
   begin
      if Mixer.GetLineInfoBySource(FDestinationId, Index, Info) then
      begin
         Result:= Info.dwLineId;
         Exit;
      end;
   end;
   Result:= badLineId;
end;

{-- TMMAudioLine --------------------------------------------------------}
function TMMAudioLine.GetControls: TMMControlIndex;
begin
   Result := LineInfo.Controls;
end;

{-- TMMAudioLine --------------------------------------------------------}
function TMMAudioLine.GetControl(Index: TMMControlIndex): TMMControlId;
var
    P, R: PMixerControl;
    Size: Integer;
begin
   if not InRange(Index, 0, Controls - 1) then
      { TODO: Should be resource id }
      raise EMMAudioLineError.Create('Control index out of range');

   if not ValidMixer then
   begin
      Result:= badControlId;
      Exit;
   end;
   Size:= SizeOf(P^)*Controls;
   GetMem(P,Size);
   try
      Mixer.GetAllControls(LineId,Controls,P);
      R:= P;
      Inc(R,Index);
      Result:= R^.dwControlId;
   finally
      FreeMem(P,Size);
   end;
end;

{-- TMMAudioLine --------------------------------------------------------}
function TMMAudioLine.ValidMixer: Boolean;
begin
   Result:= (FMixer <> nil) and FMixer.ValidDevice;
end;

{-- TMMAudioLine --------------------------------------------------------}
procedure TMMAudioLine.UpdateLine;
var
    LineInfo: TMixerLine;
    Ok: Boolean;
begin
   if csLoading in ComponentState then
      Exit;

   FDestinationId:= badLineId;
   Ok := False;
   if ValidMixer then
   begin
      if FDestLine <> nil then
        if FDestLine.Mixer = Mixer then
            Ok := FDestLine.GetLineInfoForSource(Self,LineInfo)
        else
            Ok := False
      else
      case FLineSetup of
        lsLineId   : Ok:= (FLineId <> badLineId) and Mixer.GetLineInfoById(FLineId, LineInfo);
        lsCompType : Ok:= Mixer.GetLineInfoByCompType(FComponentType, LineInfo);
        lsTarget   : Ok:= Mixer.GetLineInfoByTarget(FTarget, LineInfo);
      end;

      if Ok then
      begin
         FLineId        := LineInfo.dwLineId;
         FComponentType := APIToCompType(LineInfo.dwComponentType);
         with FLineInfo do
         begin
            FFlags         := APIToLineFlags(LineInfo.fdwLine);
            FChannels      := LineInfo.cChannels;
            FConnections   := LineInfo.cConnections;
            FControls      := LineInfo.cControls;
            if not (cfSource in FFlags) then
               FDestinationId := LineInfo.dwDestination
            else
               FDestinationId := badLineId;

            FShortName     := LineInfo.szShortName;
            FName          := LineInfo.szName;
         end;
      end
      else
      begin
         FLineId := badLineId;
         FLineInfo.Clear;
      end;
   end;
   LineIdChanged;
end;

{-- TMMAudioLine --------------------------------------------------------}
procedure TMMAudioLine.Loaded;
begin
   inherited Loaded;

   UpdateLine;
end;

{-- TMMAudioLine --------------------------------------------------------}
procedure TMMAudioLine.MixerNotify(Sender, Data: TObject);
begin
   if Data is TMMLineChange then
   begin
      if (Data as TMMLineChange).LineId = FLineId then
          Changed;
   end
   else if Data is TMMControlChange then
   begin
      if (Data as TMMControlChange).LineId = FLineId then
          ControlChanged((Data as TMMControlChange).ControlId)
   end
   else if Data is TMMDeviceChange then
   begin
      UpdateLine;
   end;
end;

{-- TMMAudioLine --------------------------------------------------------}
procedure TMMAudioLine.TargetNotify(Sender, Data: TObject);
begin
   UpdateLine;
end;

{-- TMMAudioLine --------------------------------------------------------}
procedure TMMAudioLine.DestNotify(Sender, Data: TObject);
begin
    if (Data <> nil) and (Data is TMMLineIdChange) then
        UpdateLine;
end;

{-- TMMAudioLine --------------------------------------------------------}
procedure TMMAudioLine.SetDestLine(Value: TMMComponent1);
begin
    if (Value <> nil) and not (Value is TMMAudioLine) then
        { TODO: Should be resource id }
        raise EMMMixerDeviceError.Create('DestLine should be TMMAudioLine');

    if FDestLine <> Value then
    begin
        if FDestLine <> nil then
            FDestLine.RemoveObserver(FDestObserver);

        FDestLine := Value as TMMAudioLine;

        if FDestLine <> nil then
        begin
            FDestLine.AddObserver(FTargetObserver);
            FDestLine.FreeNotification(Self);
        end;
        UpdateLine;
    end;
end;

{-- TMMAudioLine --------------------------------------------------------}
function  TMMAudioLine.GetDestLine: TMMComponent1;
begin
    Result := FDestLine;
end;

{-- TMMAudioLine --------------------------------------------------------}
procedure TMMAudioLine.Changed;
var
    Chg: TMMLineChange;
begin
   Chg:= TMMLineChange.Create;
   try
      Chg.LineId:= LineId;
      FObservable.NotifyObservers(Chg);
   finally
      Chg.Free;
   end;
   DoChange;
end;

{-- TMMAudioLine --------------------------------------------------------}
procedure TMMAudioLine.LineIdChanged;
var
    Chg: TMMLineIdChange;
begin
   Chg:= TMMLineIdChange.Create;
   try
      FObservable.NotifyObservers(Chg);
   finally
      Chg.Free;
   end;
end;

{-- TMMAudioLine --------------------------------------------------------}
procedure TMMAudioLine.DoChange;
begin
   if Assigned(FOnChange) then FOnChange(Self);
end;

{-- TMMAudioLine --------------------------------------------------------}
procedure TMMAudioLine.ControlChanged(CtlId: TMMControlId);
var
    Chg: TMMControlChange;
begin
   Chg:= TMMControlChange.Create;
   try
      Chg.LineId     := LineId;
      Chg.ControlId  := CtlId;
      FObservable.NotifyObservers(Chg);
   finally
      Chg.Free;
   end;
   DoControlChange(CtlId);
end;

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

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

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

{-- TMMAudioLine --------------------------------------------------------}
function  TMMAudioLine.GetLineInfoForSource(Source: TMMAudioLine; var Info : TMixerLine): Boolean;
var
   i : Integer;
   Ok: Boolean;

   function CompTypeOk: Boolean;
   begin
    Result := APIToCompType(Info.dwComponentType) = Source.FComponentType;
   end;

   function TargetOk: Boolean;
   begin
    if Source.Target <> nil then
       with Source.Target.DeviceCaps do
       begin
          Result := (Info.Target.dwType = DeviceTypeToTarget(Source.Target.GetDeviceType)) and
                    (Info.Target.wMid = ManufacturerId) and
                    (Info.Target.wPid = ProductId) and
                    (Info.Target.vDriverVersion = MakeVersion(VerMajor,VerMinor)) and
                    (StrComp(Info.Target.szPName, PChar(ProductName)) = 0);
        end
    else
        Result := False;
   end;
begin
   Result := False;
   Ok     := False;

   if csLoading in ComponentState then
      Exit;

   if ValidMixer and
      (LineId <> badLineId) and
      not (cfSource in LineInfo.Flags) then
   begin
      case Source.FLineSetup of
        lsLineId   : Ok:= (Source.FLineId <> badLineId) and Mixer.GetLineInfoById(Source.FLineId, Info);
        lsCompType : Ok:= Mixer.GetLineInfoByCompType(Source.FComponentType, Info);
        lsTarget   : Ok:= Mixer.GetLineInfoByTarget(Source.FTarget, Info);
      end;

      if not Ok then
        Exit;

      if Info.dwDestination = LineId then
      begin
        Result := True;
        Exit;
      end;

      if Source.FLineSetup = lsLineId then
        Exit;

      for i := 0 to Connections - 1 do
        if Mixer.GetLineInfoBySource(FDestinationId, i, Info) then
            if ((Source.FLineSetup = lsCompType) and CompTypeOk) or
               ((Source.FLineSetup = lsTarget) and TargetOk) then begin
                Result := True;
                Exit;
            end;
   end;
end;

{== TMMControlInfo ======================================================}
procedure TMMControlInfo.SetDummyStr(const Value: string);
begin
  ;
end;

{-- TMMControlInfo ------------------------------------------------------}
procedure TMMControlInfo.Clear;
begin
   FFlags         := [];
   FMultipleItems := 0;
   FShortName     := '';
   FName          := '';
   FMinValue      := 0;
   FMaxValue      := 0;
   FSteps         := 0;
end;

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

   FControlInfo       := TMMControlInfo.Create;
   FControlId         := badControlId;
   FObserver          := TMMObserver.Create;
   FObserver.OnNotify := LineNotify;
   FObservable        := TMMObservable.Create;
end;

{-- TMMCustomMixerControl -----------------------------------------------}
destructor TMMCustomMixerControl.Destroy;
begin
   FObserver.Free;
   FControlInfo.Free;
   FObservable.Free;
   FObservable:= nil;

   inherited Destroy;
end;

{-- TMMCustomMixerControl -----------------------------------------------}
procedur