// ***************************************************************** // Delphi-OpenCV Demo // Copyright (C) 2013 Project Delphi-OpenCV // **************************************************************** // Contributor: // Laentir Valetov // email:laex@bk.ru // **************************************************************** // 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. // ******************************************************************* {$IFNDEF CLR} {$I OpenCV.inc} unit ocv.comp.Source; {$ENDIF} interface uses {$IFDEF HAS_UNITSCOPE} System.SysUtils, System.Classes, System.SyncObjs, {$ELSE} SysUtils, Classes, SyncObjs, {$ENDIF} ocv.core.types_c, ocv.highgui_c, ffm.libavcodec.avcodec, ocv.comp.Types; type TocvCameraCaptureSource = // (CAP_ANY { = 0 } , // autodetect CAP_CAM_0 { =0 } , // CAP_CAM_1 { =1 } , // CAP_CAM_2 { =2 } , // CAP_CAM_3 { =3 } , // CAP_CAM_4 { =4 } , // CAP_CAM_5 { =5 } , // CAP_MIL { = 100 } , // MIL proprietary drivers CAP_VFW { = 200 } , // platform native CAP_V4L { = 200 } , // CAP_V4L2 { = 200 } , // CAP_FIREWARE { = 300 } , // IEEE 1394 drivers CAP_FIREWIRE { = 300 } , // CAP_IEEE1394 { = 300 } , // CAP_DC1394 { = 300 } , // CAP_CMU1394 { = 300 } , // CAP_STEREO { = 400 } , // TYZX proprietary drivers CAP_TYZX { = 400 } , // TYZX_LEFT { = 400 } , // TYZX_RIGHT { = 401 } , // TYZX_COLOR { = 402 } , // TYZX_Z { = 403 } , // CAP_QT { = 500 } , // QuickTime CAP_UNICAP { = 600 } , // Unicap drivers CAP_DSHOW { = 700 } , // DirectShow (via videoInput) CAP_PVAPI { = 800 } , // PvAPI, Prosilica GigE SDK CAP_OPENNI { = 900 } , // OpenNI (for Kinect) CAP_OPENNI_ASUS { = 910 } , // OpenNI (for Asus Xtion) CAP_ANDROID { = 1000 } , // Android CAP_XIAPI { = 1100 } , // XIMEA Camera API CAP_AVFOUNDATION { = 1200 } ); type TocvCustomSourceThread = class(TThread) private FOnNotifyData: TOnOcvNotify; FOnNoData: TNotifyEvent; FThreadDelay: Integer; FLock: TCriticalSection; public constructor Create(CreateSuspended: Boolean); destructor Destroy; override; property OnNoData: TNotifyEvent Read FOnNoData write FOnNoData; property OnNotifyData: TOnOcvNotify Read FOnNotifyData write FOnNotifyData; end; TocvCustomSource = class(TocvDataSource) protected FSourceThread: TocvCustomSourceThread; FThreadDelay: Integer; procedure OnNotifyData(Sender: TObject; Var IplImage: IocvImage); virtual; procedure SetEnabled(Value: Boolean); virtual; function GetEnabled: Boolean; override; private FEnabled: Boolean; FOnImage: TOnOcvNotify; procedure TerminateSourceThread; virtual; procedure ReleaseSource; virtual; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; published property Enabled: Boolean Read GetEnabled write SetEnabled default False; property OnImage: TOnOcvNotify read FOnImage write FOnImage; property ImageWidth: Integer Read GetWidth; property ImageHeight: Integer Read GetHeight; property FPS: Double read GetFPS; end; TocvCaptureSource = class(TocvCustomSource) protected FCapture: pCvCapture; procedure Loaded; override; private procedure ReleaseSource; override; public constructor Create(AOwner: TComponent); override; end; TocvResolution = (r160x120, r320x240, r424x240, r640x360, r800x448, r960x544, r1280x720); TocvCameraSource = class(TocvCaptureSource) protected procedure SetEnabled(Value: Boolean); override; private FCaptureSource: TocvCameraCaptureSource; FResolution: TocvResolution; procedure SetCameraSource(const Value: TocvCameraCaptureSource); procedure SetResolution(const Value: TocvResolution); procedure SetCameraResolution; public constructor Create(AOwner: TComponent); override; published property Camera: TocvCameraCaptureSource read FCaptureSource write SetCameraSource default CAP_ANY; property Resolution: TocvResolution read FResolution write SetResolution default r160x120; end; TocvFileSource = class(TocvCaptureSource) protected procedure SetEnabled(Value: Boolean); override; procedure OnNoData(Sender: TObject); private FFileName: TFileName; FLoop: Boolean; FOnEndOfFile: TNotifyEvent; FDelay: Integer; procedure SetFileName(const Value: TFileName); procedure SetDelay(const Value: Integer); public constructor Create(AOwner: TComponent); override; published property Delay: Integer read FDelay write SetDelay default (1000 div 25); property FileName: TFileName read FFileName write SetFileName; property Loop: Boolean read FLoop write FLoop default True; property OnEndOfFile: TNotifyEvent read FOnEndOfFile Write FOnEndOfFile; end; TocvIPProtocol = ( // ippHTTP, // ippHTTPS, // ippRTSP // ); // TocvIPCamSource = class(TocvCaptureSource) private FPort: Word; FPassword: string; FIP: string; FUserName: String; FURI: string; FProtocol: TocvIPProtocol; protected function GetIPCamTarget: AnsiString; procedure SetEnabled(Value: Boolean); override; public constructor Create(AOwner: TComponent); override; published property UserName: String read FUserName write FUserName; property Password: string read FPassword write FPassword; property IP: string read FIP write FIP; property URI: string read FURI write FURI; { TODO: Need rename } property Port: Word read FPort write FPort default 554; property Protocol: TocvIPProtocol read FProtocol write FProtocol default ippRTSP; end; TOnNotifyFFMpegPacket = procedure(Sender: TObject; const packet: TAVPacket; const isKeyFrame: Boolean) of object; TocvFFMpegIPCamEvent = (ffocvTryConnect, ffocvConnected, ffocvLostConnection, ffocvReconnect, ffocvErrorGetStream); TOnocvFFMpegIPCamEvent = procedure(Sender: TObject; const Event: TocvFFMpegIPCamEvent) of object; TocvFFMpegIPCamSource = class(TocvCustomSource) private FPort: Word; FPassword: string; FIP: string; FUserName: String; FURI: string; FOnNotifyFFMpegPacket: TOnNotifyFFMpegPacket; FProtocol: TocvIPProtocol; FReconnectDelay: Cardinal; FOnIPCamEvent: TOnocvFFMpegIPCamEvent; procedure SetReconnectDelay(const Value: Cardinal); procedure TerminateSourceThread; override; protected function GetIPCamTarget: AnsiString; procedure SetEnabled(Value: Boolean); override; procedure Loaded; override; procedure DoNotifyPacket(const packet: TAVPacket; const isKeyFrame: Boolean); procedure DoNotifyEvent(Event: TocvFFMpegIPCamEvent); public constructor Create(AOwner: TComponent); override; published property UserName: String read FUserName write FUserName; property Password: string read FPassword write FPassword; property IP: string read FIP write FIP; property URI: string read FURI write FURI; { TODO: Need rename } property Port: Word read FPort write FPort default 554; property Protocol: TocvIPProtocol read FProtocol write FProtocol default ippRTSP; property OnFFMpegPacket: TOnNotifyFFMpegPacket read FOnNotifyFFMpegPacket write FOnNotifyFFMpegPacket; property OnIPCamEvent: TOnocvFFMpegIPCamEvent read FOnIPCamEvent write FOnIPCamEvent; property ReconnectDelay: Cardinal Read FReconnectDelay write SetReconnectDelay default 1000; end; implementation uses ocv.core_c, ffm.avformat, ffm.dict, ffm.avutil, ffm.frame, ffm.swscale, ffm.pixfmt; const IPProtocolString: array [TocvIPProtocol] of AnsiString = ( // 'http://', // 'https://', // 'rtsp://' // ); Type TocvCaptureThread = class(TocvCustomSourceThread) private procedure SetCapture(const Value: pCvCapture); virtual; protected FCapture: pCvCapture; protected procedure Execute; override; public property Capture: pCvCapture read FCapture write SetCapture; end; TocvFFMpegIPCamSourceThread = class(TocvCustomSourceThread) private FEnabled: Boolean; FIPCamURL: AnsiString; FSuspendEvent: TEvent; FOwner: TocvFFMpegIPCamSource; FReconnectDelay: Cardinal; FisReconnect: Boolean; {$IFDEF DELPHIXE2_UP} procedure TerminatedSet; override; {$ENDIF} procedure DoNotyfy(Event: TocvFFMpegIPCamEvent); protected procedure Execute; override; public constructor Create(AOwner: TocvFFMpegIPCamSource); destructor Destroy; override; procedure SetIPCamUrl(const AIPCam: AnsiString; const AEnabled: Boolean); end; const ocvCameraCaptureSource: array [TocvCameraCaptureSource] of Longint = // (CV_CAP_ANY, // autodetect CV_CAP_CAM_0, // CV_CAP_CAM_1, // CV_CAP_CAM_2, // CV_CAP_CAM_3, // CV_CAP_CAM_4, // CV_CAP_CAM_5, // CV_CAP_MIL, // MIL proprietary drivers CV_CAP_VFW, // platform native CV_CAP_V4L, // CV_CAP_V4L2, // CV_CAP_FIREWARE, // IEEE 1394 drivers CV_CAP_FIREWIRE, // CV_CAP_IEEE1394, // CV_CAP_DC1394, // CV_CAP_CMU1394, // CV_CAP_STEREO, // TYZX proprietary drivers CV_CAP_TYZX, // CV_TYZX_LEFT, // CV_TYZX_RIGHT, // CV_TYZX_COLOR, // CV_TYZX_Z, // CV_CAP_QT, // QuickTime CV_CAP_UNICAP, // Unicap drivers CV_CAP_DSHOW, // DirectShow (via videoInput) CV_CAP_PVAPI, // PvAPI; Prosilica GigE SDK CV_CAP_OPENNI, // OpenNI (for Kinect) CV_CAP_OPENNI_ASUS, // OpenNI (for Asus Xtion) CV_CAP_ANDROID, // Android CV_CAP_XIAPI, // XIMEA Camera API CV_CAP_AVFOUNDATION); Type TCameraResolution = record cWidth, cHeight: Integer; end; Const CameraResolution: array [TocvResolution] of TCameraResolution = ((cWidth: 160; cHeight: 120), (cWidth: 320; cHeight: 240), (cWidth: 424; cHeight: 240), (cWidth: 640; cHeight: 360), (cWidth: 800; cHeight: 448), (cWidth: 960; cHeight: 544), (cWidth: 1280; cHeight: 720)); { TOpenCVCameraThread } procedure TocvCaptureThread.Execute; Var frame: pIplImage; begin while not Terminated do if Assigned(FCapture) then begin try FLock.Enter; try frame := cvQueryFrame(FCapture); finally FLock.Leave; end; if not Terminated then begin if Assigned(frame) then begin if Assigned(OnNotifyData) then Synchronize( procedure Var Image: IocvImage; begin Image := TocvImage.CreateClone(frame); OnNotifyData(Self, Image); Image := nil; end); Sleep(FThreadDelay); end else if Assigned(OnNoData) then OnNoData(Self); end; except end; end else Suspend; end; { TOpenCVCamera } constructor TocvCameraSource.Create(AOwner: TComponent); begin inherited; FEnabled := False; Resolution := r160x120; end; procedure TocvCameraSource.SetCameraSource(const Value: TocvCameraCaptureSource); Var isEnabled: Boolean; begin if FCaptureSource <> Value then begin isEnabled := Enabled; if Assigned(FCapture) and FEnabled then Enabled := False; FCaptureSource := Value; Enabled := isEnabled; end; end; procedure TocvCameraSource.SetEnabled(Value: Boolean); begin if FEnabled <> Value then begin if not(csDesigning in ComponentState) then begin if Assigned(FCapture) and FEnabled then begin (FSourceThread as TocvCaptureThread).Capture := nil; cvReleaseCapture(FCapture); FCapture := Nil; end; if Value then begin FCapture := cvCreateCameraCapture(ocvCameraCaptureSource[FCaptureSource]); if Assigned(FCapture) then begin SetCameraResolution; FFPS := cvGetCaptureProperty(FCapture, CV_CAP_PROP_FPS); (FSourceThread as TocvCaptureThread).Capture := FCapture; FSourceThread.Resume; end; end; end; FEnabled := Value; end; end; procedure TocvCameraSource.SetCameraResolution; begin cvSetCaptureProperty(FCapture, CV_CAP_PROP_FRAME_WIDTH, CameraResolution[FResolution].cWidth); cvSetCaptureProperty(FCapture, CV_CAP_PROP_FRAME_HEIGHT, CameraResolution[FResolution].cHeight); end; procedure TocvCameraSource.SetResolution(const Value: TocvResolution); begin FWidth := CameraResolution[Value].cWidth; FHeight := CameraResolution[Value].cHeight; if FResolution <> Value then begin FResolution := Value; if Enabled then begin Enabled := False; Enabled := True; end; end; end; { TocvCustomSource } constructor TocvCustomSource.Create(AOwner: TComponent); begin inherited; FThreadDelay := 10; FEnabled := False; end; destructor TocvCustomSource.Destroy; begin TerminateSourceThread; ReleaseSource; inherited; end; function TocvCustomSource.GetEnabled: Boolean; begin Result := FEnabled; end; procedure TocvCustomSource.OnNotifyData(Sender: TObject; Var IplImage: IocvImage); begin FWidth := IplImage.Width; FHeight := IplImage.Height; FImage := IplImage.Clone; if Assigned(OnImage) then OnImage(Self, IplImage); NotifyReceiver(IplImage); end; procedure TocvCustomSource.SetEnabled(Value: Boolean); begin end; procedure TocvCustomSource.TerminateSourceThread; begin if Assigned(FSourceThread) then begin FSourceThread.Terminate; if FSourceThread.Suspended then FSourceThread.Resume; FSourceThread := Nil; end; end; procedure TocvCustomSource.ReleaseSource; begin end; { TocvFileSourceclass } constructor TocvFileSource.Create(AOwner: TComponent); begin inherited; FLoop := True; FDelay := (1000 div 25); end; procedure TocvFileSource.OnNoData(Sender: TObject); begin if Assigned(FOnEndOfFile) then FOnEndOfFile(Self); if Loop then begin Enabled := False; Enabled := True; end; end; procedure TocvFileSource.SetDelay(const Value: Integer); begin if FDelay <> Value then begin FDelay := Value; if Assigned(FSourceThread) then FSourceThread.FThreadDelay := FDelay; end; end; procedure TocvFileSource.SetEnabled(Value: Boolean); begin if FEnabled <> Value then begin if not(csDesigning in ComponentState) then begin if Assigned(FCapture) and FEnabled then begin (FSourceThread as TocvCaptureThread).Capture := nil; cvReleaseCapture(FCapture); FCapture := Nil; end; if Value then begin FCapture := cvCreateFileCapture(PAnsiChar(AnsiString(FileName))); if Assigned(FCapture) then begin (FSourceThread as TocvCaptureThread).Capture := FCapture; FSourceThread.Resume; end; end; end; FEnabled := Value; end; end; procedure TocvFileSource.SetFileName(const Value: TFileName); Var _Enabled: Boolean; begin if FFileName <> Value then begin _Enabled := Enabled; Enabled := False; FFileName := Value; Enabled := _Enabled; end; end; { TocvCustomSourceThread } constructor TocvCustomSourceThread.Create(CreateSuspended: Boolean); begin inherited; FThreadDelay := 10; FLock := TCriticalSection.Create; end; destructor TocvCustomSourceThread.Destroy; begin FLock.Free; inherited; end; { TocvIPCamSource } constructor TocvIPCamSource.Create(AOwner: TComponent); begin inherited; FPort := 554; FProtocol := ippRTSP; end; function TocvIPCamSource.GetIPCamTarget: AnsiString; begin Result := IPProtocolString[FProtocol]; if Length(Trim(UserName)) <> 0 then Result := Result + AnsiString(Trim(UserName)) + ':' + AnsiString(Trim(Password)) + '@'; Result := Result + AnsiString(IP) + ':' + AnsiString(IntToStr(Port)); if Length(Trim(URI)) > 0 then begin if (Result[Length(Result)] <> '/') and (URI[1] <> '/') then Result := Result + '/'; Result := Result + AnsiString(URI); end; end; procedure TocvIPCamSource.SetEnabled(Value: Boolean); begin if FEnabled <> Value then begin if not(csDesigning in ComponentState) then begin if Assigned(FCapture) and FEnabled then begin (FSourceThread as TocvCaptureThread).Capture := nil; cvReleaseCapture(FCapture); FCapture := Nil; end; if Value then begin FCapture := cvCreateFileCapture(PAnsiChar(GetIPCamTarget)); if Assigned(FCapture) then begin (FSourceThread as TocvCaptureThread).Capture := FCapture; FSourceThread.Resume; end; end; end; FEnabled := Value; end; end; { TocvCaptureSource } constructor TocvCaptureSource.Create(AOwner: TComponent); begin inherited; if not(csDesigning in ComponentState) then begin FSourceThread := TocvCaptureThread.Create(True); FSourceThread.OnNotifyData := OnNotifyData; FSourceThread.FThreadDelay := FThreadDelay; FSourceThread.FreeOnTerminate := True; end; end; procedure TocvCaptureSource.Loaded; begin inherited; if Enabled and (not Assigned(FCapture)) then begin // Hack FEnabled := False; Enabled := True; end; end; procedure TocvCaptureSource.ReleaseSource; begin inherited; if Assigned(FCapture) then begin cvReleaseCapture(FCapture); FCapture := nil; end; end; { TocvFFMpegIPCamSource } constructor TocvFFMpegIPCamSource.Create(AOwner: TComponent); begin inherited; FPort := 554; FProtocol := ippRTSP; FReconnectDelay := 1000; if not(csDesigning in ComponentState) then begin FSourceThread := TocvFFMpegIPCamSourceThread.Create(Self); FSourceThread.OnNotifyData := OnNotifyData; FSourceThread.FThreadDelay := FThreadDelay; FSourceThread.FreeOnTerminate := True; end; end; procedure TocvFFMpegIPCamSource.DoNotifyEvent(Event: TocvFFMpegIPCamEvent); begin if Assigned(OnIPCamEvent) then OnIPCamEvent(Self, Event); end; procedure TocvFFMpegIPCamSource.DoNotifyPacket(const packet: TAVPacket; const isKeyFrame: Boolean); begin if Assigned(OnFFMpegPacket) then OnFFMpegPacket(Self, packet, isKeyFrame); end; function TocvFFMpegIPCamSource.GetIPCamTarget: AnsiString; begin Result := IPProtocolString[FProtocol]; if Length(Trim(UserName)) <> 0 then Result := Result + AnsiString(Trim(UserName)) + ':' + AnsiString(Trim(Password)) + '@'; Result := Result + AnsiString(IP) + ':' + AnsiString(IntToStr(Port)); if Length(Trim(URI)) > 0 then begin if (Result[Length(Result)] <> '/') and (URI[1] <> '/') then Result := Result + '/'; Result := Result + AnsiString(URI); end; end; procedure TocvFFMpegIPCamSource.Loaded; begin inherited; if Enabled then begin // Hack FEnabled := False; Enabled := True; end; end; procedure TocvFFMpegIPCamSource.SetEnabled(Value: Boolean); begin if FEnabled <> Value then begin if not(csDesigning in ComponentState) then begin (FSourceThread as TocvFFMpegIPCamSourceThread).FReconnectDelay := ReconnectDelay; (FSourceThread as TocvFFMpegIPCamSourceThread).SetIPCamUrl(GetIPCamTarget, Value); end; FEnabled := Value; end; end; procedure TocvFFMpegIPCamSource.SetReconnectDelay(const Value: Cardinal); begin if FReconnectDelay <> Value then begin FReconnectDelay := Value; if Assigned(FSourceThread) then (FSourceThread as TocvFFMpegIPCamSourceThread).FReconnectDelay := ReconnectDelay; end; end; procedure TocvFFMpegIPCamSource.TerminateSourceThread; begin if Assigned(FSourceThread) then (FSourceThread as TocvFFMpegIPCamSourceThread).FSuspendEvent.SetEvent; inherited; end; procedure TocvCaptureThread.SetCapture(const Value: pCvCapture); begin FLock.Enter; try FCapture := Value; finally FLock.Leave; end; end; { TocvFFMpegIPCamSourceThread } constructor TocvFFMpegIPCamSourceThread.Create(AOwner: TocvFFMpegIPCamSource); begin inherited Create(False); FOwner := AOwner; FReconnectDelay := 1000; FSuspendEvent := TEvent.Create; FSuspendEvent.ResetEvent; end; destructor TocvFFMpegIPCamSourceThread.Destroy; begin FSuspendEvent.Free; inherited; end; procedure TocvFFMpegIPCamSourceThread.DoNotyfy(Event: TocvFFMpegIPCamEvent); begin Synchronize( procedure begin FOwner.DoNotifyEvent(Event); end); end; procedure TocvFFMpegIPCamSourceThread.Execute; Var optionsDict: pAVDictionary; pFormatCtx: pAVFormatContext; pCodecCtx: pAVCodecContext; pCodec: pAVCodec; packet: TAVPacket; img_convert_context: pSwsContext; frame: pAVFrame; iplframe: pIplImage; procedure ReleaseAllocatedData; begin if Assigned(pCodecCtx) then begin avcodec_close(pCodecCtx); pCodecCtx := nil; end; if Assigned(pFormatCtx) then begin avformat_close_input(pFormatCtx); pFormatCtx := nil; end; if Assigned(iplframe) then begin cvReleaseImage(iplframe); iplframe := nil; end; if Assigned(frame) then begin av_frame_free(frame); frame := nil; end; if Assigned(optionsDict) then begin av_dict_free(optionsDict); optionsDict := nil; end; end; Var i, ret, videoStream: Integer; frame_finished: Integer; linesize: array [0 .. 3] of Integer; RDelay: Cardinal; begin av_register_all(); avformat_network_init(); optionsDict := nil; pFormatCtx := nil; pCodecCtx := nil; iplframe := nil; frame := nil; While (not Terminated) do begin FisReconnect := False; {$IFDEF DELPHIXE_UP} FSuspendEvent.WaitFor; {$ELSE} FSuspendEvent.WaitFor(10000); {$ENDIF} if Terminated then Break; ReleaseAllocatedData; DoNotyfy(ffocvTryConnect); av_dict_set(optionsDict, 'rtsp_transport', 'tcp', 0); av_dict_set(optionsDict, 'rtsp_flags', 'prefer_tcp', 0); av_dict_set(optionsDict, 'allowed_media_types', 'video', 0); av_dict_set(optionsDict, 'reorder_queue_size', '10', 0); av_dict_set(optionsDict, 'max_delay', '500000', 0); av_dict_set(optionsDict, 'stimeout', '1000000', 0); ret := avformat_open_input(pFormatCtx, PAnsiChar(FIPCamURL), nil, @optionsDict); // pFormatCtx if ret < 0 then begin DoNotyfy(ffocvErrorGetStream); FisReconnect := True; Continue; end; av_dict_free(optionsDict); optionsDict := nil; if avformat_find_stream_info(pFormatCtx, nil) < 0 then begin DoNotyfy(ffocvErrorGetStream); FisReconnect := True; Continue; end; // Dump information about file onto standard error av_dump_format(pFormatCtx, 0, PAnsiChar(FIPCamURL), 0); // Find the first video stream videoStream := -1; for i := 0 to pFormatCtx^.nb_streams - 1 do if (pFormatCtx^.streams[i]^.codec^.codec_type = AVMEDIA_TYPE_VIDEO) then begin videoStream := i; Break; end; if videoStream = -1 then begin DoNotyfy(ffocvErrorGetStream); FisReconnect := True; Continue; end; // Get a pointer to the codec context for the video stream pCodecCtx := pFormatCtx^.streams[videoStream]^.codec; // pCodecCtx // Find the decoder for the video stream pCodec := avcodec_find_decoder(pCodecCtx^.codec_id); if not Assigned(pCodec) then begin DoNotyfy(ffocvErrorGetStream); FisReconnect := True; Continue; end; if (pCodec^.capabilities and CODEC_CAP_TRUNCATED) = 0 then pCodecCtx^.flags := pCodecCtx^.flags or CODEC_FLAG_TRUNCATED; (* we dont send complete frames *) // Open codec if avcodec_open2(pCodecCtx, pCodec, nil) < 0 then begin DoNotyfy(ffocvErrorGetStream); FisReconnect := True; Continue; end; img_convert_context := sws_getCachedContext(nil, pCodecCtx^.Width, pCodecCtx^.Height, pCodecCtx^.pix_fmt, pCodecCtx^.Width, pCodecCtx^.Height, AV_PIX_FMT_BGR24, SWS_BILINEAR, nil, nil, nil); if (img_convert_context = nil) then begin DoNotyfy(ffocvErrorGetStream); FisReconnect := True; Continue; end; frame := av_frame_alloc(); iplframe := cvCreateImage(CvSize(pCodecCtx^.Width, pCodecCtx^.Height), IPL_DEPTH_8U, 3); // iplframe FillChar(linesize, SizeOf(linesize), 0); linesize[0] := iplframe^.widthStep; DoNotyfy(ffocvConnected); while (not Terminated) and (FSuspendEvent.WaitFor(0) = wrSignaled) and (not FisReconnect) do if av_read_frame(pFormatCtx, packet) >= 0 then begin if (packet.stream_index = videoStream) then begin Synchronize( procedure begin FOwner.DoNotifyPacket(packet, (packet.flags and AV_PKT_FLAG_KEY) <> 0); end); // Video stream packet avcodec_decode_video2(pCodecCtx, frame, frame_finished, @packet); if (frame_finished <> 0) then begin sws_scale(img_convert_context, @frame^.data, @frame^.linesize, 0, pCodecCtx^.Height, @iplframe^.imageData, @linesize); if Assigned(OnNotifyData) then Synchronize( procedure Var Image: IocvImage; begin Image := TocvImage.CreateClone(iplframe); OnNotifyData(FOwner, Image); Image := nil; end); end; end else begin DoNotyfy(ffocvLostConnection); FisReconnect := True; Break; end; av_free_packet(packet); end; if (not Terminated) and FisReconnect and (FReconnectDelay > 0) and (FSuspendEvent.WaitFor(0) = wrSignaled) then begin DoNotyfy(ffocvReconnect); RDelay := 0; while (not Terminated) and (RDelay < FReconnectDelay) do begin Sleep(100); Inc(RDelay, 100); end; if Terminated then Break; FisReconnect := False; end; end; ReleaseAllocatedData; avformat_network_deinit; end; procedure TocvFFMpegIPCamSourceThread.SetIPCamUrl(const AIPCam: AnsiString; const AEnabled: Boolean); begin if (FEnabled <> AEnabled) or (FIPCamURL <> AIPCam) then begin FSuspendEvent.ResetEvent; FisReconnect := True; FIPCamURL := AIPCam; FEnabled := AEnabled; if FEnabled then FSuspendEvent.SetEvent; end; end; {$IFDEF DELPHIXE2_UP} procedure TocvFFMpegIPCamSourceThread.TerminatedSet; begin inherited; FSuspendEvent.ResetEvent; end; {$ENDIF} end.