⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 unit1.pas

📁 摄像头视频捕捉程序
💻 PAS
字号:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, ExtCtrls, StdCtrls, ComCtrls, dspack, DirectShow, OleServer, dsutil;

type
  TForm1 = class(TForm)
    VideoWindow: TDSVideoWindow;
    Memo1: TMemo;
    Splitter1: TSplitter;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Exit1: TMenuItem;
    StatusBar: TStatusBar;
    CaptureGraph: TDSCaptureGraph;
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure CaptureGraphDSEvent(sender: TOleServer; Event, Param1,
      Param2: Integer);
    procedure Exit1Click(Sender: TObject);
  private
    { D閏larations priv閑s }
  public
    { D閏larations publiques }
  end;

var
  Form1: TForm1;
implementation

{$R *.DFM}

procedure TForm1.FormShow(Sender: TObject);
var sysenum: TDSSysDevEnum;
    source: IBaseFilter;
begin
  CaptureGraph.Connect;
  sysenum := TDSSysDevEnum.Create;
  sysenum.SelectGUIDCategory(CLSID_VideoInputDeviceCategory); // select video Capture category
  if (sysenum.CountFilters = 0) then
    begin
      Messagebox(0,'No video capture device found','error',id_ok);
      sysenum.Destroy;
      CaptureGraph.Disconnect;
      Application.Terminate;
    end;
  source := sysenum.GetBaseFilterByIndex(0); // get the first Filter capture device
  StatusBar.SimpleText := sysenum.Filters[0].FriendlyName; // get the filter name
  CaptureGraph.GraphBuilder.AddFilter(source, 'Video Capture'); // Add filter to graph
  sysenum.Destroy;
  CaptureGraph.CaptureGraphBuilder2.RenderStream(@PIN_CATEGORY_CAPTURE,@MEDIATYPE_Video,source,nil,nil); // build gaph
  CaptureGraph.QueryInterfaces;
  CaptureGraph.MediaControl.Run;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
CaptureGraph.Disconnect;
end;

procedure TForm1.CaptureGraphDSEvent(sender: TOleServer; Event, Param1,
  Param2: Integer);
begin
  memo1.Lines.Add(GetEventCodeDef(event));
end;

procedure TForm1.Exit1Click(Sender: TObject);
begin
  close;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -