zw版【转发·台湾nvp系列Delphi例程】HALCON HWindow Overlayer 1

zw版【转发·台湾nvp系列Delphi例程】HALCON HWindow Overlayer 1

------------------------------------
HALCON HWindow Overlayer 1

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;
rg : HRegionX;
op : HOperatorSetX;
img : HImageX;
mtype, w, h : OleVariant;
hw : THWindowXCtrl;
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;
hw := THWindowXCtrl.Create(Self);
hw.Width := HWindowXCtrl1.Width;
hw.Height := HWindowXCtrl1.Height;
hw.Parent := Self;
hw.Visible := False;
op := CoHOperatorSetX.Create;
rg := CoHRegionX.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);
hw.HalconWindow.SetPart(0,0,h-1,w-1);
img.DispObj(hw.HalconWindow);
rg := img.Threshold(60.0, 180.0);
rg.DispObj(hw.HalconWindow);
hw.HalconWindow.CopyRectangle(HWindowXCtrl1.HalconWindow, 0, 0, HWindowXCtrl1.Height-1, HWindowXCtrl1.Width-1, 0, 0);
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Timer1.Enabled := False;
op.CloseFramegrabber(fg.Handle);
fg := nil;
img := nil;
rg := nil;
end;
end.

------------------------------------
HALCON HWindow Overlayer 2

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;
HWindowXCtrl2: THWindowXCtrl;
procedure FormShow(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
fg : HFramegrabberX;
rg : HRegionX;
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;
HWindowXCtrl2.Width := HWindowXCtrl1.Width;
HWindowXCtrl2.Height := HWindowXCtrl1.Height;
HWindowXCtrl2.Parent := Self;
HWindowXCtrl2.Visible := False;
op := CoHOperatorSetX.Create;
rg := CoHRegionX.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);
HWindowXCtrl2.HalconWindow.SetPart(0,0,h-1,w-1);
img.DispObj(HWindowXCtrl2.HalconWindow);
rg := img.Threshold(60.0, 180.0);
rg.DispObj(HWindowXCtrl2.HalconWindow);
HWindowXCtrl2.HalconWindow.CopyRectangle(HWindowXCtrl1.HalconWindow, 0, 0, HWindowXCtrl1.Height-1, HWindowXCtrl1.Width-1, 0, 0);
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Timer1.Enabled := False;
op.CloseFramegrabber(fg.Handle);
fg := nil;
img := nil;
rg := nil;
end;
end.