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

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

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

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

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

raxper · 28.11.2014, 13:14

VHScrCap SDK http://www.pcworld.com/product... rsion.html + http://www.splitmedialabs.com

Добавлено через 34 секунды

Походу во всем коде надо менять Char на AnsiChar.

походу версии Delphi нужно указывать, у меня не юникод.

@FIL · 28.11.2014, 13:27

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

версии Delphi нужно указывать

так ТС указал

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

delphi xe5

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

у меня не юникод

Это понятно. Я просто хотел сказать, что переделать под юникод просто и легко не получится - надо во всем коде типы переправлять.

@inetinf · 28.11.2014, 13:35 **[ТС]**

смена кодека не помогает
просмотрел код приведение этих типов нашел только здесь в этой функции

raxper · 28.11.2014, 13:39

Это понятно.

так вот я и поправил, указал свою

Я просто хотел сказать, что переделать под юникод просто и легко не получится - надо во всем коде типы переправлять.

открываем единственный модуль в блокноте, в меню "Правка/Заменить", пишем вместо char на ansichar, жмакаем кнопку "Заменить все"

@inetinf · 28.11.2014, 14:04 **[ТС]**

может использование VHScrCap проще будет чем переписывать код
подскажите где взять и как её использовать VHScrCap по ссылке там жмешь посылает куда то )

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

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

пишем вместо char на ansichar, жмакаем кнопку "Заменить все"

в коде встречаются и WideChar PChar WChar с ними чаво

Добавлено через 20 минут
я наверное посидею быстрей чем найду как записывать видео

@FIL · 28.11.2014, 15:41

Подправил под юникодные версии Дельфи:
AviWriter_2_u.rar
По крайней мере запись видео работает.

@inetinf · 01.12.2014, 13:05 **[ТС]**

спс большое все работает только вот 1 минута весит 1 гиг)

raxper · 01.12.2014, 14:09

...кодек выбрать следует. x263-4 или MJPEG из пакета k-lite неплохи.

@inetinf · 01.12.2014, 15:00 **[ТС]**

есть ли возможность транслировать видео в инет он лайн

Добавлено через 44 секунды

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

x263-4 или MJPEG из пакета k-lite

попробую спасибо

raxper · 01.12.2014, 16:55

Транслировать? Используйте DSPack.

@inetinf · 01.12.2014, 18:03 **[ТС]**

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

Транслировать? Используйте DSPack.

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

Добавлено через 1 минуту
что значит снимаю то что транслируется часть экрана

raxper · 01.12.2014, 20:18

DSPack. Это пакет компонентов такой, обертка над DirectShow интерфейсами под Delphi. Примеры в комплекте, конкретно по передаче - работа с классом TASFWriter.

Если так хочется транслировать по сети экран рабочего стола, то есть и VLC API, у него это фича из коробки, это первый же мой пост в данной теме.

@inetinf · 02.12.2014, 15:29 **[ТС]**

спасибо обязательно посмотрю

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

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

AviWriter_2_u.rar

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

raxper · 02.12.2014, 16:43

...нечего дергать из VCL, используйте потоки.

@inetinf · 02.12.2014, 17:54 **[ТС]**

извините что надоедаю можете дать пример

raxper · 02.12.2014, 21:49

http://www.delphi-manual.ru/threads.php

@inetinf · 03.12.2014, 08:09 **[ТС]**

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

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
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 FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure SpeedButton1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
   TMyThread = class(TThread)
    private
    { Private declarations }
  protected
    procedure on_tmr(Sender: TObject);
    procedure AviWriterProgress(Sender: TObject; FrameCount: Integer;  var abort: Boolean);
    procedure wdm;
  end;
var
  Form1: TForm1;
  //
  ftimer: ttimer;
  AviWriter: TAviWriter_2;
  on_avi: boolean;
  gl_wdm: string;
  gl_rec,gl_cnt: integer;
  b: tbitmap;
  MyThread: TMyThread;
implementation
 
{$R *.dfm}
 
function 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 TMyThread.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             := ftimer.Interval;
    //WavFileName           := gl_out + '\' + '~AWTemp.wav'; //без задержки-
    OnTheFlyCompression   := true;
    width:= GetSystemMetrics(0);
    height:= GetSystemMetrics(1);
    //
    //Compression('WMV3');
    //SetCompression('MJPG');
    //SetCompression('MPG4');
    SetCompression(Form1.listbox1.items[Form1.listbox1.itemindex]);
    SetCompressionQuality(strtoint(Form1.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 TMyThread.AviWriterProgress(Sender: TObject; FrameCount: Integer;
  var abort: Boolean);
begin
 gl_cnt:= FrameCount;
 Form1.label2.Caption:= inttostr(gl_cnt)
end;
 
procedure TMyThread.on_tmr(Sender: TObject);
var  z: integer;
begin
 //захват по кадрово-
 if on_avi then begin
 
  //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*ftimer.Interval/1000)));
  //AviWriter.AddStillImage(b,z)
  AviWriter.AddFrame(b)
 end
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
 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:= MyThread.AviWriterProgress;
 //
 ftimer:= ttimer.Create(nil);
 ftimer.interval:= 50;
 ftimer.ontimer := MyThread.on_tmr;
 ftimer.Enabled := true;
end;
 
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
 freeandnil(ftimer);
 freeandnil(AviWriter);
 b.Free
end;
 
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
 MyThread.wdm
end;
 
end.

@FIL · 03.12.2014, 09:39

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

прикольно

Пока не очень)
Ты мануал-то по ссылке прочитал или только заголовок?)

raxper · 03.12.2014, 09:54

...таймер выкинуть, настройки перенести в кнопу, а не в поток, а захват перенести в поток из таймера.

@inetinf · 03.12.2014, 13:05 **[ТС]**

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

Пока не очень)

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

Добавлено через 21 секунду
век живи век учись

Добавлено через 1 час 19 минут
вот что получилось где то еще надо править не пойму

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
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 FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure SpeedButton1Click(Sender: TObject);
  private
    { Private declarations }
  public
    procedure AviWriterProgress(Sender: TObject; FrameCount: Integer;  var abort: Boolean);
    procedure wdm;
    { Public declarations }
  end;
   TMyThread = class(TThread)
    private
    { Private declarations }
  protected
    procedure on_tmr(Sender: TObject);
  end;
var
  Form1: TForm1;
  //
  ftimer: ttimer;
  AviWriter: TAviWriter_2;
  on_avi: boolean;
  gl_wdm: string;
  gl_rec,gl_cnt: integer;
  b: tbitmap;
  MyThread: TMyThread;
implementation
 
{$R *.dfm}
 
function 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             := ftimer.Interval;
    //WavFileName           := gl_out + '\' + '~AWTemp.wav'; //без задержки-
    OnTheFlyCompression   := true;
    width:= GetSystemMetrics(0);
    height:= GetSystemMetrics(1);
    //
    //Compression('WMV3');
    //SetCompression('MJPG');
    //SetCompression('MPG4');
    SetCompression(Form1.listbox1.items[Form1.listbox1.itemindex]);
    SetCompressionQuality(strtoint(Form1.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;
 Form1.label2.Caption:= inttostr(gl_cnt)
end;
 
procedure TMyThread.on_tmr(Sender: TObject);
var  z: integer;
begin
 //захват по кадрово-
 if on_avi then begin
 
  //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*ftimer.Interval/1000)));
  //AviWriter.AddStillImage(b,z)
  AviWriter.AddFrame(b)
 end
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
 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;
 
 ftimer:= ttimer.Create(nil);
 ftimer.interval:= 50;
 ftimer.ontimer := MyThread.on_tmr;
 ftimer.Enabled := False;
 
end;
 
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
 freeandnil(ftimer);
 freeandnil(AviWriter);
 b.Free
end;
 
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
  ftimer.Enabled := True;
  wdm;
end;
 
end.

Добавлено через 55 минут
если выкинуть таймер прога виснет

Delphi
1
2
3
4
5
6
7
8
9
10
11
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
//  ftimer.Enabled := True;
  wdm;
    while True do
       Begin
         MyThread.on_tmr;
         if MyThread.Terminated then break;
         Sleep(50);
       End;
end;

Добавлено через 31 минуту
чет я не догоняю

Новые блоги и статьи Все статьи Все блоги /
Запустил конкурс "тем и промптов для текстовых квестов созданных почти чисто ИИ" 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. Показов 17974. Ответов 86 Метки нет (Все метки) Доброго времени суток как можно реализовать запись с экрана монитора без звука и минимальной нагрузкой даже не знаю в какую сторону копать Добавлено через 31 минуту поделитесь компонентом Delphi Screen Camera Component delphi xe5 0

@inetinf 0 / 0 / 8 Регистрация: 29.07.2014 Сообщений: 514
	28.11.2014, 13:35 [ТС]
	смена кодека не помогает просмотрел код приведение этих типов нашел только здесь в этой функции 0

@FIL Модератор 3492 / 2614 / 742 Регистрация: 19.09.2012 Сообщений: 7,978
	28.11.2014, 15:41
	Подправил под юникодные версии Дельфи: AviWriter_2_u.rar По крайней мере запись видео работает. 1

@inetinf 0 / 0 / 8 Регистрация: 29.07.2014 Сообщений: 514
	01.12.2014, 13:05 [ТС]
	спс большое все работает только вот 1 минута весит 1 гиг) 0

raxper 10237 / 6615 / 498 Регистрация: 28.12.2010 Сообщений: 21,154 Записей в блоге: 1
	01.12.2014, 14:09
	...кодек выбрать следует. x263-4 или MJPEG из пакета k-lite неплохи. 0

raxper 10237 / 6615 / 498 Регистрация: 28.12.2010 Сообщений: 21,154 Записей в блоге: 1
	01.12.2014, 16:55
	Транслировать? Используйте DSPack. 0

raxper 10237 / 6615 / 498 Регистрация: 28.12.2010 Сообщений: 21,154 Записей в блоге: 1
	01.12.2014, 20:18
	DSPack. Это пакет компонентов такой, обертка над DirectShow интерфейсами под Delphi. Примеры в комплекте, конкретно по передаче - работа с классом TASFWriter. Если так хочется транслировать по сети экран рабочего стола, то есть и VLC API, у него это фича из коробки, это первый же мой пост в данной теме. 0

raxper 10237 / 6615 / 498 Регистрация: 28.12.2010 Сообщений: 21,154 Записей в блоге: 1
	02.12.2014, 16:43
	...нечего дергать из VCL, используйте потоки. 0

@inetinf 0 / 0 / 8 Регистрация: 29.07.2014 Сообщений: 514
	02.12.2014, 17:54 [ТС]
	извините что надоедаю можете дать пример 0

raxper 10237 / 6615 / 498 Регистрация: 28.12.2010 Сообщений: 21,154 Записей в блоге: 1
	02.12.2014, 21:49
	http://www.delphi-manual.ru/threads.php 0

raxper 10237 / 6615 / 498 Регистрация: 28.12.2010 Сообщений: 21,154 Записей в блоге: 1
	03.12.2014, 09:54
	...таймер выкинуть, настройки перенести в кнопу, а не в поток, а захват перенести в поток из таймера. 0