zw版【转发·*nvp系列Delphi例程】HALCON DirectShow

zw版【转发·*nvp系列Delphi例程】HALCON DirectShow

unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, OleCtrls, HALCONXLib_TLB, StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
HWindowXCtrl1: THWindowXCtrl;
Button1: TButton;
Timer1: TTimer;
procedure FormShow(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
fg : HFramegrabberX;
op : HOperatorSetX;
img : HImageX;
mtype, w, h : OleVariant;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure PatchINT3;
var
NOP : Byte;
NTDLL: THandle;
BytesWritten: DWORD;
Address: Pointer;
begin
if Win32Platform <> VER_PLATFORM_WIN32_NT then
Exit;
NTDLL := GetModuleHandle('NTDLL.DLL');
if NTDLL = 0 then
Exit;
Address := GetProcAddress(NTDLL, 'DbgBreakPoint');
if Address = nil then
Exit;
try
if Char(Address^) <> #$CC then
Exit;
NOP := $90;
if WriteProcessMemory(GetCurrentProcess, Address, @NOP, 1, BytesWritten) and (BytesWritten = 1) then
FlushInstructionCache(GetCurrentProcess, Address, 1);
except
//Do not panic if you see an EAccessViolation here, it is perfectly harmless!
on EAccessViolation do ;
else raise;
end;
end;
procedure TForm1.FormShow(Sender: TObject);
begin
PatchINT3;
op := CoHOperatorSetX.Create;
fg := CoHFramegrabberX.Create;
fg.OpenFramegrabber('DirectShow', 1, 1, 0, 0, 0, 0, 'default', 8, 'rgb', -1, 'false', 'default', '[0] Logitech QuickCam for Notebooks Pro', 0, -1);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if Button1.Caption = 'Grab Start' then
begin
Button1.Caption := 'Grab Stop';
Timer1.Enabled := True;
end
else
begin
Timer1.Enabled := False;
Button1.Caption := 'Grab Start';
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
img := fg.GrabImage;
img.GetImagePointer1(mType,w,h);
HWindowXCtrl1.HalconWindow.SetPart(0,0,h-1,w-1);
img.DispObj(HWindowXCtrl1.HalconWindow);
img.GenEmptyObj;
img := nil;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Timer1.Enabled := False;
op.CloseFramegrabber(fg.Handle);
fg := nil;
end;
end.