// JCL_DEBUG_EXPERT_GENERATEJDBG OFF // JCL_DEBUG_EXPERT_INSERTJDBG OFF // JCL_DEBUG_EXPERT_DELETEMAPFILE OFF program cv_SetMouseCallback; {$APPTYPE CONSOLE} {$R *.res} uses System.SysUtils, Core.types_c in '..\..\include\сore\Core.types_c.pas', core_c in '..\..\include\сore\core_c.pas', highgui_c in '..\..\include\highgui\highgui_c.pas', LibName in '..\..\include\LibName.pas'; Const // имя картинки filename = 'Resource\opencv_logo_with_text.png'; Var image: PIplImage = nil; c: Integer; // рисуем целеуказатель procedure drawTarget(img: PIplImage; x, y, radius: Integer); cdecl; begin cvCircle(img, cvPoint(x, y), radius, CV_RGB(250, 0, 0), 1, 8); cvLine(img, cvPoint(x - radius div 2, y - radius div 2), cvPoint(x + radius div 2, y + radius div 2), CV_RGB(250, 0, 0), 1, 8); cvLine(img, cvPoint(x - radius div 2, y + radius div 2), cvPoint(x + radius div 2, y - radius div 2), CV_RGB(250, 0, 0), 1, 8); end; // обработчик событий от мышки procedure myMouseCallback(event: Integer; x: Integer; y: Integer; flags: Integer; param: Pointer); cdecl; Var img: PIplImage; begin img := PIplImage(param); if event = CV_EVENT_LBUTTONDOWN then begin Writeln(Format('%d x %d', [x, y])); drawTarget(img, x, y, 10); end; end; begin try // получаем картинку image := cvLoadImage(filename, 1); Writeln('[i] image: ', filename); if not Assigned(image) then Halt; // окно для отображения картинки cvNamedWindow('original', CV_WINDOW_AUTOSIZE); // вешаем обработчик мышки cvSetMouseCallback('original', myMouseCallback, image); while True do begin // показываем картинку cvShowImage('original', image); c := cvWaitKey(33); if (c = 27) then break; end; // освобождаем ресурсы cvReleaseImage(image); // удаляем окно cvDestroyWindow('original'); except on E: Exception do Writeln(E.ClassName, ': ', E.Message); end; end.