Espectacular simulación realizada con OpenGL del movimiento de los electrones cuando atraviesan un campo eléctrico.
Esta aplicación genera un array de vértices utilizados para construir curvas de Bezier. Requiere que la tarjeta gráfica sea compatible con OpenGL.
(* /*****************************************************************
// Delphi-OpenCV Demo
// Copyright (C) 2013 Project Delphi-OpenCV
// ****************************************************************
// Contributor:
// Mikhail Grigorev
// email: sleuthhound@gmail.com
// ****************************************************************
// You may retrieve the latest version of this file at the GitHub,
// located at git://github.com/Laex/Delphi-OpenCV.git
// ****************************************************************
// The contents of this file are used with permission, subject to
// the Mozilla Public License Version 1.1 (the "License"); you may
// not use this file except in compliance with the License. You may
// obtain a copy of the License at
// http://www.mozilla.org/MPL/MPL-1_1Final.html
//
// Software distributed under the License is distributed on an
// "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
// implied. See the License for the specific language governing
// rights and limitations under the License.
******************************************************************* *)
// JCL_DEBUG_EXPERT_GENERATEJDBG OFF
// JCL_DEBUG_EXPERT_INSERTJDBG OFF
// JCL_DEBUG_EXPERT_DELETEMAPFILE OFF
program MotionDetect;
{$APPTYPE CONSOLE}
{$POINTERMATH ON}
{$R *.res}
uses
System.SysUtils,
Math,
uLibName in '..\..\..\include\uLibName.pas',
highgui_c in '..\..\..\include\highgui\highgui_c.pas',
imgproc.types_c in '..\..\..\include\imgproc\imgproc.types_c.pas',
imgproc_c in '..\..\..\include\imgproc\imgproc_c.pas',
imgproc in '..\..\..\include\imgproc\imgproc.pas',
core in '..\..\..\include\core\core.pas',
core.types_c in '..\..\..\include\core\Core.types_c.pas',
core_c in '..\..\..\include\core\core_c.pas';
var
storage: pCvMemStorage = nil;
capture: pCvCapture = nil;
frame: pIplImage = nil;
frame_grey: pIplImage = nil;
difference_img: pIplImage = nil;
oldframe_grey: pIplImage = nil;
contours: pCvSeq = nil;
c: pCvSeq = nil;
// rect: TCvRect;
rect2d: TCvBox2D;
key: integer;
first: boolean = true;
begin
try
capture := cvCreateCameraCapture(0);
storage := cvCreateMemStorage(0);
frame := cvQueryFrame(capture);
frame_grey := cvCreateImage(cvSize(frame^.width, frame^.height), IPL_DEPTH_8U, 1);
while true do
begin
frame := cvQueryFrame(capture);
if frame = nil then
break;
cvCvtColor(frame, frame_grey, CV_RGB2GRAY);
if first then
begin
difference_img := cvCloneImage(frame_grey);
oldframe_grey := cvCloneImage(frame_grey);
cvConvertScale(frame_grey, oldframe_grey, 1.0, 0.0);
first := false;
end;
cvAbsDiff(oldframe_grey, frame_grey, difference_img);
cvSmooth(difference_img, difference_img, CV_BLUR);
cvThreshold(difference_img, difference_img, 25, 255, CV_THRESH_BINARY);
contours := AllocMem(SizeOf(TCvSeq));
cvFindContours(difference_img, storage, @contours, SizeOf(TCvContour), CV_RETR_LIST, CV_CHAIN_APPROX_NONE,
cvPoint(0, 0));
c := contours;
while (c <> nil) do
begin
rect2d := cvMinAreaRect2(c);
cvRectangle(frame, cvPoint(Round(rect2d.center.x - rect2d.size.width / 2),
Round(rect2d.center.y - rect2d.size.height / 2)), cvPoint(Round(rect2d.center.x + rect2d.size.width / 2),
Round(rect2d.center.y + rect2d.size.height / 2)), cvScalar(0, 0, 255, 0), 2, 8, 0);
c := c.h_next;
end;
cvShowImage('Output Image', frame);
cvShowImage('Difference Image', difference_img);
cvConvertScale(frame_grey, oldframe_grey, 1.0, 0.0);
cvClearMemStorage(storage);
c := nil;
FreeMem(contours, SizeOf(TCvSeq));
key := cvWaitKey(33);
if (key = 27) then
break;
end;
cvReleaseMemStorage(storage);
cvReleaseCapture(capture);
cvReleaseImage(oldframe_grey);
cvReleaseImage(difference_img);
cvReleaseImage(frame_grey);
cvDestroyAllWindows();
except
on E: Exception do
WriteLn(E.ClassName, ': ', E.Message);
end;
end.
Posteriormente se puede hacer clic mantenido sobre una partícula cualquiera para moverla.
Autor:
Paul TOTH
http://tothpaul.free.fr
Codigo fuente
UNIT Unit1;
INTERFACE
USES
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls;
TYPE
TForm1 = CLASS(TForm)
Image1: TImage;
Timer1: TTimer;
PROCEDURE FormCreate(Sender: TObject);
PROCEDURE Timer1Timer(Sender: TObject);
PROCEDURE QuitClick(Sender: TObject);
PROCEDURE Image1Click(Sender: TObject);
PRIVATE
{ Private declarations }
PUBLIC
{ Public declarations }
END;
TYPE
co_ordinate = RECORD
x, y: integer;
END;
TYPE
scanline = ARRAY [0 .. 319] OF byte;
VAR
Form1: TForm1;
Threshold: integer;
blobimage: tbitmap;
blobs: ARRAY [0 .. 5] OF co_ordinate;
Frame: Cardinal;
drawing: boolean;
IMPLEMENTATION
{$R *.DFM}
PROCEDURE TForm1.FormCreate(Sender: TObject);
VAR
Temp: integer;
pal: PLogPalette;
hpal: HPALETTE;
BEGIN
Frame := 0;
blobimage := tbitmap.create;
blobimage.width := 320;
blobimage.height := 240;
blobimage.PixelFormat := pf8bit;
Image1.Picture.Bitmap := blobimage;
pal := NIL;
TRY
GetMem(pal, sizeof(TLogPalette) + sizeof(TPaletteEntry) * 255);
pal.palVersion := $300;
pal.palNumEntries := 256;
FOR Temp := 0 TO 255 DO
BEGIN
pal.palPalEntry[Temp].peRed := 255 - Temp; { (temp * 4)-1; }
pal.palPalEntry[Temp].peGreen := 0;
pal.palPalEntry[Temp].peBlue := 128 - Temp;
END;
hpal := CreatePalette(pal^);
IF hpal <> 0 THEN
Image1.Picture.Bitmap.Palette := hpal;
FINALLY
FreeMem(pal);
END;
application.ProcessMessages;
Timer1.Enabled := true;
END;
PROCEDURE TForm1.Timer1Timer(Sender: TObject);
VAR
X_Loop, Y_Loop, I: integer;
Value, t: integer;
Scan: ^scanline;
BEGIN
Frame := Frame + 1;
IF drawing = false THEN
BEGIN
blobs[0].x := 160 + round(150 * SIN((2 * Frame) * 0.01745329252222));
blobs[0].y := 100 + round(90 * SIN((4 * Frame) * 0.01745329252222));
blobs[1].x := 160 + round(150 * SIN((6 * Frame) * 0.01745329252222));
blobs[1].y := 100 + round(90 * SIN((3 * Frame) * 0.01745329252222));
blobs[2].x := 160 + round(150 * SIN((7 * Frame) * 0.01745329252222));
blobs[2].y := 100 + round(90 * SIN((5 * Frame) * 0.01745329252222));
blobs[3].x := 160 + round(150 * SIN((3 * Frame) * 0.01745329252222));
blobs[3].y := 100 + round(90 * SIN((2 * Frame) * 0.01745329252222));
blobs[4].x := 160 + round(150 * SIN((4 * Frame) * 0.01745329252222));
blobs[4].y := 100 + round(90 * SIN((2 * Frame) * 0.01745329252222));
blobs[5].x := 160 + round(150 * SIN((2 * Frame) * 0.01745329252222));
blobs[5].y := 100 + round(90 * SIN((3 * Frame) * 0.01745329252222));
drawing := true;
FOR Y_Loop := 0 TO 239 DO
BEGIN
Scan := Image1.Picture.Bitmap.scanline[Y_Loop];
FOR X_Loop := 0 TO 319 DO
BEGIN
t := 0;
FOR I := 0 TO 5 DO
BEGIN
Value := (blobs[I].x - X_Loop) * (blobs[I].x - X_Loop);
Value := Value + (blobs[I].y - Y_Loop) * (blobs[I].y - Y_Loop);
IF Value < 1 THEN
Value := 1;
t := t + (100000 DIV Value);
END;
t := 255 - t;
IF t < 0 THEN
t := 0;
Scan[X_Loop] := t;
{ if t >= 200 then scan[x_loop] := 0 else scan[x_loop] := 10; }
END;
END;
Image1.Refresh;
application.ProcessMessages;
drawing := false;
END;
END;
PROCEDURE TForm1.QuitClick(Sender: TObject);
BEGIN
Timer1.Enabled := false;
application.Terminate;
END;
PROCEDURE TForm1.Image1Click(Sender: TObject);
BEGIN
Timer1.Enabled := false;
application.Terminate;
END;
END.
Espectacular simulación realizada con OpenGL del movimiento de los electrones cuando atraviesan un campo eléctrico. Como muestra la image...
