以前のリビジョンの文書です


Delphi で OpenCV を動かす

USBカメラ、ウェブカム、ビデオキャプチャ、HDMIキャプチャなどの映像を取り込む。

IO-DATA GV-USB3/HD、GV-USB2 などで動作確認

Program

ラッパーパーコンポーネント一式を 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 image
    cvSetCaptureProperty(capture, CV_CAP_PROP_FRAME_WIDTH, 1920);
    cvSetCaptureProperty(capture, CV_CAP_PROP_FRAME_HEIGHT, 1080);
    cvSetCaptureProperty(capture, CV_CAP_PROP_FPS, 60);
  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.
文書の先頭へ
delphi-opencv.1522723550.txt.gz · 最終更新: 2018/04/03 11:45 by sugakoubou