Запись видео с экрана

@inetinf · Регистрация: 29.07.2014

Студворк — интернет-сервис помощи студентам

Доброго времени суток
как можно реализовать запись с экрана монитора без звука и минимальной нагрузкой
даже не знаю в какую сторону копать

Добавлено через 31 минуту
поделитесь компонентом Delphi Screen Camera Component delphi xe5

raxper · 09.12.2014, 19:02

Посты #57 и #59.

@inetinf · 09.12.2014, 20:02 **[ТС]**

перечитав ваш пост в предыдущий раз я пропустил слово т.е. надо было добавить в процедуру video gl_rec:= gettickcount;

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
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);
    function WindowSnap(windowHandle: HWND; bmp: TBitmap): 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 TForm1.WindowSnap(windowHandle: HWND; bmp: TBitmap): boolean;
var
  r: TRect;
  user32DLLHandle: THandle;
  printWindowAPI: function(sourceHandle: HWND; destinationHandle: HDC; nFlags: UINT): BOOL; stdcall;
begin
  result := False;
  user32DLLHandle := GetModuleHandle(user32) ;
  if user32DLLHandle <> 0 then
  begin
    @printWindowAPI := GetProcAddress(user32DLLHandle, 'PrintWindow') ;
    if @printWindowAPI <> nil then
    begin
      GetWindowRect(windowHandle, r);
      bmp.Width := r.Right - r.Left;
      bmp.Height := r.Bottom - r.Top;
      bmp.Canvas.Lock;
      try
        result := printWindowAPI(windowHandle, bmp.Canvas.Handle, 0) ;
      finally
        bmp.Canvas.Unlock;
      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.

сейчас к сожалению нет возможности проверить

Добавлено через 12 минут
если честно не догоняю я вить начальное время записи засекаю и добавляю время
зачем еще раз засекать

Сообщение от inetinf

gl_rec+(gl_cnt*40)

@inetinf · 10.12.2014, 08:48 **[ТС]**

доброго времени суток
вроде все поправил все показывает рывками такое ощущение что не срабатывает добавление доп кадров

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
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);
    function WindowSnap(windowHandle: HWND; bmp: TBitmap): 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 TForm1.WindowSnap(windowHandle: HWND; bmp: TBitmap): boolean;
var
  r: TRect;
  user32DLLHandle: THandle;
  printWindowAPI: function(sourceHandle: HWND; destinationHandle: HDC; nFlags: UINT): BOOL; stdcall;
begin
  result := False;
  user32DLLHandle := GetModuleHandle(user32) ;
  if user32DLLHandle <> 0 then
  begin
    @printWindowAPI := GetProcAddress(user32DLLHandle, 'PrintWindow') ;
    if @printWindowAPI <> nil then
    begin
      GetWindowRect(windowHandle, r);
      bmp.Width := r.Right - r.Left;
      bmp.Height := r.Bottom - r.Top;
      bmp.Canvas.Lock;
      try
        result := printWindowAPI(windowHandle, bmp.Canvas.Handle, 0) ;
      finally
        bmp.Canvas.Unlock;
      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.

Добавлено через 4 минуты
наверно с моей тупезной не решить этот ребус

Добавлено через 2 часа 7 минут
из условия убрал gl_cnt* не вижу в ней необходимости
рывки все ровно остались

Сообщение от inetinf

if GetTickCount=gl_rec+(gl_cnt*40) then

может я не прав?

@wingblack · 12.12.2014, 01:00

Не знаю насколько это будет тут полезно - только что закончил черновой вариант записи битмапов в видео файл.
В качестве кодировщика взята внешняя консольная утилита ffmpeg, передача данных через анонимные пайпы с помощью удобных оберток PJConsoleApp и PJPipe (взято тут). С захватом или вообще передачей еще и аудио потока у меня вопрос не стоял, так что без звука.

@inetinf · 12.12.2014, 08:15 **[ТС]**

спс что откликнулись можете дать готовый год
ну не хватает моих мозгов

@wingblack · 12.12.2014, 09:53

Это только Proof-of-Concept

Кликните здесь для просмотра всего текста

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
uses PJConsoleApp, PJPipe
///////////
/// TButton
//////////
FPs:=TBytesStream.Create;
bmp:=TBitmap.Create;
bmp.PixelFormat:=pf32bit;
bmp.Width:=300;
bmp.Height:=300;
or I := 1 to 200 do begin
  bmp.Canvas.Rectangle(Random(300),Random(300),Random(300),Random(300));
  for j:= 0 to 300-1 do //Передаем только "сырые" пиксели
    fps.WriteBuffer(bmp.ScanLine[j]^,300*32 div 8)
end;
FPs.Position:=0;
FPipeOut:=TPJPipe.Create;
FPipeErr:=TPJPipe.Create;
FPipeIn:=TPJPipe.Create(fps.Size);// принудительно определяем размер буфера пайпы
FPipeIn.CopyFromStream(fps);
FPipeIn.CloseWriteHandle;//иначе программа ждет новые данные
FApp:=TPJConsoleApp.Create;
FApp.StdIn:=FPipeIn.ReadHandle;   
FApp.StdOut:=FPipeOut.WriteHandle;
FApp.StdErr:=FPipeErr.WriteHandle; 
FApp.CommandLine:='ffmpeg -y  -f rawvideo -pix_fmt rgb32  -s 300x300 -r 30 -i - -r 30 -g 1 out.mkv';
// -y (на все вопросы - "да") -f (формат данных) -pix_fmt (формат пикселя) -s (размер картинки)
// -r (fps видео) -i (источник данных, "-" = читать данные из входа консоли StdIn)
// дальнейшее воспринимается как информация о выходном файле
// -g (максимальное расстояние между ключевыми кадрами)
FApp.TimeSlice:=10;
FApp.OnWork:=Worker;// через каждые TimeSlice миллисекунд вызывается событие OnWork
FApp.Execute;
/////////////
 
procedure TForm1.Worker(Sender: TObject);
var s:TStringStream;
begin
s:=TStringStream.Create;
if FPipeOut.AvailableDataSize>0 then begin
  FPipeOut.CopyToStream(s);
  Memo2.Lines.Add(s.DataString);
end;
s.Clear;
if FPipeErr.AvailableDataSize>0 then begin
  FPipeErr.CopyToStream(s);
  Memo2.Lines.Add(s.DataString);
end;
s.Free;

Обращаю внимание, что ffmpeg имеет кучу настроек для входных и выходных данных о видео и звуке, в моем случае настройки кодирования эта программа подбирала сама. В интернете имеется довольно много информации как ею сжимать. Скажу лишь что рекомендую х264 (h264), настройки для кодирования которым большей частью не универсальны для ffmpeg, и лучше их смотреть на x264-wiki.
-g 1 ставилось чтобы можно было начать просмотр с любого кадра видео, т.к. воспроизведение начинается оттуда где есть ключевой кадр.
Буфер (внутренняя память) пайпы по умолчанию задается системой, у меня это оказалось примерно 4096 байт. При работе с пайпами нужно учитывать что операции чтения-записи буфера не завершаются (как бы зависают) если нечего читать/некуда записывать и ждут пока что-то запишут/почитают (я на некоторое время застрял из-за этого, потому что не мог понять почему однопоточная программа зависает при записи моих данных в пайпу).
Лучше всего будет установить размер буфер кратно размеру кадра, и заполнять её в отдельном потоке.
Как тут уже сказали - нужно следить за количеством FPS при записи. Т.е. количество переданных кадров за одну секунду должно соответствовать настройкам кодирования, поскольку ffmpeg пытается обработать все что ему передали сразу. Можно использовать параметр -re для входных данных - тогда ffmpeg эмулирует устройство захвата видео и читает кадры с той же скоростью с которой видео будет воспроизводится (тут остается только следить за заполненностью буфера пайпы).
Когда мы закончили писать данные в пайпу, то следует вызвать CloseWriteHandle поскольку иначе ffmpeg ожидает новых данных и не завершает работу как положено.

Как-то так.

Добавлено через 9 минут
Да, при передаче "сырой" картинки в ffmpeg нужно явно указать всю информацию о изображении, поскольку программке неоткуда её взять.

@inetinf · 12.12.2014, 10:04 **[ТС]**

спс а где взять PJConsoleApp, PJPipe лазил не нашел
да еще вот скачал прогу с исходниками есть демо работает а вот после компиляции не хотит поможете забраться прога прикольная возможностей куча у меня delphi X5 если че

raxper · 12.12.2014, 12:45

...если че, комментарии читайте:

Professional Screen Camera Delphi Unit (Delphi 7 to above)
Developed 2008 by Mohammad Reza Hanifeh Pour (MRH Software Co.)
Author E-Mail: mrh.info2007@gmail.com
Centeral Office Tel: +98-(21)(7764)(4130)
Office Address: 29 Rezai St. Namjo Av. F2 Tehran-Iran.

а у вас Delphi юникодная.

@inetinf · 12.12.2014, 13:14 **[ТС]**

я знаю что Professional Screen Camera Delphi Unit
как сделать что бы работала
delphi xe 5
или где посмотреть

Добавлено через 2 минуты
там не каких тормозов как раз что надо
по крайне мере в демо

raxper · 12.12.2014, 13:16

Смешно. Знаете и игнорируете. Сделать также как и с AVIWriter, заменить типы данных или перейти на старую версию Delphi.

@wingblack · 12.12.2014, 13:18

Сообщение от inetinf

спс а где взять PJConsoleApp, PJPipe лазил не нашел

PJConsoleApp http://delphidabbler.com/software/consoleapp там же ссылка на страницу с PJPipe

@inetinf · 12.12.2014, 13:59 **[ТС]**

Сообщение от raxp

Смешно. Знаете и игнорируете. Сделать также как и с AVIWriter

да я знаю заменил pchar на pansichar ток не помогло выдает ошибку не может создать файл avi

Добавлено через 1 минуту
в том варианте который прикрепил уже заменено

Добавлено через 13 минут
он вот тут ругается

Delphi
1
2
3
4
5
6
    // Open the movie file for writing....
    hr := AVIFileOpen(pfile, PAnsiChar(TempVideoFile), OF_WRITE or OF_CREATE, nil);
    if (hr <> AVIERR_OK) then begin
    if Assigned(FOnError) then FOnError(Self, 'Error on create AVI file.');
    goto Error;
    end;

Добавлено через 1 минуту
модуль ScrCam.pas

Добавлено через 9 минут
hr: HRESULT;

raxper · 12.12.2014, 14:02

Вам уже ранее заменяли типы, просто откройте модуль и сравните.

@inetinf · 12.12.2014, 14:15 **[ТС]**

да вы конечно "извращенец" заставляете думать мозгами спасибо большое вам за неоценимую помощь

Добавлено через 1 минуту
все заработало

raxper · 12.12.2014, 14:35

Шарман.

@inetinf · 16.12.2014, 09:35 **[ТС]**

Доброго времени суток прошу помощи)
нашел обновление Screen Camera
ругается гад
вот на эту строку

Delphi
1
2
3
4
5
          FTimerID := TimeSetEvent(FInterval,
                                   FInterval,
                                   TimeCallBack,
                                   FWindowHandle,
                                   TIME_PERIODIC);

[dcc32 Error] scHighTimer.pas(342): E2010 Incompatible types: 'NativeUInt' and 'Cardinal'
scHighTimer.txt

@inetinf · 16.12.2014, 13:21 **[ТС]**

delphi xe5

Добавлено через 13 минут
исправил на

Delphi
1
2
3
4
5
          FTimerID := TimeSetEvent(FInterval,
                                   FInterval,
                                   @TimeCallBack,
                                   FWindowHandle,
                                   TIME_PERIODIC);

теперь ругается что не знает TimeSeparator

Добавлено через 2 минуты

Delphi
1
2
      Result := Format('%u%s%2.2u%s%2.2u%s%2.2u',
        [Hours, TimeSeparator, Mins mod 60, TimeSeparator, Secs mod 60, DecimalSeparator, HSecs mod 100]);

Добавлено через 32 минуты
дико извиняюсь эти ошибки поправил арет что нету dsgnintf
если заменить на DesignIntf вроде норм но говорит что не знает TStringProperty фигня какая то

Добавлено через 12 минут
тема снята
еще раз спс raxp думаю он поймет

Добавлено через 2 часа 35 минут
помогите подобрать
параметры видео записи
delay every frames в мили секундах
и PlayBack frame rate : (fps) в fps
уже трясет и мозг пухнет от прочитанного

raxper · 16.12.2014, 20:03

40 мс период - есть частота 25 Гц (FPS) кадров.

@inetinf · 17.12.2014, 07:08 **[ТС]**

я так и ставлю при просмотре изображение дергается может мало памяти выделяется
когда снимается ну скажем 5 часть экрана то нормально а когда фул то дергается

Сообщение от inetinf

уже трясет и мозг пухнет от прочитанного

Добавлено через 29 минут
появилась еще одна проблема если выполнялся вот этот код то при закрытии кричит не верный дескриптор окна
хотя я не вижу криминала

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
procedure TForm1.ScreenCamera1Saving(Sender: TObject; Percent: Integer;
  StatusCaption: string; var Continue: Boolean);
begin
  Application.ProcessMessages;
//  AllowExit := False;
  if not FCancel then begin
    Form1.ProgressBar1.Visible:=True;
    Form1.ProgressBar1.Position := Percent;
    if Percent = 100 then begin
      FCancel         := False;
      Form1.ProgressBar1.Position := 0;
//      AllowExit       := True;
      end;
    Continue          := True;
    end
  else begin
    FCancel           := False;
    Form1.ProgressBar1.Position := 0;
//    AllowExit         := True;
    Continue          := False;
    end;
end;

raxper · 17.12.2014, 07:36

если выполнялся вот этот код

мне неизвестно, что это за код и откуда вы его дернули.

Новые блоги и статьи Все статьи Все блоги /
Запустил конкурс "тем и промптов для текстовых квестов созданных почти чисто ИИ" Adler 06.10.2026 Всем привет! За последние три-четыре дня я создал более 16 текстовых квестовых игр используя преимущественно по одному запросу к ИИ на игру. Мне так понравилось смотреть все ветки/ сцены во всех. . .	ИИ не может найти нужный язык в списке Supersumestria 05.10.2026 Я ему даю вот такое изображение и прошу найти и подчеркнуть немецкий язык. Возвращает он вот это: https:/ / i. **********/ vqBWLe2. png Нужную строчку в 3й колонке просто выдумал. . Это. . .	Новая последняя моя музыка в SUNO zorxor 05.10.2026 Здравствуйте, дорогие мои друзья! С большой радостью я хотел бы представить вам свою новую последнею музыку, которую сгенерировала мне по моей просьбе нейросеть SUNO. С уважением, zorxor. Это. . .	Программный домашний кинотеатр russiannick 27.09.2026 Сподобился на программный домашний кинотеатр. В качестве ЯВУ по традиции выбрал js. В помощники взял Яндекс-Алису. Было создано три зала на разные интересы. исторические и ретро сериал Хичкок. . .
Беседа с ИИ о программистах, недопускающих к созданию и правке кода генеративные ИИ и причины этого zorxor 21.09.2026 Раньше я радовался или получал некоторые эмоции, пусть небольшие, но всё же, от самого процесса написания кода, рекомпиляции и запуска, видя постепенное развитие программы и прочее. А теперь лень. . .	Мобильное приложение ColorStep pavlinmavlin 17.09.2026 Реализовал приложение Красный, Зеленый, Синий в Unity3d + c#. Название изменил на ColorStep. Приложение прошло модерацию и теперь доступно для скачивания. Делал его сам, шаг за шагом — и вот,. . .	Запрет дублирования строк в табличной части Maks 13.09.2026 Реализация из решения ниже выполнена на нетиповом справочнике "Нормы ТО" с табличной часть "Виды ТО", разработанного в КА2, со следующими реквизитами: - ВидТО (СправочникСсылка. ВидыТО); - ВидГСМ. . .	Скрипты Tampermonkey для CyberForum, ChatGPT, Claude и пр. Jin X 06.09.2026 Скрипты Tampermonkey для CyberForum, ChatGPT, Claude и пр. Работая с форумом и нейросетями в браузере часто хочется что-то подкорректировать или добавить какого-то функционала. Ниже прикреплён. . .

@inetinf 0 / 0 / 8 Регистрация: 29.07.2014 Сообщений: 514

	Запись видео с экрана 31.10.2014, 11:27. Показов 17972. Ответов 86 Метки нет (Все метки) Доброго времени суток как можно реализовать запись с экрана монитора без звука и минимальной нагрузкой даже не знаю в какую сторону копать Добавлено через 31 минуту поделитесь компонентом Delphi Screen Camera Component delphi xe5 0

raxper 10237 / 6615 / 498 Регистрация: 28.12.2010 Сообщений: 21,154 Записей в блоге: 1
	09.12.2014, 19:02
	Посты #57 и #59. 0

@wingblack 294 / 265 / 48 Регистрация: 09.04.2013 Сообщений: 1,038
	12.12.2014, 01:00
	Не знаю насколько это будет тут полезно - только что закончил черновой вариант записи битмапов в видео файл. В качестве кодировщика взята внешняя консольная утилита ffmpeg, передача данных через анонимные пайпы с помощью удобных оберток PJConsoleApp и PJPipe (взято тут). С захватом или вообще передачей еще и аудио потока у меня вопрос не стоял, так что без звука. 0

@inetinf 0 / 0 / 8 Регистрация: 29.07.2014 Сообщений: 514
	12.12.2014, 08:15 [ТС]
	спс что откликнулись можете дать готовый год ну не хватает моих мозгов 0

@inetinf 0 / 0 / 8 Регистрация: 29.07.2014 Сообщений: 514
	12.12.2014, 13:14 [ТС]
	я знаю что Professional Screen Camera Delphi Unit как сделать что бы работала delphi xe 5 или где посмотреть Добавлено через 2 минуты там не каких тормозов как раз что надо по крайне мере в демо 0

raxper 10237 / 6615 / 498 Регистрация: 28.12.2010 Сообщений: 21,154 Записей в блоге: 1
	12.12.2014, 13:16
	Смешно. Знаете и игнорируете. Сделать также как и с AVIWriter, заменить типы данных или перейти на старую версию Delphi. 0

raxper 10237 / 6615 / 498 Регистрация: 28.12.2010 Сообщений: 21,154 Записей в блоге: 1
	12.12.2014, 14:02
	Вам уже ранее заменяли типы, просто откройте модуль и сравните. 1

@inetinf 0 / 0 / 8 Регистрация: 29.07.2014 Сообщений: 514
	12.12.2014, 14:15 [ТС]
	да вы конечно "извращенец" заставляете думать мозгами спасибо большое вам за неоценимую помощь Добавлено через 1 минуту все заработало 0

raxper 10237 / 6615 / 498 Регистрация: 28.12.2010 Сообщений: 21,154 Записей в блоге: 1
	12.12.2014, 14:35
	Шарман. 0

raxper 10237 / 6615 / 498 Регистрация: 28.12.2010 Сообщений: 21,154 Записей в блоге: 1
	16.12.2014, 20:03
	40 мс период - есть частота 25 Гц (FPS) кадров. 0