Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Мультимедиа в Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 11.12.2014, 08:33   #1
inetinf
 
Регистрация: 26.09.2014
Сообщений: 6
По умолчанию Запись видео с экрана

Доброго времени суток есть исходный код он записывает видео с экрана но при просмотре видео показывает рывками
помогите найти ошибку
Код:
procedure TMyThread.video;
var
   z: integer;
begin
  if on_avi then
   begin
     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+40) then
                Begin
                   flag_:= false;
                   Synchronize(video);
                End;
          end;
     end;
end;


___________
Код нужно оформлять по правилам:
тегом [CODE]..[/СODE]
(кнопочка на панели форматирования с решёточкой #)
Не забывайте об этом!

Модератор.

Последний раз редактировалось Serge_Bliznykov; 11.12.2014 в 09:31.
inetinf вне форума Ответить с цитированием
Старый 11.12.2014, 11:38   #2
inetinf
 
Регистрация: 26.09.2014
Сообщений: 6
По умолчанию

я дико извиняюсь
причина обращения за помощью в том что записывается 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.
inetinf вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Чем записать видео с экрана ололошка30 Компьютерное железо 0 29.09.2014 01:25
Запись видео с экрана монитора gogol123 Помощь студентам 1 08.05.2012 21:06
Запись видео (по возможности со звуком) с экрана Guy C# (си шарп) 0 06.12.2011 19:52
Зпись видео с экрана в Linux unicode Софт 2 12.08.2009 03:14