Question

Delphi 6项目

我搜索谷歌非常彻底，但我找不到我的delima的答案。基本上我想在我的应用程序，状态栏或标签中显示当前屏幕捕获会话的时间码和视频帧率。关于将捕获同步到播放视频的软件播放器的帧率，我也需要这个，否则我会得到很多重复或错过的帧。视频分别为29.970和23.976 fps。所以我需要能够以某种方式为两者配置。

目前，我可以从电视卡和软件视频播放器（如vlc，ffplay，mplayer，virtualdub等）中截屏。

我不确定如何将必要的例程实施到我的，更不用说在哪里了。我已经阅读了很多关于下面这些项目的内容，但它们都在我脑海中，尽管我做了很多尝试：

timer1控制 - 将设置间隔设置为34并不准确，它会在屏幕捕获期间复制或错过帧
gettimetick和timegettime
timeBeginPeriod和timeEndPeriod
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.

Answer 1

实际挂钩播放视频的软件并与之同步，我不知道该怎么做。但是计时可能会有所帮助。假设播放视频的软件也很合适，你应该能够顺利捕获。

本教程很有用：http://www.codeproject.com/Articles/1236/Timers-Tutorial

“多媒体计时器”提供了良好的分辨率（在大多数机器上低至1毫秒），我发现它们是可靠的。

我会尝试使用Performance Timer（queryperformancetimer，正如您已经提到的那样）来计算“CaptureWindow”程序。然后，当您在多媒体计时器中调用“timesetevent”时，从单帧的整体时间中减去捕获所花费的时间，并将其用作“uDelay”值。

HowLongTimerShouldWait := LengthOfASingleFrame - TimeSpentCapturingPreviousFrame

多媒体计时器的优点在于它们可以让你将它用作“一次性”，每个间隔可以有不同的延迟时间。我通常将计时器设置为递归调用单个过程，直到它被标记为停止。

通过这种方式，通过一些微调，您应该能够获得捕获率在实际视频FPS的+/- 1ms容差范围内。

Answer 2

正如所承诺的，这是我根据一些谷歌搜索提出的代码，并在delphi中进行处理。以下链接确实帮助了我一些（但是由于c / c ++ / c＃我无法轻易地转换为delphi）所以大多数最终答案都基于大量的试验和错误：

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

据我所知，这个例行程序完美无瑕。但只是你知道，我喜欢我的数字用于间距目的，所以我填充到2位数，这样就不会在数字超过59时来回掠夺。

以下是它的工作原理：

它根据视频源的帧速率计算时间码（即29.970隔行扫描或逐行扫描，24p影片为23.976）。所以只需输入一个帧编号，该函数将以字符串格式返回时间码。 / LI>

预备/使用示例：

在你的form1上放了两个Tedit和一个Tbutton控件
在button1 onClick事件中，输入：edit2.text：= frameNo2timecode（strToint（edit1.text），29.970）;
现在，运行程序并在第一个edit1.text
然后，按下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.

如何在屏幕截图期间计算帧率和时间码？

2 个答案: