Как рассчитать частоту кадров и тайм-код во время захвата экрана?

Проект Delphi 6

Я довольно тщательно искал в Google, но не нашел ответов на свои вопросы. В основном я хочу, чтобы временные коды и частота кадров видео текущего сеанса захвата экрана отображались в моем приложении, в строке состояния или на ярлыке. Мне это также нужно для синхронизации кадров с частотой кадров проигрывателя программного обеспечения, воспроизводящего видео, в противном случае я получаю много дубликатов или пропущенных кадров. видео 29,970 и 23,976 кадров в секунду. Так что мне нужно как-то настроить оба.

В настоящее время я могу снимать скриншоты с телевизионных карт и программных видеоплееров, таких как, vlc, ffplay, mplayer, virtualdub и т. Д.

Я не уверен, как внедрить необходимые процедуры в мою, не говоря уже о том, где. Я много читал о следующих пунктах ниже, но они у меня над головой, хотя я и делал много попыток:

  1. control timer1 - установка интервала в 34 не является точной, она дублирует или пропускает кадры во время захвата экрана
  2. gettimetick и timegettime
  3. timeBeginPeriod и timeEndPeriod
  4. QueryPerformanceTimer и QueryPerformanceCounter

Чтобы упростить процесс, я снял много кода оригинального проекта, чтобы показать только захват экрана. Вот полная процедура (вместе с некоторым выделенным экспериментальным кодом) для этого:

(заранее спасибо за любую помощь)

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, mmsystem,
  ExtCtrls, clipbrd, DXClass;

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    Panel1: TPanel;
    m1: TMemo;
    btnCapOnOff: TButton;
    txtHandle: TEdit;
    Edit2: TEdit;
    stDataRate: TStaticText;
    btnCopy: TButton;
    btnSetHDC: TButton;
    dxt1: TDXTimer;
    sb1: TScrollBox;
    Splitter1: TSplitter;
    im1: TImage;
    procedure btnCapOnOffClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure capturewindow;
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btnCopyClick(Sender: TObject);
    procedure btnSetHDCClick(Sender: TObject);
    procedure dxt1Timer(Sender: TObject; LagCount: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  start,
  finish : cardinal; //int64;
  i : integer;
  s : string;
  bm: tbitmap;
  dc: hdc=0;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  form1.DoubleBuffered:=true;
  sb1.DoubleBuffered:=true; // this is a scrollbox control
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
  im1.Picture.Bitmap.PixelFormat:=pf24bit;
  im1.Width:=352;
  im1.Height:=240;
end;

procedure TForm1.btnSetHDCClick(Sender: TObject);
begin
  if dc=0 then dc := getdc(strToint(txtHandle.text));
end;

procedure TForm1.capturewindow;
begin
  //timeBeginPeriod(1);
  start := timegettime;
  //sleep(1);
  bitblt(bm.canvas.Handle, 0,0, 352,240, dc, 0,0, srccopy);
  finish := timegettime-start;
  //m1.lines.Add(intTostr(finish)); // debugging: to spill out timing values, etc.
  im1.Picture.Bitmap := bm;
  stDataRate.Caption := 'Date Rate: '+intTostr(finish) + ' fps or ms';
end;

procedure TForm1.dxt1Timer(Sender: TObject; LagCount: Integer);
begin
  capturewindow;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
//  capturewindow; // timer1 is too slow or unpredictable
end;

// button: a cheeters way to turn On or Off capturing
procedure TForm1.btnCapOnOffClick(Sender: TObject);
begin
  if btnCapOnOff.caption='Cap is Off' then begin
    btnCapOnOff.caption:='Cap is On';
    //timer1.Enabled:=true; // capture the window // too slow
    dxt1.Enabled:=true;   // capture the window // a better timer control component (delphiX)

  end else begin
    btnCapOnOff.Caption:='Cap is Off';
    //timer1.Enabled:=false; // too slow
    dxt1.Enabled:=false; // stop capturing the window // a better timer control component (delphiX)
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  bm.free;
  releaseDC(dc,dc);
  //timeEndPeriod(1);
end;

procedure TForm1.btnCopyClick(Sender: TObject);
begin
  clipboard.assign(im1.picture.bitmap); // to take quick pics
end;

initialization
  bm := tbitmap.Create;
  bm.PixelFormat:=pf24bit;
  bm.Width:=352;
  bm.Height:=240;  beep;
end.

2 ответа

На самом деле, подключив программное обеспечение, которое воспроизводит видео, и синхронизируя его, я не уверен, как это сделать. Но работа над временем может помочь. Предполагая, что программное обеспечение для воспроизведения видео также точно рассчитано по времени, вы сможете получить плавный захват.

Этот учебник полезен: http://www.codeproject.com/Articles/1236/Timers-Tutorial

"Мультимедийные таймеры" предлагают хорошее разрешение (до 1 мс на большинстве машин), и я считаю их надежными.

Я бы попробовал использовать таймер производительности (queryperformancetimer, как вы уже упоминали) для определения времени вашей процедуры CaptureWindow. Затем, когда вы вызываете "timesetevent" в мультимедийном таймере, вычтите количество времени, затраченное на захват, из общего времени одного кадра и используйте его в качестве значения "uDelay".

HowLongTimerShouldWait := LengthOfASingleFrame - TimeSpentCapturingPreviousFrame

Приятной особенностью мультимедийных таймеров является то, что они позволяют использовать его как "один кадр", где каждый интервал может иметь различный период задержки. Я обычно устанавливаю таймер для рекурсивного вызова одной процедуры, пока она не помечается как остановленная.

Таким образом, с некоторой тонкой настройкой вы сможете получить частоту захвата в пределах +/-1 мс от фактического FPS видео.

Как и было обещано, вот код, который я придумал на основе некоторых поисков в Google и их обработки в Delphi. Следующие ссылки помогли мне кое-что (хотя из-за c/ C++/ C# я не мог так легко перевести на delphi), поэтому большая часть окончательного ответа была основана на множестве проб и ошибок:

  1. http://www.andrewduncan.ws/Timecodes/Timecodes.html
  2. http://puredata.hurleur.com/sujet-990-framenumber-timecode-conversion

Насколько мне известно, рутина работает безупречно. но, как вы знаете, мне нравятся мои числа, отформатированные для пробелов, поэтому я добавляю их к 2 цифрам, таким образом, число не сжимается взад и вперед, когда числа прогрессируют после 59.

Вот как это работает:

  1. Он вычисляет временной код на основе частоты кадров вашего видеоисточника (то есть 29,970 чересстрочных или прогрессивных и 23,976 для 24p пленки), поэтому просто введите номер кадра, и функция вернет временной код в строковом формате.

Пример подготовки / использования:

  1. поместите два элемента управления Tedit и один Tbutton на вашу форму1
  2. в событии button1 onClick введите это: edit2.text:= frameNo2timecode(strToint(edit1.text), 29.970);
  3. Теперь запустите программу и введите номер вашего кадра в первом edit1.text
  4. затем нажмите элемент управления button1, он вычислит временной код в edit2.text

Исходный код для расчета временного кода:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, math;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Edit2: TEdit;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function FrameNo2Timecode(fn: longint; rate: real): string;
var
  hours,mins,secs,milli: extended;
  hoursStr, minsStr, secsStr, milliStr: string;
function padzero(N: longint; Len: Integer): string;
begin
  FmtStr(Result, '%d', [N]);
  while Length(Result) < Len do
    Result := '0' + Result;
end;
begin
    hours := floor( (fn/rate)/3600) mod 60;
    hoursStr := padzero(floor(hours),2);
    mins  := floor( (fn/rate)/60.0) mod 60;
    minsstr  := padzero(floor(mins),2);
    secs  := floor( (fn/rate)) mod 60;
    secsstr  := padzero(floor(secs),2);
    milli := floor( (1000*fn/rate)) mod 6000 mod 1000;
    millistr := padzero(floor(milli),3);
    result := hoursStr +':'+ minsStr  +':'+ secsStr  +'.'+ milliStr;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  edit2.text := frameNo2timecode(strToint(edit1.text), 29.970);
end;

end.
Другие вопросы по тегам