Форум программистов, компьютерный форум, киберфорум
Delphi для начинающих
Войти
Регистрация
Восстановить пароль
Блоги Сообщество Поиск Заказать работу  
 
Рейтинг 4.50/6: Рейтинг темы: голосов - 6, средняя оценка - 4.50
2 / 2 / 2
Регистрация: 16.02.2014
Сообщений: 153
RAD XE3+

Захват произвольной области экрана на нескольких мониторах (скриншот)

17.04.2021, 21:56. Показов 1350. Ответов 9

Студворк — интернет-сервис помощи студентам
Здравствуйте!
Пишу простой скриншотер с возможностью захвата произвольной области.
Столкнулся с проблемой - не удается реализовать работу программы с несколькими мониторами.
В чем выражается проблема:
При попытке сделать скриншот на втором мониторе - захватывается область на первом(как будто я сделал захват области на нём).
При попытке сделать скриншот на первом экране - Image1 "заливается" белым (прямоугольник выделенной области белого цвета)
Сразу приведу фрагменты кода, но на всякий случай приложил архив с проектом(+exe).

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

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
procedure TForm2.Button1Click(Sender: TObject);
var
  ScreenForm: TForm1;
begin
  // создаем полупрозрачную форму оверлей
  ScreenForm := TForm1.Create(nil);
  try
    // и растягиваем её на весь экран и позиционируем
    ScreenForm.Width := Screen.DesktopWidth;
    ScreenForm.Height := Screen.DesktopHeight;
    ScreenForm.Left := Screen.DesktopLeft;  // если 0 то программа работает только с 1 экраном - основным и корректно
    ScreenForm.Top := Screen.DesktopTop;    // если 0 то программа работает только с 1 экраном - основным и корректно
 
    // дальше прячем основную форму
    self.Hide;
    Application.ShowMainForm := FALSE;
 
    //показать форму оверлей
    ScreenForm.ShowModal;
 
    Image1.Picture.BitMap := ScreenForm.Bild;
 
    ScrollBox1.HorzScrollBar.Range := Image1.Picture.Width;
    ScrollBox1.VertScrollBar.Range := Image1.Picture.Height;
    self.Show;
  finally
    ScreenForm.Free;
  end;
end;


Захват области(+"исправление" прямоугольника выделенной области, если вдруг выделяли "снизу вверх"):
Кликните здесь для просмотра всего текста

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
procedure NormRect(var aRect: TRect);
var tmp:Integer;
begin
if  aRect.Left > aRect.Right  then
    begin
      tmp:=aRect.Left;
      aRect.Left:=aRect.Right;
      aRect.Right:=tmp;
    end;
if  aRect.Top > aRect.Bottom  then
    begin
      tmp:=aRect.Top;
      aRect.Top:=aRect.Bottom;
      aRect.Bottom:=tmp;
    end;
end;
 
function CaptureScreenRect(aRect: TRect): TBitMap;
var
 ScreenDC: HDC;
 ActHandles:HWND;
begin
  Result := TBitMap.Create;
  with Result, aRect do
  begin
    Result.Free;
    Result := TBitMap.Create;
    NormRect(aRect); // исправить координаты выделенной области
    Result.Width := aRect.Right - aRect.Left;
    Result.Height :=aRect.Bottom - aRect.Top;
    ActHandles := GetDesktopWindow;
    ScreenDC  := GetWindowDC(ActHandles);//GetDc(0); - пробовал так, но результат тот же
    try
     BitBlt(Result.Canvas.Handle, 0, 0, Result.Width, Result.Height, ScreenDC, aRect.Left, aRect.Top, SRCCOPY);
    finally
     ReleaseDC(ActHandles, ScreenDC);//ReleaseDC(0, ScreenDC); - пробовал так, но результат тот же
    end;
  end;
end;
Вложения
Тип файла: zip d.zip (3.32 Мб, 6 просмотров)
0
cpp_developer
Эксперт
20123 / 5690 / 1417
Регистрация: 09.04.2010
Сообщений: 22,546
Блог
17.04.2021, 21:56
Ответы с готовыми решениями:

Сделать скриншот произвольной области
Всем драсти вот нарыл в поиске такой исходник который делает скриншоты все работает вроде бы но иногда выходит такая ошибка Out of system...

Захват области экрана
Подскажите как можно захватывать выделенную область экрана? Я имею ввиду принтскрин выбранной области. Как работает clip2net и другие...

Скриншот области экрана
Подскажите, как грамотнее будет сделать программу скриншота области экрана (примерно 100х300) от 60 до 100 раз в секунду с последующей...

9
 Аватар для Пытливый
3763 / 2271 / 705
Регистрация: 29.05.2013
Сообщений: 9,622
17.04.2021, 23:42
Посмотрите эту темку.
1
Злостный нарушитель
 Аватар для Verevkin
10656 / 5804 / 1282
Регистрация: 12.03.2015
Сообщений: 26,799
18.04.2021, 00:02
Координаты могут быть и отрицательными. Надо работать с объектами TMonitor. Я года 4 назад писал одну прогу для чуваков из столицы одной незалэжной державы, чтоб доказать именно этот факт. Даже видос заснял.

1
2 / 2 / 2
Регистрация: 16.02.2014
Сообщений: 153
18.04.2021, 07:36  [ТС]
Цитата Сообщение от Verevkin Посмотреть сообщение
Координаты могут быть и отрицательными.
Действительно.
Заметил странный момент с координатам окна-оверлея
в кнопке "Сделать скриншот" вывожу в мемо инфу:
Delphi
1
2
3
4
Form2.Memo1.Lines.Add(Format( 'Координаты до CaptureScreenRect: left = %d, top = %d',[ScreenForm.Left, ScreenForm.Top]));
//показать форму оверлей
ScreenForm.ShowModal;
Form2.Memo1.Lines.Add(Format( 'Координаты после CaptureScreenRect: left = %d, top = %d',[ScreenForm.Left, ScreenForm.Top]));
А в функции CaptureScreenRect вывожу вывожу перед try:
Delphi
1
2
Form2.Memo1.Lines.Add(Format( 'Координаты оверлея в CaptureScreenRect: left = %d, top = %d',[Form1.Left, Form1.Top]));
Form2.Memo1.Lines.Add(Format( 'Координаты области: left = %d, top = %d',[aRect.Left, aRect.Top]));
Получаю следующее для основного монитора:
Координаты до CaptureScreenRect: left = -1920, top = 0
Координаты оверлея в CaptureScreenRect: left = 0, top = 0
Координаты области: left = 2476, top = 250
Координаты после CaptureScreenRect: left = -1920, top = 0


и для второго(он у меня слева):
Координаты до CaptureScreenRect: left = -1920, top = 0
Координаты оверлея в CaptureScreenRect: left = 0, top = 0
Координаты области: left = 622, top = 213
Координаты после CaptureScreenRect: left = -1920, top = 0


Почему в CaptureScreenRect нули?
по сути же вывожу одни и те же свойства
0
Модератор
4149 / 2360 / 812
Регистрация: 15.11.2015
Сообщений: 9,457
18.04.2021, 09:50
Цитата Сообщение от Verevkin Посмотреть сообщение
чтоб доказать именно этот факт
Слишком крутая прога получилась для доказательства такой вещи. Но прога интересная - взял на изучение.
0
Злостный нарушитель
 Аватар для Verevkin
10656 / 5804 / 1282
Регистрация: 12.03.2015
Сообщений: 26,799
18.04.2021, 09:53
Цитата Сообщение от AzAtom Посмотреть сообщение
Слишком крутая прога получилась для доказательства такой вещи. Но прога интересная - взял на изучение.
Где взял-то?
0
Модератор
4149 / 2360 / 812
Регистрация: 15.11.2015
Сообщений: 9,457
18.04.2021, 11:14
Verevkin, ты её выкладывал в какой-то теме.

Добавлено через 10 минут
Цитата Сообщение от CTAJIuH Посмотреть сообщение
Почему в CaptureScreenRect нули?
У тебя форма для выделения области почему-то не идёт на левый монитор, где left отрицательный. Но если выделить область, протянув мышку налево, то он нормально скопировал фрагмент экрана, включая монитор слева (с отрицательными координатами).
0
Злостный нарушитель
 Аватар для Verevkin
10656 / 5804 / 1282
Регистрация: 12.03.2015
Сообщений: 26,799
18.04.2021, 11:18
Цитата Сообщение от AzAtom Посмотреть сообщение
ты её выкладывал в какой-то теме.
Да?... Не помню. Склероз проклятый...
0
18.04.2021, 12:35

Не по теме:

Цитата Сообщение от Verevkin Посмотреть сообщение
Координаты могут быть и отрицательными.
О да... Это более глобальный фактор, чем может показаться. На MacOS та же фигня, причем на уровне SDK...

0
2 / 2 / 2
Регистрация: 16.02.2014
Сообщений: 153
22.05.2021, 03:38  [ТС]
Если в TForm1.FormMouseUp
сделать так:
Delphi
1
2
3
4
r.Left := downX-screen.Width;
r.Top := downY;
r.Right := X-screen.Width;
r.Bottom := Y;
то работает корректно, но только если у меня мониторы выставлены в настройках как [2][1] (доп монитор у меня слева)
если я в настройках винды меняю порядок на [1][2](как будто я переставил доп монитор справа), то данное "исправление" не работает(тут у меня не получилось подобрать что и из чего вычитать).

Как определять координаты правильные?
Не могу понять что и из чего вычитать/складывать

Добавлено через 1 час 38 минут
омг! неужто осенило!)
неужели все так просто было?)

Вместо фрагмента из предыдущего сообщения прописал это:
Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
  if Screen.DesktopLeft < 0 then
  begin
    r.Left := downX-screen.Width;
    r.Right := X-screen.Width;
  end
  else
  begin
  r.Left := downX;
    r.Right := X;
  end;
 
  if Screen.DesktopTop < 0 then
  begin
    r.Top := downY-screen.Height;
    r.Bottom := Y-screen.Height;
  end
  else
  begin
    r.Top := downY;
    r.Bottom := Y;
  end;
и вроде работает!

Подскажите пожалуйста - хорошее ли это решение и какие могут быть "подводные камни" при такой реализации?

P.S.:
правда проверял только меняя настройки мониторов в винде(по другому не знаю как проверить):
[1][2]

[2][1]

[1]
[2]

[2]
[1]
0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
raxper
Эксперт
30234 / 6612 / 1498
Регистрация: 28.12.2010
Сообщений: 21,154
Блог
22.05.2021, 03:38
Помогаю со студенческими работами здесь

Скриншот области экрана
Здравствуйте, есть некий фрагмент кода: private static string getString() { string imgText = null; ...

Снять скриншот с области экрана
Написано на borland turbo c++ 2006, проблемма состоит в том, что я не знаю как снимать не весь скрин экрана, а допустим только мною...

[WPF] Скриншот выделенной области экрана
Подскажите, пожалуйста, как правильно проделать следующие действия: пользователь нажимает кнопку &quot;Сфотографировать&quot;, затем...

Как сделать скриншот области экрана?
Есть пример на Делфи http://delphiexpert.ru/sozdanie-skrinshotera-na-delphi.html, но в Lazarus отсуствует Transparentcolor свойство. ...

Скриншот не всего экрана, а только изменившейся области
В общем задача такая. Вишу программу для удаленного управления. Для оптимизации решил отправлять не целые скриншоты а только области на...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
10
Ответ Создать тему
Новые блоги и статьи
My Business CRM
MaGz GoLd 16.04.2026
Всем привет, недавно возникла потребность создать CRM, для личных нужд. Собственно программа предоставляет из себя базу данных клиентов, в которой можно фиксировать звонки, стадии сделки, а также. . .
Знаешь почему 90% людей редко бывают счастливыми?
kumehtar 14.04.2026
Потому что они ждут. Ждут выходных, ждут отпуска, ждут удачного момента. . . а удачный момент так и не приходит.
Фиксация колонок в отчете СКД
Maks 14.04.2026
Фиксация колонок в СКД отчета типа Таблица. Задача: зафиксировать три левых колонки в отчете. Процедура ПриКомпоновкеРезультата(ДокументРезультат, ДанныеРасшифровки, СтандартнаяОбработка) / / . . .
Настройки VS Code
Loafer 13.04.2026
{ "cmake. configureOnOpen": false, "diffEditor. ignoreTrimWhitespace": true, "editor. guides. bracketPairs": "active", "extensions. ignoreRecommendations": true, . . .
Оптимизация кода на разграничение прав доступа к элементам формы
Maks 13.04.2026
Алгоритм из решения ниже реализован на нетиповом документе, разработанного в конфигурации КА2. Задачи, как таковой, поставлено не было, проделанное ниже исключительно моя инициатива. Было так:. . .
Контроль заполнения и очистка дат в зависимости от значения перечислений
Maks 12.04.2026
Алгоритм из решения ниже реализован на примере нетипового документа "ПланированиеПерсонала", разработанного в конфигурации КА2. Задача: реализовать контроль корректности заполнения дат назначения. . .
Архитектура слоя интернета для сервера-слоя.
Hrethgir 11.04.2026
В продолжение https:/ / www. cyberforum. ru/ blogs/ 223907/ 10860. html Знаешь что я подумал? Раз мы все источники пишем в голове ветки, то ничего не мешает добавить в голову такой источник, который сам. . .
Подстановка значения реквизита справочника в табличную часть документа
Maks 10.04.2026
Алгоритм из решения ниже реализован на примере нетипового документа "ПланированиеПерсонала", разработанного в конфигурации КА2. Задача №1: при указании работ (справочник РаботыПоРемонтуСпецтехники),. . .
КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2026, CyberForum.ru