powered by simpleCommunicator - 2.0.59     © 2026 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Захват произвольной области экрана на нескольких мониторах (скриншот)
1 сообщений из 1, страница 1 из 1
Захват произвольной области экрана на нескольких мониторах (скриншот)
    #40063457
bigjoe
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Здравствуйте!
Пишу простой скриншотер с возможностью захвата произвольной области.
Столкнулся с проблемой - не удается реализовать работу программы с несколькими мониторами.
В чем выражается проблема:
При попытке сделать скриншот на втором мониторе - захватывается область на первом(как будто я сделал захват области на нём).
При попытке сделать скриншот на первом экране - Image1 "заливается" белым (прямоугольник выделенной области белого цвета)
Сразу приведу фрагменты кода, но на всякий случай приложил архив с проектом.

Кнопка "Сделать скриншот":

Код: pascal
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;




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

Код: pascal
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;




Архив с проектом почему то не прикрепляется, поэтому пришлось залить на гуглодиск
https://drive.google.com/file/d/1VSRkaWGla_TA7_4ftF05RayrCH2SRXJ1/view?usp=sharing
...
Рейтинг: 0 / 0
1 сообщений из 1, страница 1 из 1
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Захват произвольной области экрана на нескольких мониторах (скриншот)
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]