1

德尔福6项目

我已经非常彻底地搜索了谷歌，但没有找到我的 delima 的答案。基本上我希望在我的应用程序、状态栏或标签中显示当前屏幕捕获会话的时间码和视频帧速率。我还需要将捕获同步到播放视频的软件播放器的帧速率，否则我会得到很多重复或丢失的帧。视频为 29.970 和 23.976 fps。所以我需要能够以某种方式为两者进行配置。

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

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

  1. 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.
4

2 回答 2

2

实际上挂钩正在播放视频的软件并与之同步，我不知道该怎么做。但在时间上工作可能会有所帮助。假设播放视频的软件也适时，应该可以顺利抓拍。

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

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

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

HowLongTimerShouldWait := LengthOfASingleFrame - TimeSpentCapturingPreviousFrame

多媒体定时器的好处是它们让您可以将其用作“一次性”，其中每个间隔都可以有不同的延迟时间。我通常将计时器设置为递归调用单个过程，直到它被标记为停止。

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

于 2012-12-25T04:57:13.657 回答
0

正如所承诺的，这是我根据一些谷歌搜索并在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. 在你的 form1 上放两个 Tedit 和一个 Tbutton 控件
  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.
于 2012-12-26T04:56:08.820 回答