Delphi/Delphi-OpenCV
1
0
Fork 0
mirror of https://github.com/Laex/Delphi-OpenCV.git synced 2024-11-15 07:45:53 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

VideoWriter

Browse Source 
Signed-off-by: Laentir Valetov <laex@bk.ru>
This commit is contained in:
Laentir Valetov 2014-05-31 12:45:56 +04:00
parent e093d356cd
commit b03814236a
12 changed files with 264 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
source/component/Delphi18/OpenCV180.dpk
View File

@ -35,6 +35,7 @@ requires
contains
uOCVImageOperation in '..\uOCVImageOperation.pas',
uOCVVideoWriter in '..\uOCVVideoWriter.pas',
uOCVTypes in '..\uOCVTypes.pas',
uOCVSource in '..\uOCVSource.pas',
uOCVView in '..\uOCVView.pas';

1
source/component/Delphi19/OpenCV190.dpk
View File

@ -35,6 +35,7 @@ requires
contains
uOCVImageOperation in '..\uOCVImageOperation.pas',
uOCVVideoWriter in '..\uOCVVideoWriter.pas',
uOCVTypes in '..\uOCVTypes.pas',
uOCVSource in '..\uOCVSource.pas',
uOCVView in '..\uOCVView.pas';

1
source/component/Delphi20/OpenCV200.dpk
View File

@ -35,6 +35,7 @@ requires
contains
uOCVImageOperation in '..\uOCVImageOperation.pas',
uOCVVideoWriter in '..\uOCVVideoWriter.pas',
uOCVTypes in '..\uOCVTypes.pas',
uOCVSource in '..\uOCVSource.pas',
uOCVView in '..\uOCVView.pas';

3
source/component/Delphi20/OpenCV200.dproj
View File

@ -230,7 +230,7 @@
<DCC_UnitSearchPath>..;$(DCC_UnitSearchPath)</DCC_UnitSearchPath>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<VerInfo_Locale>1033</VerInfo_Locale>
<VerInfo_Keys>CompanyName=;FileDescription=OpenCV Component;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=OpenCV Component;ProductVersion=1.0.0.0;Comments=;LastCompiledTime=30.05.2014 19:19:54</VerInfo_Keys>
<VerInfo_Keys>CompanyName=;FileDescription=OpenCV Component;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=OpenCV Component;ProductVersion=1.0.0.0;Comments=;LastCompiledTime=31.05.2014 12:40:52</VerInfo_Keys>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2_Win64)'!=''">
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
@ -244,6 +244,7 @@
<DCCReference Include="rtl.dcp"/>
<DCCReference Include="vcl.dcp"/>
<DCCReference Include="..\uOCVImageOperation.pas"/>
<DCCReference Include="..\uOCVVideoWriter.pas"/>
<DCCReference Include="..\uOCVTypes.pas"/>
<DCCReference Include="..\uOCVSource.pas"/>
<DCCReference Include="..\uOCVView.pas"/>

BIN
source/component/Delphi20/OpenCV200.res
View File

Binary file not shown.

2
source/component/Delphi20/dclOpenCV200.dproj
View File

@ -141,7 +141,7 @@
<DCC_DcuOutput>.</DCC_DcuOutput>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<VerInfo_Locale>1033</VerInfo_Locale>
<VerInfo_Keys>CompanyName=;FileDescription=OpenCV Component;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=OpenCV Component;ProductVersion=1.0.0.0;Comments=;LastCompiledTime=30.05.2014 19:19:57</VerInfo_Keys>
<VerInfo_Keys>CompanyName=;FileDescription=OpenCV Component;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=OpenCV Component;ProductVersion=1.0.0.0;Comments=;LastCompiledTime=31.05.2014 12:40:55</VerInfo_Keys>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2_Win64)'!=''">
<DCC_DcuOutput>.\$(Platform)\$(Config)</DCC_DcuOutput>

BIN
source/component/Delphi20/dclOpenCV200.res
View File

Binary file not shown.

4
source/component/uOCVRegister.pas
View File

@ -45,12 +45,12 @@ uses
{$ENDIF}
uOCVSource,
uOCVView,
uOCVImageOperation;
uOCVImageOperation, uOCVVideoWriter;
procedure Register;
begin
RegisterComponents('OpenCV', [TocvImageOperation, TocvCameraSource, TocvView, TocvFileSource, TocvIPCamSource,
TocvFFMpegIPCamSource]);
TocvFFMpegIPCamSource, TocvVideoWriter]);
RegisterClasses([
{} TocvNoneOperation,
{} TocvGrayScaleOperation,

43
source/component/uOCVSource.pas
View File

@ -97,7 +97,7 @@ type
protected
FSourceThread: TocvCustomSourceThread;
FThreadDelay: Integer;
procedure OnNotifyData(Sender: TObject; const IplImage: IocvImage);
procedure OnNotifyData(Sender: TObject; const IplImage: IocvImage); virtual;
procedure SetEnabled(Value: Boolean); virtual;
function GetEnabled: Boolean; override;
private
@ -105,8 +105,6 @@ type
FOnImage: TOnOcvNotify;
procedure TerminateSourceThread;
procedure ReleaseSource; virtual;
function GetHeight: Integer; virtual;
function GetWidth: Integer; virtual;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
@ -115,6 +113,7 @@ type
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)
@ -138,8 +137,6 @@ type
procedure SetCameraSource(const Value: TocvCameraCaptureSource);
procedure SetResolution(const Value: TocvResolution);
procedure SetCameraResolution;
function GetHeight: Integer; override;
function GetWidth: Integer; override;
public
constructor Create(AOwner: TComponent); override;
published
@ -375,6 +372,7 @@ begin
if Assigned(FCapture) then
begin
SetCameraResolution;
FFPS := cvGetCaptureProperty(FCapture, CV_CAP_PROP_FPS);
(FSourceThread as TocvCaptureThread).Capture := FCapture;
FSourceThread.Resume;
end;
@ -384,16 +382,6 @@ begin
end;
end;
function TocvCameraSource.GetHeight: Integer;
begin
Result := CameraResolution[FResolution].cHeight;
end;
function TocvCameraSource.GetWidth: Integer;
begin
Result := CameraResolution[FResolution].cWidth;
end;
procedure TocvCameraSource.SetCameraResolution;
begin
cvSetCaptureProperty(FCapture, CV_CAP_PROP_FRAME_WIDTH, CameraResolution[FResolution].cWidth);
@ -404,6 +392,8 @@ procedure TocvCameraSource.SetResolution(const Value: TocvResolution);
begin
if FResolution <> Value then
begin
FWidth := CameraResolution[Value].cWidth;
FHeight := CameraResolution[Value].cHeight;
FResolution := Value;
if Enabled then
begin
@ -434,18 +424,10 @@ begin
Result := FEnabled;
end;
function TocvCustomSource.GetHeight: Integer;
begin
Result := 0;
end;
function TocvCustomSource.GetWidth: Integer;
begin
Result := 0;
end;
procedure TocvCustomSource.OnNotifyData(Sender: TObject; const IplImage: IocvImage);
begin
FWidth := IplImage.Width;
FHeight := IplImage.Height;
FImage := IplImage.Clone;
if Assigned(OnImage) then
OnImage(Self, IplImage);
@ -853,8 +835,8 @@ begin
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);
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
isReconnect := True;
@ -862,12 +844,11 @@ begin
end;
frame := av_frame_alloc();
iplframe := cvCreateImage(CvSize(pCodecCtx^.width, pCodecCtx^.height), IPL_DEPTH_8U, 3); // iplframe
iplframe := cvCreateImage(CvSize(pCodecCtx^.Width, pCodecCtx^.Height), IPL_DEPTH_8U, 3); // iplframe
FillChar(linesize, SizeOf(linesize), 0);
linesize[0] := iplframe^.widthStep;
while (not Terminated) and (FSuspendEvent.WaitFor(0) = wrSignaled) do
begin
if av_read_frame(pFormatCtx, packet) >= 0 then
begin
if (packet.stream_index = videoStream) then
@ -881,7 +862,7 @@ begin
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);
sws_scale(img_convert_context, @frame^.data, @frame^.linesize, 0, pCodecCtx^.Height, @iplframe^.imageData, @linesize);
if Assigned(OnNotifyData) then
Synchronize(
procedure
@ -895,8 +876,8 @@ begin
isReconnect := True;
Break;
end;
av_free_packet(packet);
end;
end;
end;
ReleaseAllocatedData;
avformat_network_deinit;

37
source/component/uOCVTypes.pas
View File

@ -49,6 +49,7 @@ uses
Type
TocvRect = Type TRect;
TocvLine = record
S, E: TCvPoint;
end;
@ -240,10 +241,20 @@ Type
['{80640C0A-6828-42F8-83E7-DA5FD9036DFF}']
procedure AddReceiver(const OpenCVVideoReceiver: IocvDataReceiver);
procedure RemoveReceiver(const OpenCVVideoReceiver: IocvDataReceiver);
function GetName: string;
function GetImage: IocvImage;
function GetEnabled: Boolean;
function GetHeight: Integer;
function GetWidth: Integer;
function GetFPS: double;
property Enabled: Boolean Read GetEnabled;
property Image: IocvImage read GetImage;
property Name: String read GetName;
property Width: Integer Read GetWidth;
property Height: Integer Read GetHeight;
property FPS: double read GetFPS;
end;
TocvReceiverList = class(TThreadList) // <IocvDataReceiver>;
@ -256,10 +267,15 @@ Type
protected
FOpenCVVideoReceivers: TocvReceiverList;
FImage: IocvImage;
FWidth, FHeight: Integer;
FFPS: double;
function GetName: string; virtual;
procedure NotifyReceiver(const IplImage: IocvImage); virtual;
function GetImage: IocvImage;
function GetEnabled: Boolean; virtual;
function GetHeight: Integer; virtual;
function GetWidth: Integer; virtual;
function GetFPS: double; virtual;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
@ -277,6 +293,7 @@ Type
public
procedure TakeImage(const IplImage: IocvImage); virtual;
destructor Destroy; override;
function isSourceEnabled: Boolean; virtual;
published
property VideoSource: IocvDataSource Read FocvVideoSource write SetOpenCVVideoSource;
end;
@ -348,6 +365,16 @@ begin
Result := False;
end;
function TocvDataSource.GetFPS: double;
begin
Result := FFPS;
end;
function TocvDataSource.GetHeight: Integer;
begin
Result := FHeight;
end;
function TocvDataSource.GetImage: IocvImage;
begin
Result := FImage;
@ -358,6 +385,11 @@ begin
Result := Name;
end;
function TocvDataSource.GetWidth: Integer;
begin
Result := FWidth;
end;
procedure TocvDataSource.NotifyReceiver(const IplImage: IocvImage);
Var
r: Pointer; // IocvDataReceiver;
@ -417,6 +449,11 @@ begin
inherited;
end;
function TocvDataReceiver.isSourceEnabled: Boolean;
begin
Result := Assigned(VideoSource) and VideoSource.Enabled;
end;
procedure TocvDataReceiver.SetOpenCVVideoSource(const Value: IocvDataSource);
begin
if (FocvVideoSource <> Value) then

206
source/component/uOCVVideoWriter.pas Normal file
View File

@ -0,0 +1,206 @@
unit uOCVVideoWriter;
interface
Uses
System.SysUtils,
System.Classes,
ocv.highgui_c,
ocv.core_c,
ocv.core.types_c,
ocv.imgproc_c,
uOCVTypes;
Type
TocvFrameSize = class(TPersistent)
protected
procedure AssignTo(Dest: TPersistent); override;
private
FFrameSize: TcvSize;
public
constructor Create;
property cvFrameSize: TcvSize read FFrameSize write FFrameSize;
published
property Width: Integer read FFrameSize.Width write FFrameSize.Width;
property Height: Integer read FFrameSize.Height write FFrameSize.Height;
end;
TocvOnGetVideoFileName = procedure(Sender: TObject; Var AFileName: string) of object;
TocvOnGetVideoParams = procedure(Sender: TObject; Var FrameWidth, FrameHeight: Integer; Var VideoFPS: Double;
Var CodecFourCC: AnsiString) of object;
TocvVideoWriter = class(TocvDataReceiver)
private
FFps: Double;
FWriter: pCvVideoWriter;
FFourCC: AnsiString;
FFileName: TFileName;
FEnabled: Boolean;
FVideoAsSource: Boolean;
FFrameSize: TocvFrameSize;
FOnGetVideoFileName: TocvOnGetVideoFileName;
FOnGetVideoParams: TocvOnGetVideoParams;
procedure SetFourCC(const Value: AnsiString);
procedure SetFileName(const Value: TFileName);
procedure SetEnabled(const Value: Boolean);
procedure CloseWriter;
procedure OpenWriter;
procedure DoGetVideoFileName;
procedure DoGetVideoParams;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure TakeImage(const IplImage: IocvImage); override;
published
property Enabled: Boolean Read FEnabled write SetEnabled default false;
property FourCC: AnsiString read FFourCC write SetFourCC;
property FileName: TFileName read FFileName write SetFileName;
property VideoAsSource: Boolean read FVideoAsSource write FVideoAsSource default True;
property FrameSize: TocvFrameSize read FFrameSize write FFrameSize;
property OnGetVideoFileName: TocvOnGetVideoFileName read FOnGetVideoFileName write FOnGetVideoFileName;
property OnGetVideoParams: TocvOnGetVideoParams read FOnGetVideoParams write FOnGetVideoParams;
end;
implementation
{TocvVideoWriter}
procedure TocvVideoWriter.CloseWriter;
begin
if Assigned(FWriter) then
begin
cvReleaseVideoWriter(FWriter);
FWriter := nil;
end;
end;
constructor TocvVideoWriter.Create(AOwner: TComponent);
begin
inherited;
Enabled := false;
FourCC := 'XVID';
FVideoAsSource := True;
FFrameSize := TocvFrameSize.Create;
end;
destructor TocvVideoWriter.Destroy;
begin
CloseWriter;
FFrameSize.Free;
inherited;
end;
procedure TocvVideoWriter.DoGetVideoFileName;
Var
VFileName: String;
begin
if Assigned(OnGetVideoFileName) then
begin
VFileName := FileName;
OnGetVideoFileName(Self, VFileName);
FileName := VFileName;
end;
end;
procedure TocvVideoWriter.DoGetVideoParams;
var
W, H: Integer;
begin
if Assigned(OnGetVideoParams) then
begin
W := FrameSize.Width;
H := FrameSize.Height;
OnGetVideoParams(Self, W, H, FFps, FFourCC);
FrameSize.Width := W;
FrameSize.Height := H;
end;
end;
procedure TocvVideoWriter.OpenWriter;
begin
if Assigned(VideoSource) and (Length(Trim(FFourCC)) > 3) then
begin
CloseWriter;
if VideoAsSource then
begin
FrameSize.cvFrameSize := CvSize(VideoSource.Width, VideoSource.Height);
FFps := VideoSource.FPS;
end;
if (FrameSize.cvFrameSize.Width = 0) or (FrameSize.cvFrameSize.Height = 0) then
FrameSize.cvFrameSize := CvSize(640, 480);
if FFps = 0 then
FFps := 15;
DoGetVideoParams;
DoGetVideoFileName;
try
if (Length(Trim(FFourCC)) > 3) and (Length(Trim(FileName)) > 0) then
FWriter := cvCreateVideoWriter(PAnsiChar(AnsiString(FileName)), CV_FOURCC(FFourCC[1], FFourCC[2], FFourCC[3], FFourCC[4]),
FFps, FrameSize.cvFrameSize)
else
FWriter := nil;
except
FWriter := nil;
end;
end;
end;
procedure TocvVideoWriter.SetEnabled(const Value: Boolean);
begin
if FEnabled <> Value then
begin
CloseWriter;
FEnabled := Value;
end;
end;
procedure TocvVideoWriter.SetFileName(const Value: TFileName);
begin
if not SameText(FFileName, Value) then
begin
CloseWriter;
FFileName := Value;
end;
end;
procedure TocvVideoWriter.SetFourCC(const Value: AnsiString);
begin
if not SameText(FFourCC, Value) then
begin
CloseWriter;
FFourCC := Value;
end;
end;
procedure TocvVideoWriter.TakeImage(const IplImage: IocvImage);
begin
if Enabled then
begin
if not Assigned(FWriter) then
OpenWriter;
if Assigned(FWriter) then
cvWriteFrame(FWriter, IplImage.IpImage);
end;
end;
{TocvFrameSize}
procedure TocvFrameSize.AssignTo(Dest: TPersistent);
begin
inherited;
if Dest is TocvFrameSize then
FFrameSize := (Dest as TocvFrameSize).FFrameSize;
end;
constructor TocvFrameSize.Create;
begin
FFrameSize.Width := 640;
FFrameSize.Height := 480;
end;
end.

2
source/component/uOCVView.pas
View File

@ -121,8 +121,8 @@ type
function isSourceEnabled: Boolean;
function PaintRect: TRect;
protected
procedure TakeImage(const IplImage: IocvImage);
procedure SetVideoSource(const Value: TObject);
procedure TakeImage(const IplImage: IocvImage);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;