Delphi 6 プロジェクト
私はかなり徹底的にグーグルを検索しましたが、デリマへの答えが見つかりません. 基本的に、現在のスクリーン キャプチャ セッションのタイムコードとビデオ フレームレートをアプリのステータスバーまたはラベルに表示したいと考えています。ビデオを再生しているソフトウェアプレーヤーのフレームレートにキャプチャを同期することに関してもこれが必要です。そうしないと、多くの重複または欠落したフレームが発生します。ビデオは 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.