я дико извиняюсь
причина обращения за помощью в том что записывается 2 кадра и все
верхний пример выбросьте
Код:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, graphics, Controls, Forms,
Buttons,mmsystem,types, ExtCtrls, Classes, AviWriter_2, StdCtrls;
type
TForm1 = class(TForm)
SpeedButton1: TSpeedButton;
ListBox1: TListBox;
Edit1: TEdit;
Label1: TLabel;
Label2: TLabel;
procedure FormCreate(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure on_tmr(Sender: TObject);
procedure AviWriterProgress(Sender: TObject; FrameCount: Integer; var abort: Boolean);
procedure wdm;
end;
TMyThread = class(TThread)
private
{ Private declarations }
protected
procedure Execute; override;
procedure Video;
end;
var
Form1: TForm1;
//
AviWriter: TAviWriter_2;
on_avi: boolean;
flag_: boolean;
gl_wdm: string;
gl_rec,gl_cnt: integer;
b: tbitmap;
MyThread: TMyThread;
implementation
{$R *.dfm}
procedure TMyThread.video;
var
z: integer;
begin
if on_avi then
begin
// Form1.WindowSnap(GetDC(0), b);
BitBlt(b.Canvas.Handle, 0, 0, Screen.Width, Screen.Height,
GetDC(GetDesktopWindow), 0, 0, SRCCopy);
// --- вычисление отставания
z:= trunc(1000*(((gettickcount-gl_rec)/1000)-(gl_cnt*40/1000)));
AviWriter.AddStillImage(b,z);
AviWriter.AddFrame(b);
// gl_rec:= gettickcount;
end;
flag_:= true;
end;
procedure TMyThread.Execute;
Begin
while true do
begin
if flag_ then
begin
if (GetTickCount=gl_rec+(gl_cnt*40)) then
Begin
flag_:= false;
Synchronize(video);
End;
end;
end;
end;
function CheckFormat(SDate:string):string;
var IDateChar: string;
x,y : integer;
begin
IDateChar:= ':';
for y:=1 to length(IDateChar) do begin
x:=pos(IDateChar[y],SDate);
while x>0 do begin
Delete(SDate,x,1);
Insert('-',SDate,x);
x:= pos(IDateChar[y],SDate);
end
end;
CheckFormat:= SDate
end;
// режим видеозаписи ========================
procedure tform1.wdm;
var cnt: integer;
begin
on_avi:= not on_avi;
if on_avi then begin //инициализация-
//
with AviWriter do begin
gl_wdm:= CheckFormat(timetostr(time));
AviWriter.filename := gl_wdm + '.avi';
AviWriter.TempFileName:= ExtractFilePath(AviWriter.filename) + '~AWTemp' + ExtractFileName(AviWriter.filename);
// frameTime := 50;
//WavFileName := gl_out + '\' + '~AWTemp.wav'; //без задержки-
OnTheFlyCompression := true;
width:= GetSystemMetrics(0);
height:= GetSystemMetrics(1);
//
//Compression('WMV3');
//SetCompression('MJPG');
//SetCompression('MPG4');
SetCompression(listbox1.items[listbox1.itemindex]);
SetCompressionQuality(strtoint(edit1.text))
end;
AviWriter.InitVideo;
gl_rec:= gettickcount; //время записи-
end else begin //завершаем запись-
//inirec(gl_out + '\' + '~AWTemp.wav',44100,2,16);
//cnt:= (gettickcount-gl_rec) div 1000;
//AviWriter.AddWaveFile(gl_out + '\' + '~AWTemp.wav',0); //добавление с задержкой
AviWriter.FinalizeVideo;
AviWriter.WriteAvi;
//deletefile(pchar(gl_out + '\' + '~AWTemp.wav'));
end
end;
procedure Tform1.AviWriterProgress(Sender: TObject; FrameCount: Integer;
var abort: Boolean);
begin
gl_cnt:= FrameCount;
label2.Caption:= inttostr(gl_cnt);
end;
procedure Tform1.on_tmr(Sender: TObject);
begin
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
doublebuffered:= true;
SetWindowLong(application.Handle,GWL_EXSTYLE,GetWindowLong(application.Handle, GWL_EXSTYLE) or
not WS_EX_APPWINDOW);
//
b:= tbitmap.Create;
b.Width:= GetSystemMetrics(0);
b.Height:= GetSystemMetrics(1);
//
AviWriter:= TAviWriter_2.Create(nil);
AviWriter.Compressorlist(listbox1.Items);
AviWriter.OnProgress:= AviWriterProgress;
//
MyThread:=TMyThread.Create(False);
MyThread.Priority:=tpNormal;
// MyThread.FreeOnTerminate:=true;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
flag_:= false;
MyThread.Terminate;
freeandnil(AviWriter);
b.Free
end;
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
flag_:= not flag_;
if flag_ then gl_rec:= gettickcount; // засекаем-
wdm;
end;
end.