Экранная лупа (линза)

Posted by obzor under Lazarus, Free Pascal

Делал линзу которая перемещается совместно с курсором, центр окна позиция курсора,
т.е окно которое выше уровня рабочего стола, в windows7 работало хорошо,
в Windows10 не хочет

andrestudio

Сделать скрин области экрана под окном линзы мне так и не удалось. А в Windows7 это было возможно. Посему окно линзы с согласно позиции курсора уже не по перемещать.

Arigato

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

P.S. Я, кажется, понял, как вы делали линзу. Раньше (Win 7) если окно имеет любую степень прозрачности, то скриншот делался так, будто бы этого окна и вовсе нет на экране. То есть даже если добавить 1 единицу прозрачности окну (что визуально фактически оставляет окно непрозрачным), мы уже могли спокойно считывать пиксели под окном). А в Win 10 теперь на скриншот попадает полупрозрачное окно, перекрывая задний фон.

andrestudio

да, так и есть. Достаточно было сделать это окно со степенью прозрачности.
Теперь это не прокатывает

Arigato

function ScreenShot(Left, Top, Width, Height: Integer): TBitmap;
var
  ScreenDC: HDC;
begin
  Result := nil;
  if (Width <= 0) or (Height <= 0) then Exit;

  Result := TBitmap.Create;
  try
    // Устанавливаем размер
    Result.SetSize(Width, Height);
    // Можно явно задать цветовой режим, но обычно не обязательно
    Result.PixelFormat := pf24bit;

    ScreenDC := GetDC(0); // контекст всего экрана
    if ScreenDC = 0 then
    begin
      Result.Free;
      Result := nil;
      Exit;
    end;

    try
      // Копируем область экрана напрямую в Canvas.Handle битмапа
      if not BitBlt(Result.Canvas.Handle, 0, 0, Width, Height,
                    ScreenDC, Left, Top, SRCCOPY) then
      begin
        Result.Free;
        Result := nil;
        Exit;
      end;
    finally
      ReleaseDC(0, ScreenDC);
    end;
  except
    Result.Free;
    raise;
  end;
end;

Вложения

	zoom.zip (887.2 Кб)
	Zoom_SRC.zip (108.6 Кб)

тема на форуме

Похожие статьи

• Проблема с движением 2D человека