首页 > Windows开发 > 详细

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

时间:2015-10-01 20:22:17      阅读:224      评论:0      收藏:0      [点我收藏+]

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.

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

原文:http://www.cnblogs.com/ziwang/p/4851471.html

(0)
(0)
   
举报
评论 一句话评论(0
关于我们 - 联系我们 - 留言反馈 - 联系我们:wmxa8@hotmail.com
© 2014 bubuko.com 版权所有
打开技术之扣,分享程序人生!