开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Delphi控件源码 > 查看源码
main.pas
资源名称：qqdelphiprog.rar　[点击查看]
上传用户：hylc_2004
上传日期：2014-01-23
资源大小：46800k
文件大小：3k
源码类别：

Delphi控件源码

开发平台：

Delphi

main.pas：源码内容
  1. unit main;
  3. interface
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  7.   Dialogs, DSUtil, StdCtrls, DSPack, DirectShow9, Menus, ExtCtrls;
  9. type
  10.   TVideoForm = class(TForm)
  11.     FilterGraph: TFilterGraph;
  12.     VideoWindow: TVideoWindow;
  13.     MainMenu1: TMainMenu;
  14.     Devices: TMenuItem;
  15.     Filter: TFilter;
  16.     Image: TImage;
  17.     SampleGrabber: TSampleGrabber;
  18.     SnapShot: TButton;
  19.     CallBack: TCheckBox;
  20.     procedure FormCreate(Sender: TObject);
  21.     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  22.     procedure SnapShotClick(Sender: TObject);
  23.     procedure SampleGrabberBuffer(sender: TObject; SampleTime: Double;
  24.       pBuffer: Pointer; BufferLen: Integer);
  25.   private
  26.     { D閏larations priv閑s }
  27.   public
  28.     { D閏larations publiques }
  29.     procedure OnSelectDevice(sender: TObject);
  30.   end;
  32. var
  33.   VideoForm: TVideoForm;
  34.   SysDev: TSysDevEnum;
  36. implementation
  38. {$R *.dfm}
  40. procedure TVideoForm.FormCreate(Sender: TObject);
  41. var
  42.   i: integer;
  43.   Device: TMenuItem;
  44. begin
  45.   SysDev:= TSysDevEnum.Create(CLSID_VideoInputDeviceCategory);
  46.   if SysDev.CountFilters > 0 then
  47.     for i := 0 to SysDev.CountFilters - 1 do
  48.     begin
  49.       Device := TMenuItem.Create(Devices);
  50.       Device.Caption := SysDev.Filters[i].FriendlyName;
  51.       Device.Tag := i;
  52.       Device.OnClick := OnSelectDevice;
  53.       Devices.Add(Device);
  54.     end;
  55. end;
  57. procedure TVideoForm.OnSelectDevice(sender: TObject);
  58. var
  59.   CaptureGraph: ICaptureGraphBuilder2;
  60.   SourceFilter, SampleFilter, DestFilter: IBaseFilter;
  61. begin
  62.   FilterGraph.ClearGraph;
  63.   FilterGraph.Active := false;
  64.   Filter.BaseFilter.Moniker := SysDev.GetMoniker(TMenuItem(Sender).tag);
  65.   FilterGraph.Active := true;
  66.   FilterGraph.QueryInterface(ICaptureGraphBuilder2, CaptureGraph);
  67.   Filter.QueryInterface(IBaseFilter, SourceFilter);
  68.   SampleGrabber.QueryInterface(IBaseFilter, SampleFilter);
  69.   VideoWindow.QueryInterface(IBaseFilter, DestFilter);
  70.   CaptureGraph.RenderStream(nil, nil, SourceFilter, SampleFilter, DestFilter);
  71.   FilterGraph.Play;
  72.   CaptureGraph := nil;
  73.   SourceFilter := nil;
  74.   SampleFilter := nil;
  75.   DestFilter   := nil;
  76. end;
  78. procedure TVideoForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  79. begin
  80.   CallBack.Checked := False;
  81.   SysDev.Free;
  82.   FilterGraph.ClearGraph;
  83.   FilterGraph.Active := false;
  84. end;
  86. procedure TVideoForm.SnapShotClick(Sender: TObject);
  87. begin
  88.   SampleGrabber.GetBitmap(Image.Picture.Bitmap);
  89. end;
  91. procedure TVideoForm.SampleGrabberBuffer(sender: TObject;
  92.   SampleTime: Double; pBuffer: Pointer; BufferLen: Integer);
  93. begin
  94.   if CallBack.Checked then
  95.   begin
  96.     Image.Canvas.Lock;
  97.     try
  98.       SampleGrabber.GetBitmap(Image.Picture.Bitmap, pBuffer, BufferLen);
  99.     finally
  100.       Image.Canvas.Unlock;
  101.     end;
  102.   end;
  103. end;
  105. end.