unit1.pas

saa713xDiagram.src.zip saa713x芯片的底层功能测试

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,ExtCtrls{,ExceptionLog}, XPMan, Unit2;

type
  TForm1 = class(TForm)
    XPManifest1: TXPManifest;
    ScrollBox1: TScrollBox;
    Image1: TImage;
    Button1: TButton;
    Label1: TLabel;
    procedure FormShow(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    private
    thr: SecondThread;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
uses DirectShow9, ActiveX;

procedure TForm1.FormShow(Sender: TObject);
begin
thr:=SecondThread.Create(true);

Assert(CoCreateInstance(CLSID_SystemDeviceEnum,Nil,CLSCTX_INPROC_SERVER,ICreateDevEnum,thr.enum)=S_OK,'CoCreateInstance failed');
if ( thr.enum.CreateClassEnumerator(CLSID_VideoInputDeviceCategory,thr.pEnumCat, 0)<>S_OK) Then
   begin
   thr.enum:=nil;
   ShowMessage('Can''t find the tv tuner card.');
   form1.Close;
   exit;
   end;
thr.pEnumCat.Next(1,thr.pMonker, @thr.cFetched);
while (thr.cFetched=1) do
   begin
   Assert(thr.pMonker.BindToStorage(Nil, Nil, IPropertyBag, thr.pPropBag)=S_OK,'BindToStorage failed');
   Assert(thr.pPropBag.Read('FriendlyName', thr.varName, Nil)=S_OK,'IPropertyBag->Read failed');
   if(thr.varName='713x BDA Analog Capture')Then
      Assert(thr.pMonker.BindToObject(nil,nil,IBaseFilter,thr.bFilter)=S_OK,'pMonker->BindToObject failed');
   thr.pPropBag:=nil;
   thr.pMonker:=nil;
   thr.pEnumCat.Next(1,thr.pMonker, @thr.cFetched);
   end;
thr.pEnumCat:=nil;
thr.enum:=nil;
if(thr.bFilter=nil)Then
   begin
   Application.MessageBox('''713x BDA Analog Capture'' card couln''t be found.','Error',MB_OK);
   halt;
   end;
Assert(thr.bFilter.QueryInterface(IKsControl,thr.pControl)=S_OK,'QueryInterface(IKsControl,pControl)');
thr.pControl.QueryInterface(IKsPropertySet,thr.KsProp);
thr.card:=0;
fillchar(thr.KSEv,sizeof(thr.KSEv),0);
thr.KSEv.Set_:=IID_Daljinsko;
thr.KSEv.Id:=4;
thr.KSEv.Flags:=1;
fillchar(thr.ED,sizeof(thr.ED),0);
thr.ED.id:=1;
thr.ED.h:=CreateEvent(Nil,False,False,Nil);;
thr.pControl.KsEvent(@thr.KSEv,sizeof(thr.KSEv),@thr.ED,Sizeof(thr.ED),thr.card);

//SetEurekaLogInThread(thr.ThreadID,true);
Button1.Enabled := False;
thr.Resume;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
image1.Picture.SaveToFile('picture.bmp');
end;

end.