balancer.pas

一个DSPack下的声道控制控件

unit Balancer;

interface
uses Classes, BaseClass, ActiveX, DirectShow9, MMSystem, Windows, DSUTil,
  DSPack;

const
  Name_Balancer = 'Audio Balancer by Style.Chen';
  CLSID_Balancer: TGUID = '{BD8A846D-95A3-4916-AFEC-951C6A469363}';
  IID_BalancerChannel: TGUID = '{01F2EFF9-722A-4D84-A93D-53CF6CD47384}';

type
  TAudioChannel = (acStereo, acLeft, acRight);

type

  IBalancerChannel = interface(IunKnown)
    ['{BF88E3D0-573E-4D9B-9794-FC18B93E346B}']
    function put_MediaType(mt: PAMMediaType): HRESULT; stdcall;
    function get_MediaType(out mt: TAMMediaType): HRESULT; stdcall;
    function get_IPin(out Pin: IPin): HRESULT; stdcall;
    function get_State(out State: TFilterState): HRESULT; stdcall;
    function SetAudioChannel(AudioChannel: TAudioChannel): HRESULT; stdcall;
  end;

const
  MEDIATYPE_Audio: TGUID = (D1: $73647561; D2: $0000; D3: $0010; D4: ($80, $00, $00, $AA, $00, $38, $9B, $71));
  MEDIASUBTYPE_PCM: TGUID = (D1: $00000001; D2: $0000; D3: $0010; D4: ($80, $00, $00, $AA, $00, $38, $9B, $71));

  SudPinTypes: TRegPinTypes =
  (clsMajorType: @MEDIATYPE_Audio;
    clsMinorType: @MEDIASUBTYPE_PCM);

  SudPins: array[0..1] of TRegFilterPins =
  ((strName: 'Input'; bRendered: FALSE; bOutput: FALSE; bZero: FALSE; bMany:
    FALSE; oFilter: nil; strConnectsToPin: 'Output'; nMediaTypes: 1;
    lpMediaType:
    @SudPinTypes),
    (strName: 'Output'; bRendered: FALSE; bOutput: TRUE; bZero: FALSE; bMany:
    FALSE; oFilter: nil; strConnectsToPin: 'Input'; nMediaTypes: 1; lpMediaType:
    @SudPinTypes));

type

  TBalancerInputPin = class(TBCTransInPlaceInputPin)
  public
    constructor Create(ObjectName: string; TransInPlaceFilter:
      TBCTransInPlaceFilter;
      out hr: HRESULT; Name: WideString);
    function CheckMediaType(mt: PAMMediaType): HRESULT; override;
  end;

  TBalancerOutputPin = class(TBCTransInPlaceOutputPin)
  public
    constructor Create(ObjectName: string; TransInPlaceFilter:
      TBCTransInPlaceFilter;
      out hr: HRESULT; Name: WideString);
    function CheckMediaType(mt: PAMMediaType): HRESULT; override;
  end;

var
  InstanceCount: integer = 0;

type

  TBalancerFilter = class(TBCTransInPlaceFilter, IBalancerChannel)
    FThisInstance: integer;
    FPreferred: TAMMediaType;
    FBalancerLock: TBCCritSec;
    FCurrentChannel: TAudioChannel;
  public
    function GetPin(n: integer): TBCBasePin; override;
    function CheckInputType(mtIn: PAMMediaType): HRESULT; override;
    function put_MediaType(mt: PAMMediaType): HRESULT; stdcall;
    function get_MediaType(out mt: TAMMediaType): HRESULT; stdcall;
    function get_IPin(out Pin: IPin): HRESULT; stdcall;
    function get_State(out State: TFilterState): HRESULT; stdcall;

    function GetPages(out pages: TCAGUID): HResult; stdcall;

    constructor Create(ObjName: string; unk: IUnKnown; out hr: HRESULT);
    constructor CreateFromFactory(Factory: TBCClassFactory; const Controller:
      IUnknown); override;
    destructor Destroy; override;

    function Transform(Sample: IMediaSample): HRESULT; override;
    function SetAudioChannel(AudioChannel: TAudioChannel): HRESULT; stdcall;
  end;

  TFilterGraph1 = class(TFilterGraph)
  end;

  TBalancer = class(TComponent, IFilter)
  private
    FFilterGraph: TFilterGraph1;
    FBaseFilter: TBalancerFilter;
    FFilter: IBaseFilter;
    FAudioChannel: TAudioChannel;
    function GetFilter: IBaseFilter;
    function GetName: string;
    procedure NotifyFilter(operation: TFilterOperation; Param: integer = 0);
    procedure SetFilterGraph(AFilterGraph: TFilterGraph1);
    procedure SetAudioChannel(AAudioChannel: TAudioChannel);
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation);
      override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function QueryInterface(const IID: TGUID; out Obj): HResult; override;
      stdcall;
  published
    property FilterGraph: TFilterGraph1 read FFilterGraph write SetFilterGraph;
    property AudioChannel: TAudioChannel read FAudioChannel write
      SetAudioChannel;
  end;

procedure Register;

implementation

function AudioChannelMix(PBuffer: PByte; Size: Integer;
  AudioChannel:
  TAudioChannel; AudioBits: Integer): HRESULT;
var
  i: Integer;
begin
  try
    if AudioBits = 8 then
    begin
      case AudioChannel of
        acLeft:
          begin
            for i := 0 to Size - 1 do
            begin
              if (i mod 2) = 0 then
              begin
                PByte(Integer(PBuffer) + i + 1)^ :=
                  PByte(Integer(PBuffer) +
                  i)^;
              end;
            end;
          end;
        acRight:
          begin
            for i := 0 to Size - 1 do
            begin
              if (i mod 2) = 0 then
              begin
                PByte(Integer(PBuffer) + i)^ :=
                  PByte(Integer(PBuffer) + i +
                  1)^;
              end;
            end;
          end;
      end;
    end;
    if AudioBits = 16 then
    begin
      case AudioChannel of
        acLeft:
          begin
            for i := 0 to Size - 1 do
            begin
              if (i mod 4) = 0 then
              begin
                PByte(Integer(PBuffer) + i + 2)^ :=
                  PByte(Integer(PBuffer) +
                  i)^;
                PByte(Integer(PBuffer) + i + 3)^ :=
                  PByte(Integer(PBuffer) + i +
                  1)^;
              end;
            end;
          end;
        acRight:
          begin
            for i := 0 to Size - 1 do
            begin
              if (i mod 4) = 0 then
              begin
                PByte(Integer(PBuffer) + i)^ := PByte(Integer(PBuffer) + i +
                  2)^;
                PByte(Integer(PBuffer) + i + 1)^ := PByte(Integer(PBuffer) + i +
                  3)^;
              end;
            end;
          end;
      end;
    end;
    Result := S_OK;
  except
    Result := S_FALSE;
  end;
end;

function TBalancerInputPin.CheckMediaType(mt: PAMMediaType):
  HRESULT;
var
  pmt: PAMMediaType;
begin
  pmt := @TBalancerFilter(FTIPFilter).FPreferred;
  if not TBCMediaType(pmt).IsValid then
  begin
    if TBalancerFilter(FTIPFilter).Output.IsConnected then
    begin
      Result :=
        TBalancerFilter(FTIPFilter).Output.GetConnected.QueryAccept(mt^);
      Exit;
    end;
    Result := S_OK;
    Exit;
  end
  else if TBCMediaType(pmt).Equal(mt) then
  begin
    Result := S_OK;
    Exit;
  end
  else
    Result := VFW_E_TYPE_NOT_ACCEPTED;
end;

constructor TBalancerInputPin.Create(ObjectName: string;
  TransInPlaceFilter: TBCTransInPlaceFilter; out hr: HRESULT;
  Name: WideString);
begin
  inherited Create(ObjectName, TransInPlaceFilter, hr, Name);
end;

function TBalancerOutputPin.CheckMediaType(mt: PAMMediaType):
  HRESULT;
var
  pmt: PAMMediaType;
begin
  pmt := @TBalancerFilter(FTIPFilter).FPreferred;
  if not TBCMediaType(pmt).IsValid then
  begin
    Result := inherited CheckMediaType(mt);
    Exit;
  end
  else if TBCMediaType(pmt).Equal(mt) then
  begin
    Result := S_OK;
    Exit;
  end
  else
    Result := VFW_E_TYPE_NOT_ACCEPTED;
end;

constructor TBalancerOutputPin.Create(ObjectName: string;
  TransInPlaceFilter: TBCTransInPlaceFilter; out hr: HRESULT;
  Name: WideString);
begin
  inherited Create(ObjectName, TransInPlaceFilter, hr, Name);
end;

function TBalancerFilter.CheckInputType(mtIn: PAMMediaType):
  HRESULT;
begin
  if not IsEqualGUID(mtIn^.formattype, FORMAT_WaveFormatEx) then
  begin
    Result := E_INVALIDARG;
    Exit;
  end;

  if not IsEqualGUID(mtIn^.majortype, MEDIATYPE_Audio) then
  begin
    Result := E_INVALIDARG;
    Exit;
  end;

  if not IsEqualGUID(mtIn^.subtype, MEDIASUBTYPE_PCM) then
  begin
    Result := E_INVALIDARG;
    Exit;
  end;

  Result := S_OK;
end;

constructor TBalancerFilter.Create(ObjName: string; unk:
  IInterface;
  out hr: HRESULT);
var
  pmt: PAMMediaType;
begin
  inherited Create(ObjName, unk, CLSID_Balancer, hr);
  FThisInstance := InterlockedIncrement(InstanceCount);
  pmt := @FPreferred;
  TBCMediaType(pmt).InitMediaType;
  FBalancerLock := TBCCritSec.Create;
  FCurrentChannel := acStereo;
end;

constructor TBalancerFilter.CreateFromFactory(Factory:
  TBCClassFactory;
  const Controller: IInterface);
var
  hr: HRESULT;
begin
  Create(Factory.Name, Controller, hr);
end;

destructor TBalancerFilter.Destroy;
begin
  FBalancerLock.Free;
  inherited;
end;

function TBalancerFilter.get_IPin(out Pin: IPin): HRESULT;
begin
  Result := S_OK;
  FBalancerLock.Lock;
  try
    if (Input = nil) then
    begin
      Pin := nil;
      Exit;
    end;
    if not Input.IsConnected then
      Pin := nil
    else
      Pin := Input.GetConnected;
  finally
    FBalancerLock.UnLock;
  end;
end;

function TBalancerFilter.get_MediaType(out mt: TAMMediaType):
  HRESULT;
begin
  FBalancerLock.Lock;
  try
    mt := FPreferred;
    Result := NOERROR;
  finally
    FBalancerLock.UnLock;
  end;
end;

function TBalancerFilter.get_State(out State: TFilterState):
  HRESULT;
begin
  FBalancerLock.Lock;
  try
    State := self.State;
    Result := NOERROR;
  finally
    FBalancerLock.UnLock;
  end;
end;

function TBalancerFilter.GetPages(out pages: TCAGUID): HResult;
begin
  Pages.cElems := 1;
  Result := NOERROR;
end;

function TBalancerFilter.GetPin(n: integer): TBCBasePin;
var
  hr: HRESULT;
begin
  if (Input = nil) or (Output = nil) then
  begin
    hr := S_OK;
    Input := TBalancerInputPin.Create('Balancer input pin',
      self, hr, 'Input');

    if FAILED(hr) or (Input = nil) then
    begin
      if (Input <> nil) then
        input.Free;
      input := nil;
      Result := nil;
      Exit;
    end;

    Output := TBalancerOutputPin.Create('Balancer output pin',
      self, hr,
      'Output');

    if FAILED(hr) or (Output = nil) then
    begin
      if (Input <> nil) then
        input.Free;
      if (Output <> nil) then
        Output.Free;
      Input := nil;
      Output := nil;
      Result := nil;
      Exit;
    end;
  end;

  case n of
    0: Result := Input;
    1: Result := Output;
  else
    Result := nil;
  end;
end;

function TBalancerFilter.put_MediaType(mt: PAMMediaType):
  HRESULT;
var
  Pin: IPin;
  pmt: PAMMediaType;
begin
  FBalancerLock.Lock;
  try
    if (State = State_Running) then
    begin
      Result := E_UNEXPECTED;
      Exit;
    end;

    pmt := @FPreferred;
    if (mt = nil) then
      TBCMediaType(pmt).InitMediaType
    else
    begin
      Pin := Input.GetConnected;
      if (Pin <> nil) then
      begin
        if (Pin.QueryAccept(mt^) <> NOERROR) then
        begin
          MessageBox(0,
            PChar('Upstream filter cannot provide this type'),
            PChar('Format Selection'),
            MB_OK or MB_ICONEXCLAMATION);
          Result := VFW_E_TYPE_NOT_ACCEPTED;
          Exit;
        end;
      end;

      Pin := Output.GetConnected;
      if (Pin <> nil) then
      begin
        if (Pin.QueryAccept(mt^) <> NOERROR) then
        begin
          MessageBox(0,
            PChar('Downstream filter cannot accept this type'),
            PChar('Format Selection'),
            MB_OK or MB_ICONEXCLAMATION);
          Result := VFW_E_TYPE_NOT_ACCEPTED;
          Exit;
        end;
      end;
      FPreferred := mt^;
    end;

    if (Input.IsConnected) then
    begin
      pmt := Input.CurrentMediaType.MediaType;
      if not TBCMediaType(pmt).Equal(@FPreferred) then
        Graph.Reconnect(Input);
    end;
    Result := NOERROR;
  finally
    FBalancerLock.Unlock;
  end;
end;

function TBalancerFilter.Transform(Sample: IMediaSample):
  HRESULT;
var
  PWaveFormat: PWaveFormatEx;
  AudioChannel: TAudioChannel;
  Size: Integer;
  PBuffer: PByte;
begin
  try
    PWaveFormat := FInput.CurrentMediaType.MediaType.pbFormat;

    AudioChannel := FCurrentChannel;

    Sample.GetPointer(PBuffer);
    Size := Sample.GetActualDataLength;

    AudioChannelMix(Pbuffer, Size, AudioChannel,
      PWaveFormat.wBitsPerSample);
  finally
    Result := S_OK;
  end;
end;

function TBalancerFilter.SetAudioChannel(AudioChannel:
  TAudioChannel): HRESULT;
  stdcall;
begin
  try
    FCurrentChannel := AudioChannel;
  finally
    Result := S_OK;
  end;
end;

function TBalancer.GetFilter: IBaseFilter;
begin
  Result := FBaseFilter;
end;

function TBalancer.GetName: string;
begin
  Result := Name_Balancer;
end;

procedure TBalancer.NotifyFilter(operation: TFilterOperation; Param: integer =
  0);
begin
  case operation of
    foAdding: FFilter := FBaseFilter;
    foRemoving: if FFilter <> nil then
        FFilter.Stop;
    foRemoved: FFilter := nil;
    foRefresh: if assigned(FFilterGraph) then
      begin
        FFilterGraph.RemoveFilter(self);
        FFilterGraph.InsertFilter(self);
      end;
  end;
end;

procedure TBalancer.SetFilterGraph(AFilterGraph: TFilterGraph1);
begin
  if AFilterGraph = FFilterGraph then
    exit;
  if FFilterGraph <> nil then
    FFilterGraph.RemoveFilter(self);
  if AFilterGraph <> nil then
    AFilterGraph.InsertFilter(self);
  FFilterGraph := AFilterGraph;
end;

procedure TBalancer.Notification(AComponent: TComponent; Operation:
  TOperation);
begin
  inherited Notification(AComponent, Operation);
  if ((AComponent = FFilterGraph) and (Operation = opRemove)) then
    FFilterGraph := nil;
end;

constructor TBalancer.Create(AOwner: TComponent);
var
  hr: HRESULT;
begin
  inherited Create(AOwner);
  FBaseFilter := TBalancerFilter.Create(Name_Balancer, AOwner,
    hr);
  FAudioChannel := acStereo;
end;

destructor TBalancer.Destroy;
begin
  FBaseFilter.Free;
  FilterGraph := nil;
  inherited Destroy;
end;

function TBalancer.QueryInterface(const IID: TGUID; out Obj):
  HResult;
begin
  result := inherited QueryInterface(IID, Obj);
  if not Succeeded(Result) then
    if Assigned(FFilter) then
      result := FFilter.QueryInterface(IID, Obj);
end;

procedure TBalancer.SetAudioChannel(AAudioChannel: TAudioChannel);
begin
  FAudioChannel := AAudioChannel;
  FBaseFilter.SetAudioChannel(FAudioChannel);
end;

procedure Register;
begin
  RegisterComponents('DSPack', [TBalancer]);
end;

end.