USBカメラ、ウェブカム、ビデオキャプチャ、HDMIキャプチャなどの映像を取り込む。
IO-DATA GV-USB3/HD、GV-USB2 などで動作確認
ラッパーパーコンポーネント一式を Delphi-OpenCV からダウンロードする。
含まれる ocv.*.pas , *2413.dll , *2413d.dll が必要
RAD Studio Delphi 10.1 Berlin / 10.2 Tokyo 向け
unit main; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, ocv.highgui_c, Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.Buttons; type TFormMain = class(TForm) ImageVideo: TImage; Memo1: TMemo; Timer1: TTimer; procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure FormShow(Sender: TObject); procedure Timer1Timer(Sender: TObject); private { Private 宣言 } capture: pCvCapture; frameBitmap: TBitmap; procedure OnIdle(Sender: TObject; var Done: Boolean); public { Public 宣言 } end; var FormMain: TFormMain; implementation {$R *.dfm} uses ocv.core.types_c, ocv.utils; procedure TFormMain.FormCreate(Sender: TObject); begin // OpenCV capture := cvCreateCameraCapture(CV_CAP_ANY); if Assigned(capture) then begin // HD cvSetCaptureProperty(capture, CV_CAP_PROP_FRAME_WIDTH, 1920); cvSetCaptureProperty(capture, CV_CAP_PROP_FRAME_HEIGHT, 1080); cvSetCaptureProperty(capture, CV_CAP_PROP_FPS, 60); // Video // cvSetCaptureProperty(capture, CV_CAP_PROP_FRAME_WIDTH, 640); // cvSetCaptureProperty(capture, CV_CAP_PROP_FRAME_HEIGHT, 480); end; frameBitmap := TBitmap.Create; frameBitmap.PixelFormat := pf24bit; frameBitmap.HandleType := bmDIB; end; procedure TFormMain.FormDestroy(Sender: TObject); begin if Assigned(capture) then cvReleaseCapture(capture); if Assigned(frameBitmap) then frameBitmap.Free; end; procedure TFormMain.FormShow(Sender: TObject); begin if Assigned(capture) then begin // Application.OnIdle := OnIdle; Timer1.Enabled := true; end; end; procedure TFormMain.OnIdle(Sender: TObject; var Done: Boolean); var frame: pIplImage; begin frame := cvQueryFrame(capture); if Assigned(frame) then begin IplImage2Bitmap(frame, frameBitmap); ImageVideo.Canvas.StretchDraw(ImageVideo.ClientRect, frameBitmap); Done := False; end else Application.OnIdle := nil; end; procedure TFormMain.Timer1Timer(Sender: TObject); var done: Boolean; begin OnIdle(nil, done); end; end.