@DeeUs

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

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

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;


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

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_4ft...
  • Вопрос задан
  • 64 просмотра
Пригласить эксперта
Ваш ответ на вопрос

Войдите, чтобы написать ответ

Войти через центр авторизации
Похожие вопросы