videodx.pas

絮语2007视频聊天软件源程序.仅供参考

unit videodx;

interface

uses
  Windows, Messages,SysUtils,Classes,Graphics,extctrls,
  DSPack,directshow9,DSUtil,constunt,jpeg;
  
type
  
  Tvideo=class
      constructor Create;
      destructor  Destroy;override;
    private
      filter:tfilter;
      SysDev: TSysDevEnum;
      samplegrabber:tsamplegrabber;
      filtergraph:tfiltergraph;
      procedure SampleGrabberBuffer(sender: TObject; SampleTime: Double;
        pBuffer: Pointer; BufferLen: Integer);
      procedure videoformat;
      procedure videofreeandnil;
    public
      outbitmap:Tbitmap;
      procedure video_select(dev_list:tstrings);
      procedure videoseting(hwd:thandle);
      procedure videostart;
      procedure videostop;
    end;

implementation
uses shareunit;

//------------------------------------------------------------------------------
// 视频初始化
//------------------------------------------------------------------------------
procedure Tvideo.videoformat;
begin
try
outbitmap:=tbitmap.create;
filtergraph:=tfiltergraph.Create(nil);
filter:=tfilter.Create(nil);
samplegrabber:=tsamplegrabber.Create(nil);
filtergraph.Mode:=gmcapture;
filter.FilterGraph:=filtergraph;
samplegrabber.FilterGraph:=filtergraph;
samplegrabber.OnBuffer:=SampleGrabberBuffer;
SysDev:= TSysDevEnum.Create(CLSID_VideoInputDeviceCategory);
if SysDev.CountFilters > 0 then
   begin
   if not(SysDev.CountFilters>video_index) then
      video_index:=0;
   if video_index=-1 then video_index:=0;
   videoisok:=true;
   end else begin
   videoisok:=false;
   video_index:=-1;
   end;
except
logmemo.add(timetostr(time)+':视始化视频出错');
videoisok:=false;
end;
end;

//------------------------------------------------------------------------------
// 视频选择
//------------------------------------------------------------------------------
procedure Tvideo.video_select(dev_list:tstrings);
var i:integer;
begin
if videoisok then
 begin
 if SysDev.CountFilters > 0 then
 for i:=1 to  SysDev.CountFilters do
   dev_list.add(SysDev.Filters[i-1].FriendlyName);
 end;
end;

//------------------------------------------------------------------------------
// 视频实时截取
//------------------------------------------------------------------------------
procedure Tvideo.SampleGrabberBuffer(sender: TObject; SampleTime: Double;
  pBuffer: Pointer; BufferLen: Integer);
begin
try
outbitmap.Canvas.Lock;
SampleGrabber.GetBitmap(outbitmap,pBuffer,BufferLen);
outbitmap.Canvas.Unlock;
sendmsgtohwnd(xy_media_video);
except
outbitmap.Canvas.Unlock;
end;
end;


//------------------------------------------------------------------------------
// 开始视频
//------------------------------------------------------------------------------
procedure Tvideo.videostart();
var
  CaptureGraph: ICaptureGraphBuilder2;
  SourceFilter, DestFilter: IBaseFilter;
  VideoMediaTypes: TEnumMediaType;
  PinList:tPinList;
begin
if videoisok then
 begin
  inc(video_use);
  if video_use=1 then
    try
    FilterGraph.ClearGraph;
    FilterGraph.Active := false;
    Filter.BaseFilter.Moniker := SysDev.GetMoniker(video_index);
    FilterGraph.Active := true;
    FilterGraph.QueryInterface(ICaptureGraphBuilder2, CaptureGraph);
    Filter.QueryInterface(IBaseFilter, SourceFilter);
    SampleGrabber.QueryInterface(IBaseFilter,DestFilter);
    //--------------------------------------------------------------------------
    VideoMediaTypes := TEnumMediaType.Create;
    PinList := TPinList.Create(SourceFilter);
    VideoMediaTypes.Assign(PinList.First);
    if VideoMediaTypes.Count>1 then
    with (PinList.First as IAMStreamConfig) do
          SetFormat(VideoMediaTypes.Items[VideoMediaTypes.count-1].AMMediaType^);
    VideoMediaTypes.free;
    PinList.Free;
    //--------------------------------------------------------------------------
    CaptureGraph.RenderStream(@PIN_CATEGORY_CAPTURE, nil, SourceFilter, nil, DestFilter);

    FilterGraph.Play;

    CaptureGraph := nil;
    SourceFilter := nil;
    DestFilter   := nil;
    except
    CaptureGraph := nil;
    SourceFilter := nil;
    DestFilter   := nil;
    logmemo.add(timetostr(time)+': video is faile ...');
    end;
 end;
end;

//------------------------------------------------------------------------------
// 停止视频
//------------------------------------------------------------------------------
procedure Tvideo.videostop();
begin
if videoisok then
 begin
  inc(video_use,-1);
  if video_use=0 then
   begin
    filtergraph.Stop;
    FilterGraph.Active := false;
   end;
  if video_use<0 then video_use:=0;
 end;
end;


//------------------------------------------------------------------------------
// 显示视频属性
//------------------------------------------------------------------------------
procedure Tvideo.videoseting(hwd:thandle);
begin
ShowFilterPropertyPage(hwd,Filter.BaseFilter.CreateFilter);
end;

//------------------------------------------------------------------------------
// 释放视频
//------------------------------------------------------------------------------
procedure Tvideo.videofreeandnil;
begin
  try
    if assigned(samplegrabber) then freeandnil(samplegrabber);
    if assigned(filter)       then freeandnil(filter);
    if assigned(filtergraph) then freeandnil(filtergraph);
    if assigned(SysDev)     then freeandnil(SysDev);
    if assigned(outbitmap) then freeandnil(outbitmap);
  except
    logmemo.add(timetostr(time)+':freeandnil video faile');
  end;
end;

//------------------------------------------------------------------------------
// 构建 video
//------------------------------------------------------------------------------
constructor Tvideo.Create;
begin
  videoformat;
end;

//------------------------------------------------------------------------------
// 释放 video
//------------------------------------------------------------------------------
destructor Tvideo.Destroy;
begin
  if videoisok then videostop;
  videofreeandnil;
  inherited Destroy;
end;

end.