dspack.pas

摄像头视频捕捉程序

        if (input.QueryInterface(IID_IOverlay, overlay) = S_OK) then
        begin
          overlay.GetWindowHandle(VideoHandle);
          result := true;
        end;
      end;
    end;
    renderer := nil;
    input    := nil;
    enum     := nil;
    Overlay  := nil;
  end;

  procedure  TDSVideoWindow.CaptureCanvas(Sender: TObject);
  var renderer : IBaseFilter;
      input    : IPin;
      enum     : IEnumPins;
      Overlay  : IOverlay;
      wh       : HWND;
      NewDC    : HDC;
      colorkey : TColorKey;
      MyColor  : TOverlayColor;
  begin
    if assigned(FGraph) then
    begin
      if (FGraph.GraphBuilder.FindFilterByName('Video Renderer', renderer) = S_OK) then
      begin
        renderer.EnumPins(enum);
        enum.Next(1,input,nil);
        if (input.QueryInterface(IID_IOverlay, overlay) = S_OK) then
        begin
          overlay.GetWindowHandle(wh);
          NewDC := getdc(wh);
          self.Canvas.Handle := NewDC;
          overlay.GetDefaultColorKey(colorkey);
          MyColor.low := colorkey.LowColorValue;
          MyColor.hight := colorkey.HighColorValue;
          self.Canvas.Brush.Color := MyColor.color;
          releasedc(wh,NewDC);
          //result := true;
        end;
      end;
    end;
    renderer := nil;
    input    := nil;
    enum     := nil;
    Overlay  := nil;
  end;

  procedure TDSVideoWindow.ReleaseCanvas(Sender: TObject);
  begin
    self.Canvas.Handle := 0;
  end;

  function TDSVideoWindow.VideoAvailable: boolean;
  begin
    result := false;
    if assigned(FGraph) then
      if assigned(FGraph.VideoWindow) then result := true;
  end;

  function TDSVideoWindow.StartFullScreen: boolean;
  var OrigStyle, OrigStyleEx: Longint;
  begin
    result := false;
    if VideoAvailable then
    begin
      with FGraph.VideoWindow do
      begin
        get_WindowStyle(OrigStyle);
        get_WindowStyleEx(OrigStyleEx);
        put_Owner(0);
        put_WindowStyle(OrigStyle and not(WS_BORDER or WS_CAPTION or WS_THICKFRAME));
        put_WindowStyleEx(OrigStyleEx and not(WS_EX_CLIENTEDGE or WS_EX_STATICEDGE
          or WS_EX_WINDOWEDGE or WS_EX_DLGMODALFRAME) or WS_EX_TOPMOST);
        SetWindowPosition(0,0,screen.Width,screen.Height);
        FIsFullScreen := true;
        result := true;
      end;
    end;
  end;

  function TDSVideoWindow.StopFullScreen: boolean;
  begin
    result := false;
    if VideoAvailable then
    begin
      with FGraph.VideoWindow do
      begin
        put_Owner(self.Parent.Handle);
        put_WindowStyle(WS_CHILD or WS_CLIPSIBLINGS);
        SetWindowPosition(self.Left,self.Top,self.Width,self.Height);
        result := true;
        FIsFullScreen := false;
        self.parent.SetFocus;
      end;
    end;
  end;

//******************************************************************************
//
// TDSGraph implementation
//
//******************************************************************************

  procedure TDSGraph.WndProc(var Msg: TMessage);
  begin
  with Msg do
      if Msg = WM_GRAPHNOTIFY then
        try
          FDoEvent;
        except
          Application.HandleException(Self);
        end
      else
        Result := DefWindowProc(FHandle, Msg, wParam, lParam);
  end;

  constructor TDSGraph.Create(AOwner: TComponent);
  begin
    inherited Create(AOwner);
    FHandle := AllocateHWnd(WndProc);
  end;

  destructor TDSGraph.Destroy;
  begin
    DeallocateHWnd(FHandle);
    inherited Destroy;
  end;

  procedure TDSGraph.FDoEvent;
  var hr: HRESULT;
      Event, Param1, Param2: LongInt;
  begin
    if assigned(MediaEventEx) then
    begin
      hr := MediaEventEx.GetEvent(Event, Param1, Param2, 0);
      while (hr = S_OK) do
      begin
        MediaEventEx.FreeEventParams(Event, Param1, Param2);
        DoEvent(Event, Param1, Param2);
        hr := MediaEventEx.GetEvent(Event, Param1, Param2, 0);
      end;
    end;
  end;

  procedure TDSGraph.DoEvent(Event, Param1, Param2: longint);
  begin
    if assigned(FOnDSEvent) then FOnDSEvent(self, Event, Param1, Param2);
    case Event of
      EC_BUFFERING_DATA            : if assigned(FOnGraphBufferingData) then FOnGraphBufferingData(self,(Param1 = 1));
      EC_CLOCK_CHANGED             : if assigned(FOnGraphClockChanged) then FOnGraphClockChanged(self);
      EC_COMPLETE                  : if assigned(FOnGraphComplete) then FOnGraphComplete(self, Param1, IBaseFilter(Param2));
      EC_DEVICE_LOST               : if assigned(FOnGraphDeviceLost) then FOnGraphDeviceLost(self,IUnKnown(Param1),(Param2 = 1));
      EC_END_OF_SEGMENT            : if assigned(FOnGraphEndOfSegment) then FOnGraphEndOfSegment(self, PReference_Time(Param1)^, Param2);
      EC_ERROR_STILLPLAYING        : if assigned(FOnGraphErrorStillPlaying) then FOnGraphErrorStillPlaying(self, Param1);
      EC_ERRORABORT                : if assigned(FOnGraphErrorAbort) then FOnGraphErrorAbort(self, Param1);
      EC_FULLSCREEN_LOST           : if assigned(FOnGraphFullscreenLost) then FOnGraphFullscreenLost(self, IBaseFilter(Param2));
      EC_GRAPH_CHANGED             : if assigned(FOnGraphChanged) then FOnGraphChanged(self);
      EC_OLE_EVENT                 : if assigned(FOnGraphOleEvent) then FOnGraphOleEvent(self, TBSTR(Param1), TBSTR(Param2));
      EC_OPENING_FILE              : if assigned(FOnGraphOpeningFile) then FOnGraphOpeningFile(self, (Param1 = 1));
      EC_PALETTE_CHANGED           : if assigned(FOnGraphPaletteChanged) then FOnGraphPaletteChanged(self);
      EC_PAUSED                    : if assigned(FOnGraphPaused) then FOnGraphPaused(self, Param1);
      EC_QUALITY_CHANGE            : if assigned(FOnGraphQualityChange) then FOnGraphQualityChange(self);
      EC_SNDDEV_IN_ERROR           : if assigned(FOnGraphSNDDevInError) then FOnGraphSNDDevInError(self, TSNDDEV_ERR(Param1), Param2);
      EC_SNDDEV_OUT_ERROR          : if assigned(FOnGraphSNDDevOutError) then FOnGraphSNDDevOutError(self, TSNDDEV_ERR(Param1), Param2);
      EC_STEP_COMPLETE             : if assigned(FOnGraphStepComplete) then FOnGraphStepComplete(self);
      EC_STREAM_CONTROL_STARTED    : if assigned(FOnGraphStreamControlStarted) then FOnGraphStreamControlStarted(self, IPin(Param1), Param2);
      EC_STREAM_CONTROL_STOPPED    : if assigned(FOnGraphStreamControlStopped) then FOnGraphStreamControlStopped(self, IPin(Param1), Param2);
      EC_STREAM_ERROR_STILLPLAYING : if assigned(FOnGraphStreamErrorStillPlaying) then FOnGraphStreamErrorStillPlaying(self, Param1, Param2);
      EC_STREAM_ERROR_STOPPED      : if assigned(FOnGraphStreamErrorStopped) then FOnGraphStreamErrorStopped(self, Param1, Param2);
      EC_USERABORT                 : if assigned(FOnGraphUserAbort) then FOnGraphUserAbort(self);
      EC_VIDEO_SIZE_CHANGED        : if assigned(FOnGraphVideoSizeChanged) then FOnGraphVideoSizeChanged(self, TVideoSize(Param1));
      EC_TIMECODE_AVAILABLE        : if assigned(FOnGraphTimeCodeAvailable) then FOnGraphTimeCodeAvailable(self,IBaseFilter(Param1), Param2);
      EC_EXTDEVICE_MODE_CHANGE     : if assigned(FOnGraphEXTDeviceModeChange) then FOnGraphEXTDeviceModeChange(self, Param1, Param2);
    end;
  end;

  function TDSGraph.Connected: boolean;
  begin
    result := (GraphBuilder <> nil);
  end;

  procedure TDSGraph.QueryInterfaces;
  begin
    If Assigned(MediaEventEx) then
      MediaEventEx.SetNotifyWindow(FHandle,WM_GRAPHNOTIFY,ULONG(MediaEventEx));
    if assigned(FVW) then FVW.SetGraph(self);
  end;

  procedure TDSGraph.SetROT(value: boolean);
  begin
    if connected then
    case value of
      true  : AddGraphToROT(GraphBuilder, dwregister);
      false : RemoveGraphFromRot(dwregister);
    end;
    FRotEnabled := value;
  end;

  procedure TDSGraph.ClearGraph;
  var EnumFilters : IEnumFilters;
      BaseFilter  : IBaseFilter;
  Begin
    if assigned(GraphBuilder) then
    begin
      if assigned(MediaControl) then MediaControl.Stop;
      if (GraphBuilder.EnumFilters(EnumFilters)=S_OK) then
      begin
        While (EnumFilters.Next(1,BaseFilter,nil)=S_OK) do
        begin
          GraphBuilder.RemoveFilter(BaseFilter);
          EnumFilters.Reset;
        end;
      end;
    end;
  end;
//******************************************************************************
//
// TDSFilterGraph2 implementation
//
//******************************************************************************

  procedure TDSFilterGraph2.InitServerData;
  const
    CServerData: TServerData = (
      ClassID:   '{E436EBB3-524F-11CE-9F53-0020AF0BA770}'; // CLSID_FilterGraph
      IntfIID:   '{36B73882-C2C8-11CF-8B46-00805F6CEF60}'; // IID_IFilterGraph2
      EventIID:  '';
      LicenseKey: nil;
      Version: 500);
  begin
    ServerData := @CServerData;
  end;

  procedure TDSFilterGraph2.DoEvent(Event, Param1, Param2: longint);
  begin
    if assigned(FTB)then
    case Event of
      EC_COMPLETE       : FTB.ReceiveEndOfStream;
      EC_CLOCK_CHANGED  : FTB.Timer;
    end;
    inherited DoEvent(Event, Param1, Param2);
  end;

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

  destructor TDSFilterGraph2.Destroy;
  begin
    inherited Destroy;
  end;

  procedure TDSFilterGraph2.Connect;
  var
    punk: IUnknown;
  begin
    if FilterGraph2 = nil then
    begin
      punk := GetServer;
      FilterGraph2 := punk as IFilterGraph2;
      GraphBuilder := punk as IGraphBuilder; // compatibilty
      if RotEnabled then SetRot(true);
    end;
  end;

  procedure TDSFilterGraph2.Disconnect;
  begin
    if Assigned(MediaEventEx) then
      MediaEventEx.SetNotifyFlags(AM_MEDIAEVENT_NONOTIFY);
    if FilterGraph2 <> nil then
    begin
      if RotEnabled then SetRot(false);
      FilterGraph2    := nil;
      GraphBuilder    := nil;
      MediaControl    := nil;
      MediaEventEx    := nil;
      VideoWindow     := nil;
      BasicAudio      := nil;
      BasicVideo2     := nil;
      MediaSeeking    := nil;
      AMGraphStreams  := nil;
      FilterChain     := nil;
      FilterMapper2   := nil;
      GraphConfig     := nil;
      GraphVersion    := nil;
      MediaEventSink  := nil;
      QueueCommand    := nil;
      ResourceManager := nil;
      VideoFrameStep  := nil;
    end;
  end;

  procedure TDSFilterGraph2.QueryInterfaces;
  begin
    if FilterGraph2 <> nil then
    begin