dspack.pas

摄像头视频捕捉程序

  constructor TDSCaptureGraph.Create(AOwner: TComponent);
  begin
    inherited Create(AOwner);
  end;

  destructor TDSCaptureGraph.Destroy;
  begin
    inherited Destroy;
  end;

  procedure TDSCaptureGraph.Connect;
  begin
    inherited Connect;
    if CaptureGraphBuilder2 = nil then
    begin
      CoCreateInstance(CLSID_CaptureGraphBuilder2, nil, CLSCTX_INPROC, IID_ICaptureGraphBuilder2, CaptureGraphBuilder2);
      CaptureGraphBuilder2.SetFiltergraph(FilterGraph2);
    end;
  end;

  procedure TDSCaptureGraph.Disconnect;
  begin
    if CaptureGraphBuilder2 <> nil then
    begin
      CaptureGraphBuilder2 := nil;
    end;
    inherited Disconnect;
  end;

  procedure TDSCaptureGraph.QueryInterfaces;
  begin
    inherited QueryInterfaces;
  end;

//******************************************************************************
//
// TDSSysDevEnum implementation
//
//******************************************************************************
procedure TDSSysDevEnum.GetCat(catlist: TList; CatGUID: TGUID);
var
  SysDevEnum  : ICreateDevEnum;
  EnumCat     : IEnumMoniker;
  Moniker     : IMoniker;
  Fetched     : ULONG;
  PropBag     : IPropertyBag;
  Name        : olevariant;
  hr          : HRESULT;
begin
  SysDevEnum := nil;
  EnumCat    := nil;
  catList.Clear;
  CocreateInstance(CLSID_SystemDeviceEnum, nil, CLSCTX_INPROC, IID_ICreateDevEnum, SysDevEnum);
  hr := SysDevEnum.CreateClassEnumerator(CatGUID, EnumCat, 0);
  if (hr = S_OK) then
  begin
    while(EnumCat.Next(1, Moniker, @Fetched) = S_OK) do
      begin
        Moniker.BindToStorage(nil, nil, IID_IPropertyBag, PropBag);
        new(ACategory);
        PropBag.Read('FriendlyName', Name, nil);
        ACategory^.FriendlyName := Name;
        if (PropBag.Read('CLSID',Name,nil) = S_OK) then
          ACategory^.CLSID := StringToGUID(Name)
        else
          ACategory^.CLSID := GUID_NULL;
        catlist.Add(ACategory);
        PropBag := nil;
        Moniker := nil;
      end;
  end;
  EnumCat :=nil;
  SysDevEnum :=nil;
end;

Constructor TDSSysDevEnum.Create;
begin
  FCategories := TList.Create;
  FFilters    := TList.Create;
  getcat(FCategories,CLSID_ActiveMovieCategories);
end;

destructor TDSSysDevEnum.Destroy;
begin
  inherited Destroy;
  FCategories.Free;
  FFilters.Free;
end;

function TDSSysDevEnum.GetCategory(item: integer): TDSFilCatNode;
var PCategory: PDSFilCatNode;
begin
  PCategory := FCategories.Items[item];
  result := PCategory^;
end;

function TDSSysDevEnum.GetFilter(item: integer): TDSFilCatNode;
var PCategory: PDSFilCatNode;
begin
  PCategory := FFilters.Items[item];
  result := PCategory^;
end;

function TDSSysDevEnum.GetCountCategories: integer;
begin
  result := FCategories.Count;
end;

function TDSSysDevEnum.GetCountFilters: integer;
begin
  result := FFilters.Count;
end;

procedure TDSSysDevEnum.SelectGUIDCategory(GUID: TGUID);
begin
  FGUID := GUID;
  getcat(FFilters,FGUID);
end;

procedure TDSSysDevEnum.SelectIndexCategory(index: integer);
begin
  SelectGUIDCategory(Categories[index].CLSID);
end;

function TDSSysDevEnum.GetBaseFilterByIndex(index: integer): IBaseFilter;
var
  SysDevEnum  : ICreateDevEnum;
  EnumCat     : IEnumMoniker;
  Moniker     : IMoniker;
  Fetched     : ULONG;
begin
  result := nil;
  if ((index < CountFilters) and (index >= 0)) then
    begin
      SysDevEnum := nil;
      EnumCat    := nil;
      Moniker    := nil;
      CocreateInstance(CLSID_SystemDeviceEnum, nil, CLSCTX_INPROC, IID_ICreateDevEnum, SysDevEnum);
      SysDevEnum.CreateClassEnumerator(FGUID, EnumCat, 0);
      EnumCat.Next(index+1, Moniker, @Fetched);
      Moniker.BindToObject(nil, nil, IID_IBaseFilter, result);
      SysDevEnum := nil;
      EnumCat    := nil;
      Moniker    := nil;
    end
end;

//******************************************************************************
//
// TDSTrackBar implementation
//
//******************************************************************************
  constructor TDSTrackBar.Create(AOwner: TComponent);
  begin
    inherited Create(AOwner);
    FWindowHandle := AllocateHWnd(WndProc2);
    FInterval := 0;
    ThumbLength := 15;
    Height := 25;
    if assigned(FGRAPH) then SetGraph(FGRAPH);
    Settimerenabled(false);
  end;

  destructor TDSTrackBar.Destroy;
  begin
    Settimerenabled(False);
    DeallocateHWnd(FWindowHandle);
    inherited Destroy;
  end;

  procedure TDSTrackBar.WndProc2(var Msg: TMessage);
  begin
    with Msg do
      if Msg = WM_TIMER then
        try
          Timer;
        except
          Application.HandleException(Self);
        end
      else
        Result := DefWindowProc(FWindowHandle, Msg, wParam, lParam);
  end;

  procedure TDSTrackBar.UpdateTimer;
  var y: int64;
  begin
    if SeekingAvailable then
    begin
      KillTimer(FWindowHandle, 1);
      FGraph.MediaSeeking.GetDuration(y);
      FInterval := round((y*0.0001)/(max*rate));
      if (FInterval <> 0) and FTimerEnable then
        if SetTimer(FWindowHandle, 1, FInterval, nil) = 0 then
          raise EOutOfResources.Create(SNoTimers);
    end;
  end;

  procedure TDSTrackBar.SetTimerEnabled(Value: Boolean);
  begin
    if (Value <> FTimerEnable) then
    begin
      FTimerEnable := Value;
      UpdateTimer;
    end;
  end;

  procedure TDSTrackBar.Timer;
  var x,y: int64;
  begin
    if SeekingAvailable then
    begin
      FGraph.MediaSeeking.GetCurrentPosition(x);
      FGraph.MediaSeeking.GetDuration(y);
      SelStart := 0;
      SelEnd := round((x*max)/(y));
    end;
  end;

  procedure TDSTrackBar.Changed;
  var SStart, SStop, y: int64;
  begin
    inherited Changed;
    if SeekingAvailable then
    begin
      FGraph.MediaSeeking.GetDuration(y);
      SStart := round((Position*y)/max);
      FGraph.MediaSeeking.SetPositions(SStart,AM_SEEKING_AbsolutePositioning,SStop,AM_SEEKING_NoPositioning);
      Timer;
    end;
  end;

  procedure TDSTrackBar.SetGraph(grf: TDSFilterGraph2);
  var duration, SStart, SStop: int64;
  begin
    if assigned(FGraph) then FGraph.FTB := nil;
    FGraph := grf;
    if assigned(FGraph) then
    begin
      FGraph.FTB := self;
      if SeekingAvailable then
      begin
        if ([CanSeekAbsolute, CanGetDuration] <= Capabilities) then
        begin
          SelStart := 0;
          Min := 0;
          FGraph.MediaSeeking.GetDuration(duration);
          SStart :=0; SStop := 0;
          FGraph.MediaSeeking.SetPositions(SStart,AM_SEEKING_AbsolutePositioning,SStop,AM_SEEKING_NoPositioning);
          Enabled := True;
          position := 0;
          SetTimerEnabled(true);
          UpdateTimer;
        end
        else
        begin
          SetTimerEnabled(false);
          SelEnd := 0;
          Enabled := false;
        end;
      end;
    end;
  end;

  function TDSTrackBar.SeekingAvailable: boolean;
  begin
    result := false;
    if assigned(FGraph) then
      if assigned(FGraph.MediaSeeking) then result := true;
  end;

  function  TDSTrackBar.GetCapabilities: TDSAMSeekingKind;
  begin
    result := [];
    if SeekingAvailable then FGraph.MediaSeeking.GetCapabilities(PULONG(@result)^);
  end;

  function  TDSTrackBar.GetRate: double;
  begin
    result := 0;
    if SeekingAvailable then FGraph.MediaSeeking.GetRate(result);
  end;

  procedure TDSTrackBar.SetRate(rate: Double);
  begin
    if (SeekingAvailable and (rate <> 0)) then
    begin
      FGraph.MediaSeeking.SetRate(rate);
      UpdateTimer;
    end;

  end;

  procedure TDSTrackBar.ReceiveEndOfStream;
  begin
    FGraph.MediaControl.Stop;
    Position