unit Unit1;
{$MODE Delphi}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, LCLProc,
{$IFDEF MSWINDOWS} Windows, {$ENDIF}
BGRABitmap, BGRABitmapTypes,
FFUtils,
libavcodec, libavcodec_avfft, libavdevice,
libavfilter, libavfilter_avcodec, libavfilter_buffersink, libavfilter_buffersrc, libavfilter_formats,
libavformat, libavformat_avio, libavformat_url,
libavutil, libavutil_audio_fifo, libavutil_avstring, libavutil_bprint, libavutil_buffer,
libavutil_channel_layout, libavutil_common, libavutil_cpu, libavutil_dict, libavutil_error,
libavutil_eval, libavutil_fifo, libavutil_file, libavutil_frame, libavutil_imgutils,
libavutil_log, libavutil_mathematics, libavutil_md5, libavutil_mem, libavutil_opt,
libavutil_parseutils, libavutil_pixdesc, libavutil_pixfmt, libavutil_rational,
libavutil_samplefmt, libavutil_time, libavutil_timestamp, libswresample, libswscale;
type
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
function main(filename: string): integer;
var
pFormatCtx: PAVFormatContext;
pCodecCtx: PAVCodecContext;
filter_graph: PAVFilterGraph;
video_stream_index: integer = -1;
last_pts: int64; // = AV_NOPTS_VALUE;
ret, got_picture: integer;
pCodec: PAVCodec;
packet: TAVPacket;
pFrame: PAVFrame;
pFrameYUV: PAVFrame;
pFrameFilt: PAVFrame;
out_buffer: array of char;
img_convert_ctx: PSwsContext;
p0, p1, p2, pp0, pp1, pp2: PByte;
x, y: integer;
pBGRApixel0: PBGRApixel;
HSLAPixel0: THSLAPixel;
Bitmap0: TBGRABitmap;
Rect0: TRect;
label
TheEnd;
begin
pFrame := av_frame_alloc();
pFrameYUV := av_frame_alloc();
pFrameFilt := av_frame_alloc();
pFormatCtx := avformat_alloc_context();
if not Assigned(pFrame)
or not Assigned(pFrameFilt)
or not Assigned(pFormatCtx) then begin
Writeln(ErrOutput, 'Could not allocate frame');
Result := 1;
Exit;
end;
last_pts := AV_NOPTS_VALUE;
av_register_all();
avfilter_register_all();
// open file
if avformat_open_input(@pFormatCtx, PAnsiChar(ansistring(filename)), nil, nil) < 0 then begin
av_log(nil, AV_LOG_ERROR, 'Cannot open input file\n');
Result := -1;
Exit;
end;
if avformat_find_stream_info(pFormatCtx, nil) < 0 then begin
av_log(nil, AV_LOG_ERROR, 'Cannot find stream information\n');
Result := -1;
Exit;
end;
// select the video stream
video_stream_index := av_find_best_stream(pFormatCtx, AVMEDIA_TYPE_VIDEO, -1, -1, @pCodec, 0);
if video_stream_index < 0 then begin
av_log(nil, AV_LOG_ERROR, 'Cannot find a video stream in the input file\n');
Result := -1;
Exit;
end;
pCodecCtx := PPtrIdx(pFormatCtx.streams, video_stream_index).codec;
av_opt_set_int(pCodecCtx, 'refcounted_frames', 1, 0);
// init the video decoder
if avcodec_open2(pCodecCtx, pCodec, nil) < 0 then begin
av_log(nil, AV_LOG_ERROR, 'Cannot open video decoder\n');
Result := -1;
Exit;
end;
SetLength(out_buffer, avpicture_get_size(AV_PIX_FMT_RGB24, pCodecCtx.Width, pCodecCtx.Height));
avpicture_fill(PAVPicture(pFrameYUV), @out_buffer, AV_PIX_FMT_RGB24, pCodecCtx.Width, pCodecCtx.Height);
av_new_packet(@packet, pCodecCtx.Width * pCodecCtx.Height);
DebugLn('File Information---------------------------------');
av_dump_format(pFormatCtx, 0, PAnsiChar(ansistring(filename)), 0);
DebugLn('-------------------------------------------------------------------------------');
img_convert_ctx := sws_getContext(pCodecCtx.Width, pCodecCtx.Height, pCodecCtx.pix_fmt,
pCodecCtx.Width, pCodecCtx.Height, AV_PIX_FMT_RGB24, SWS_BICUBIC, nil, nil, nil);
Bitmap0 := TBGRABitmap.Create(pCodecCtx.Width, pCodecCtx.Height);
//Rect0 := Rect(0, 0, pCodecCtx.Width, pCodecCtx.Height);
Rect0.Top := 0;
Rect0.Left := 0;
Rect0.Right := pCodecCtx.Width;
Rect0.Bottom := pCodecCtx.Height;
X := 0;
while av_read_frame(pFormatCtx, @packet) >= 0 do begin
if packet.stream_index = video_stream_index then begin
ret := avcodec_decode_video2(pCodecCtx, pFrame, @got_picture, @packet);
if ret < 0 then begin
DebugLn('Decode Error.');
Exit;
end;
if got_picture <> 0 then begin
// sws_scale(img_convert_ctx, pFrame.Data, pFrame.linesize, 0,
// pCodecCtx.Height, pFrameYUV.Data, pFrameYUV.linesize);
// pFrameYUV.data;
// CopyMemory(Bitmap0.Bitmap.RawImage.Data, pFrame.Data[0], pCodecCtx.Width * pCodecCtx.Height);
p0 := pFrame.Data[0];
p1 := pFrame.Data[1];
p2 := pFrame.Data[2];
pBGRApixel0 := Bitmap0.Data + Bitmap0.NbPixels - 1;
for y := 0 to pFrame.Height - 1 do begin
Inc(p0, pFrame.linesize[0]);
Inc(p1, pFrame.linesize[0]);
Inc(p2, pFrame.linesize[0]);
for x := 0 to pFrame.Width - 1 do begin
//HSLAPixel0 := BGRAToHSLA(pBGRApixel0^);
//HSLAPixel0 := HSLA(p0^, p1^, p2^);
pBGRApixel0^ := BGRA(p0^, p1^, p2^, 0);
//HSLAToBGRA(HSLAPixel0);
Dec(pBGRApixel0);
Dec(p0);
Dec(p1);
Dec(p2);
end;
Inc(p0, pFrame.linesize[0]);
Inc(p1, pFrame.linesize[0]);
Inc(p2, pFrame.linesize[0]);
end;
Form1.Canvas.CopyRect(Rect0, Bitmap0.Canvas, Rect0);
X += 1;
//Form1.Caption := IntToStr(X) + ' - ' + IntToStr(av_rescale_q(pFrame.pts, AV_TIME_BASE_Q, AV_TIME_BASE_Q));
Form1.Caption := IntToStr(X) + ' - ' + IntToStr(pFrame.pts);
Application.ProcessMessages;
Sleep(10);
end;
end;
av_free_packet(@packet);
end;
Bitmap0.Free;
TheEnd: ;
avfilter_graph_free(@filter_graph);
avcodec_close(pCodecCtx);
avformat_close_input(@pFormatCtx);
av_frame_free(@pFrame);
av_frame_free(@pFrameYUV);
av_frame_free(@pFrameFilt);
if (ret < 0) and (ret <> AVERROR_EOF) then begin
Writeln(ErrOutput, Format('Error occurred: %s', [av_err2str(ret)]));
Result := 1;
Exit;
end;
Result := 0;
end;
{ TForm1 }
procedure TForm1.Button1Click(Sender: TObject);
begin
try
ExitCode := main(ParamStr(1));
except
on E: Exception do
Writeln(ErrOutput, 'Error: ' + E.ClassName + ': ' + E.Message);
end;
end;
end.