avsender.~pas

音视频控件SunAM-V1.0 音视频控件SunAM-V1.0 音视频控件SunAM-V1.0 音视频控件SunAM-V1.0

unit AVSender;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, g729,
  ComCtrls, ACMWaveIn, IdBaseComponent, IdComponent, IdUDPBase,
  IdUDPServer, Menus, DSPack, StdCtrls , Dialogs, DirectShow9, DSUtil, GlobalUnit, math,
  mmsystem, ExtCtrls, AVCompress;

type
  TAVState = (avsDisabled, avsEnabled, avsActive, avsNotActive);
  TSenderForm = class(TForm)
    FilterGraph: TFilterGraph;
    VideoGrabber: TSampleGrabber;
    VideoCapFilter: TFilter;
    PopupSetting: TPopupMenu;
    miVideoRate: TMenuItem;
    miVideoSize: TMenuItem;
    miVideoDrv: TMenuItem;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    FPS1: TMenuItem;
    FPS2: TMenuItem;
    FPS3: TMenuItem;
    FPS5: TMenuItem;
    FPS8: TMenuItem;
    FPS10: TMenuItem;
    FPS12: TMenuItem;
    FPS15: TMenuItem;
    vm2: TMenuItem;
    vm3: TMenuItem;
    vm0: TMenuItem;
    vm1: TMenuItem;
    VideoWindow: TVideoWindow;
    Image1: TImage;
    WaveIn: TACMWaveIn;
    procedure FormCreate(Sender: TObject);
    procedure FPSClick(Sender: TObject);
    procedure vmClick(Sender: TObject);
    procedure VideoGrabberBuffer(sender: TObject; SampleTime: Double;
      pBuffer: Pointer; BufferLen: Integer);
    procedure WaveInData(data: Pointer; size: Integer);
    procedure FormDestroy(Sender: TObject);
  private
     FHasAudioDrv: Boolean;

     FHasVideoDrv: Boolean;

     FSysDev: TSysDevEnum;
     FAVCompressor: TAVCompressor;
     FOnAudioOut: TOnAudioOut;
     FOnVideoOut: TOnVideoOut;
     FOnVideoShow:TOnVideoShow;
     FOnVolumeOut: TOnVolumeOut;
     function GetFilterPin(Filter: IBaseFilter; PinDirection: TPinDirection; Index: Integer = 1): IPin;
     procedure OnSelectDevice(sender: TObject);
     procedure OnVideoOutput(Adata: Pointer; Asize: Cardinal);
     procedure OnAudioOutput(Adata: Pointer; Asize: Cardinal);
     procedure SetOnAudioOut(const Value: TOnAudioOut);
     procedure SetOnVideoOut(const Value: TOnVideoOut);
     procedure SetOnVideoShow(const Value: TOnVideoShow);
     procedure SetOnVolumeOut(const Value: TOnVolumeOut);
  public
     FAudioActive: Boolean;
     FVideoActive: Boolean;
     VideoDrvIndex: Integer;
     VideoMediaTypes: TEnumMediaType;
     VideoMode:TVideoDispMode;

     AudioDrvIndex:integer;
     AudioBuf: array[0..3000 - 1] of Byte; //缓存3S的声音数据，超过则抛弃
     AudioSize: Integer;
     AudioDecBuf: array[0..3 * 16000 - 1] of Byte;
     property HasVideoDrv: Boolean read FHasVideoDrv;
     property HasAudioDrv: Boolean read FHasAudioDrv;
     Function ConnectDrv():boolean;
     function DisconnectDrv: Boolean;
     function OpenVideo: Boolean;
     procedure CloseVideo;
     function OpenAudio():boolean;
     procedure CloseAudio;
     procedure init();
  published
     property OnAudioOut: TOnAudioOut read FOnAudioOut write SetOnAudioOut;
     property OnVideoOut: TOnVideoOut read FOnVideoOut write SetOnVideoOut;
     property OnVideoShow: TOnVideoShow read FOnVideoShow write SetOnVideoShow;
     property OnVolumeOut: TOnVolumeOut read FOnVolumeOut write SetOnVolumeOut;
  end;
var
  SenderForm: TSenderForm;


implementation

{$R *.dfm}

function TSenderForm.GetFilterPin(Filter: IBaseFilter; PinDirection: TPinDirection; Index: Integer = 1): IPin;
var
  ppEnum: IEnumPins;
  ppPins: IPin;
  PinDirec: TPinDirection;
  Count: Integer;
begin
  if Filter <> nil then
  begin
    Count := 0;

    Filter.EnumPins(ppEnum);
    ppEnum.Next(1, ppPins, nil);

    while ppPins <> nil do
    begin
      ppPins.QueryDirection(PinDirec);

      if PinDirec = PinDirection then
      begin
        Inc(Count);
        if Count >= Index then
        begin
          Break;
        end;
      end;

      ppEnum.Next(1, ppPins, nil);
    end;
  end;
  Result := ppPins;
end;

procedure TSenderForm.OnVideoOutput(Adata: Pointer; Asize: Cardinal);
begin
   if Asize<=0 then exit;
   if Assigned(FOnVideoOut) then begin
      FOnVideoOut(Adata,Asize);
   end;
end;


procedure TSenderForm.OnAudioOutput(Adata: Pointer; Asize: Cardinal);
begin
   if Asize<=0 then exit;
   if Assigned(FOnAudioOut) then
      FOnAudioOut(Adata,Asize);
end;

procedure TSenderForm.SetOnAudioOut(const Value: TOnAudioOut);
begin
   FOnAudioOut := Value;
end;

procedure TSenderForm.SetOnVideoOut(const Value: TOnVideoOut);
begin
   FOnVideoOut := Value;
end;

procedure TSenderForm.SetOnVideoShow(const Value: TOnVideoShow);
begin
   FOnVideoShow := Value;
end;

procedure TSenderForm.SetOnVolumeOut(const Value: TOnVolumeOut);
begin
   FOnVolumeOut := Value;
end;

procedure TSenderForm.FormCreate(Sender: TObject);
var
  i: Integer;
  Device: TMenuItem;
begin
  try
    FSysDev := TSysDevEnum.Create(CLSID_VideoInputDeviceCategory);

    if FSysDev.CountFilters > 0 then begin
      miVideoDrv.Clear;
      for i := 0 to FSysDev.CountFilters - 1 do  begin
        Device := TMenuItem.Create(miVideoDrv);
        Device.Caption := FSysDev.Filters[i].FriendlyName;
        Device.Tag := i;
        Device.OnClick := OnselectDevice;
        miVideoDrv.Add(Device);
      end;
    end;
   except
   end;
end;

procedure TSenderForm.OnSelectDevice(sender: TObject);
begin
  VideoDrvIndex:=TMenuItem(Sender).tag;
  TMenuItem(Sender).Checked :=true;
  closeVideo;
  ConnectDrv;
  OpenVideo;
end;

function TSenderForm.OpenVideo:boolean;
begin
   FVideoActive:=true;
   OpenVideo:=true;
end;

procedure TSenderForm.CloseVideo();
begin
  FVideoActive:=false;
end;

function TSenderForm.ConnectDrv: Boolean;
var
  i:integer;
  Device: TMenuItem;
  ppPins1: IPin;
  MediaTypeIndex:integer;
  PinList: TPinList;
begin
  try
    FilterGraph.ClearGraph;
    FilterGraph.Active := false;
    FSysDev := TSysDevEnum.Create(CLSID_VideoInputDeviceCategory);
    if FSysDev.CountFilters > 0 then begin
      for i := 0 to FSysDev.CountFilters - 1 do  begin
        Device := TMenuItem.Create(miVideoDrv);
        Device.Caption := FSysDev.Filters[i].FriendlyName;
        Device.Tag := i;
        Device.OnClick := OnselectDevice;
        miVideoDrv.Add(Device);
        if i = VideoDrvIndex then Device.Checked := true;
      end;
    end;
    VideoCapFilter.BaseFilter.Moniker := FSysDev.GetMoniker(VideoDrvIndex);
    FilterGraph.Active := true;
    PinList := TPinList.Create(VideoCapFilter as IBaseFilter);
    VideoMediaTypes.Assign(PinList.First);
    if VideoMode=vm320 then MediaTypeIndex:=0;
    if VideoMode=vm352 then MediaTypeIndex:=1;
    if VideoMode=vm160 then MediaTypeIndex:=2;
    if VideoMode=vm176 then MediaTypeIndex:=3;
    if VideoMode=vm640 then MediaTypeIndex:=2;
    ppPins1 := GetFilterPin((VideoCapFilter as IFilter).GetFilter, PINDIR_OUTPUT);
    with (ppPins1 as IAMStreamConfig) do
      SetFormat(VideoMediaTypes.Items[MediaTypeIndex].AMMediaType^);
    with FilterGraph as ICaptureGraphBuilder2 do
       CheckDSError(RenderStream(@PIN_CATEGORY_PREVIEW, nil, VideoCapFilter as IBaseFilter, VideoGrabber as IBaseFilter, VideoWindow as IbaseFilter));
    FilterGraph.Play;
    ConnectDrv:=true;
    FHasVideoDrv := true;
  except
     FilterGraph.Stop;
     ConnectDrv:=false;
     FHasVideoDrv := false;
     PinList.Free;
  end;
end;

function TSenderForm.DisconnectDrv: Boolean;
begin
  try
    FilterGraph.Active := false;
    FilterGraph.ClearGraph; 
    FSysDev.Free;
    FHasVideoDrv := false;
    DisconnectDrv:=true;
  except
    DisconnectDrv:=false;
  end;
end;

procedure TSenderForm.init();
begin
  FAVCompressor:=TAVCompressor.Create;
  FAVCompressor.VideoMode := VideoMode;
  FAVCompressor.OnAudioOut := OnAudioOutput;
  FAVCompressor.OnVideoOut := OnVideoOutput;
  FAVCompressor.Open;
  VideoMediaTypes:=TEnumMediaType.Create;
end;

procedure TSenderForm.FPSClick(Sender: TObject);
begin
   case TMenuItem(Sender).tag of
     1: begin
          FPS1.Checked := true;
        end;
     2: begin
          FPS2.Checked := true;
        end;
     3: begin
          FPS3.Checked := true;
        end;
     5: begin
          FPS5.Checked := true;
        end;
     8: begin
          FPS8.Checked := true;
        end;
     10:begin
          FPS10.Checked := true;
        end;
     12:begin
          FPS12.Checked := true;
        end;
     15:begin
          FPS15.Checked := true;
        end;
   end;
end;

procedure TSenderForm.vmClick(Sender: TObject);
begin
    closeVideo;
    case TMenuItem(Sender).tag of
     0: begin
          vm0.Checked := true;
          VideoMode:=vm320;
          if Assigned(FAVCompressor) then begin
            FAVCompressor.Close;
            FAVCompressor.VideoMode := VideoMode;
            FAVCompressor.Open;
          end;
        end;
     1: begin
          vm1.Checked := true;
          VideoMode:=vm352;
          if Assigned(FAVCompressor) then begin
            FAVCompressor.Close;
            FAVCompressor.VideoMode := VideoMode;
            FAVCompressor.Open;
          end;
        end;
     2: begin
          vm2.Checked := true;
          VideoMode:=vm160;
          if Assigned(FAVCompressor) then begin
            FAVCompressor.Close;
            FAVCompressor.VideoMode := VideoMode;
            FAVCompressor.Open;
          end;
        end;
     3: begin
          vm3.Checked := true;
          VideoMode:=vm176;
          if Assigned(FAVCompressor) then begin
            FAVCompressor.Close;
            FAVCompressor.VideoMode := VideoMode;
            FAVCompressor.Open;
          end;
        end;
     4: begin
        end;
   end;
   ConnectDrv;
   OpenVideo;
end;

procedure TSenderForm.VideoGrabberBuffer(sender: TObject; SampleTime: Double;
  pBuffer: Pointer; BufferLen: Integer);
var
  hr: HRESULT;
  BIHeaderPtr: PBitmapInfoHeader;
  MediaType: TAMMediaType;
  BitMapHandle: HBitmap;
  DIBPtr: Pointer;
  BitmapInfoHeader:TBitmapInfoHeader;
begin
  if not FVideoActive then exit;
  hr := VideoGrabber.SampleGrabber.GetConnectedMediaType(MediaType);
  if hr <> S_OK then Exit;
  try
    if IsEqualGUID(MediaType.majortype, MEDIATYPE_Video) then
    begin
      if IsEqualGUID(MediaType.formattype, FORMAT_VideoInfo) then begin
         if MediaType.cbFormat = SizeOf(TVideoInfoHeader) then
           BitmapInfoHeader:=PVideoInfoHeader(MediaType.pbFormat)^.bmiHeader;
      end;
      if Assigned(FAVCompressor) then begin
         if FAVCompressor.IsActive then
            FAVCompressor.VCompressor(BitmapInfoHeader,pBuffer);
      end;
      Image1.Canvas.Lock;
      try
         VideoGrabber.GetBitmap(Image1.Picture.Bitmap, pBuffer, BufferLen);
         if Assigned(FOnVideoShow) then
           FOnVideoShow(Image1.Picture.Bitmap);
      finally
         Image1.Canvas.Unlock;
      end;
    end;
  finally
    FreeMediaType(@MediaType);
  end;
end;

function TSenderForm.OpenAudio:boolean;
begin
   try
     WaveIn.Open(@PCMFOMAT, AudioDrvIndex);
   except
     Exit;
  end;
end;

procedure TSenderForm.CloseAudio();
begin
  WaveIn.Close;
end;

procedure TSenderForm.WaveInData(data: Pointer; size: Integer);
var
  PeakL, PeakR: Smallint;
begin
  if Assigned(FAVCompressor) then
     FAVCompressor.ACompressor(data,size);
  pcmFindPeak(@PCMFOMAT, Data, Size, PeakL, PeakR);
  if Assigned(FOnVolumeOut) then
     FOnVolumeOut(32767-ABS(PeakL));
end;

procedure TSenderForm.FormDestroy(Sender: TObject);
begin
   FilterGraph.ClearGraph;
   FilterGraph.Active := false;
   CloseVideo;
   CloseAudio;
   if Assigned(FAVCompressor) then FAVCompressor.Free;
   WaveIn.Close;
   WaveIn.Destroy;
end;

end.