[nixon232]

Началось все с того, что на ноутбуке, с заявленным разрешением, FHD
некорректно работает такой код:

Код:

h := WindowFromPoint(Mouse.CursorPos);
    SetForegroundWindow(h);
    GetWindowRect(h, r);
    
    bit := CaptureScreenRect(r);
OrigBMP.Assign(bit);
    bit.SaveToFile(ExtractFilePath(ParamStr(0)) + 'xxx.BMP');

Код:

function CaptureScreenRect( ARect: TRect )
: TBitmap;
var
  ScreenDC: HDC;
begin
  Result := TBitmap.Create;

    Result.Width := ARect.Right - ARect.Left;
    Result.Height := ARect.Bottom - ARect.Top;

    ScreenDC := GetDC( 0 );
    try
       BitBlt ( Result.Canvas.Handle, 0, 0,  Result.Width,
      Result.Height, ScreenDC,
        ARect.Left, ARect.Top, SRCCOPY );
    finally
 //    Result.SaveToFile('d:\1.bmp');
      ReleaseDC( 0, ScreenDC );
    end;

end;

Имеем в итоге картинку
такую
1.BMP

Меняем разрешение с 1920х1080 на 1600х900 и картинка в норме

2.BMP

В итоге решил проверить разрешениие

Код:

for m := 0 to Screen.MonitorCount - 1 do
    with Screen.Monitors[m] do

      Format('%d : Monitor %d x %d, Scale: %d', [m+ 1, width, height, PixelsPerInch]);

в корректном случае

1 : Monitor 1600 x 900, Scale: 96

в проблемном (при 1920 х1080

1 : Monitor 1536 x 864, Scale: 96

Потом думаю дай гляну масштабирование, оно оказалось нифига не 100, а 125, хотя по логу Scale 96 в обоих случаях. Откатил до 100 - проблема как таковая ушла, но как тогда сделать корректный скрин окна при масштабировании?

[Alegun]

Да как-то слишком уж изьяшно окошко фоткается - сначало область определяется, и затем только из целой снимки рабочего стола кусман с её размерами выкусывается, а при масштабировании окно немного по-другому место на экране занимает и кусок видимо поэтому от целой картинки отличается, вот может вдруг такой вариант для скриншотки больше подойдёт

Код:

procedure ScreenShot(hWnd: HWND; bm: TBitmap);
var
 RLeft, RTop, RWidth, RHeight: Word;
 R: TRect;
 dc: HDC;
 lpPal: PLogPalette;
begin
 dc:= GetDC(0);
 try
  if (not IsWindow(hWnd)) or (dc = 0) then Exit;
  GetWindowRect(hWnd, R);
  RLeft:= R.Left;
  RTop:= R.Top;
  RWidth:= R.Right-RLeft;
  RHeight:= R.Bottom-RTop;
  bm.Width:= RWidth;
  bm.Height:= RHeight;
  if (GetDeviceCaps(dc, RASTERCAPS) and RC_PALETTE = RC_PALETTE) then
   begin
    GetMem(lpPal, SizeOf(TLogPalette) + (255 * SizeOf(TPaletteEntry)));
    FillChar(lpPal^, SizeOf(TLogPalette) + (255 * SizeOf(TPaletteEntry)), #0);
    lpPal^.palVersion:= $300;
    lpPal^.palNumEntries:= GetSystemPaletteEntries(dc,0,256,lpPal^.palPalEntry);
    if (lpPal^.PalNumEntries <> 0) then bm.Palette:= CreatePalette(lpPal^);
    FreeMem(lpPal, SizeOf(TLogPalette) + (255 * SizeOf(TPaletteEntry)));
   end;
  BitBlt(bm.Canvas.Handle, 0, 0, RWidth, RHeight, dc, RLeft, RTop, SRCCOPY);
 finally
  ReleaseDc(0, dc);
 end;
end;

[nixon232]

Как ни странно, но ваш вариант дает такой же результат

3.BMP
То ли тут WindowRect Косячит? То ли В манифесте дело?
Если в свойствах - совместитмость убрать масштабирование, то скрин корректный, а разрешение пишет так

1 : Monitor 1920 x 1080, Scale: 120

[Vayrus]

Попробуйте эти варианты, не тестировал, в проблему вопроса вникать некогда)

Код:

//v1
function GetScreenShot(const AHandle: THandle; FileName: String; QuickSave: Boolean): Boolean;
var
  fBitmap: PBitmap;
  DC: HDC;
  Rect: TRect;
  OSD: POpenSaveDialog;
  Image: PPngObject;

begin
  Image := NewPngObject;
  fBitmap := nil;
  Result := False;
  DC := GetDC(AHandle);
  if DC <> 0 then
    try
      if not GetClientRect(AHandle, Rect) then Exit;
      fBitmap := NewDIBBitmap(Rect.Right - Rect.Left, Rect.Bottom - Rect.Top, pf32bit);
      Result := BitBlt(fBitmap.Canvas.Handle, 0, 0, fBitmap.Width, fBitmap.Height, DC, 0, 0, SRCCOPY);
      if not Result then Exit;
      Image.AssignHandle(fBitmap.Handle, false, 0);
      if not QuickSave then
        begin
        OSD := NewOpenSaveDialog('', '', DefOpenSaveDlgOptions );
        OSD.Filter := 'PNG - Portable Network Graphics|*.png';
        OSD.Filename := FileName;
        OSD.WndOwner := OpWnd;
        OSD.OpenDialog := false;
        if OSD.Execute then
          begin
          Image.SaveToFile(OSD.Filename);
          end;
        OSD.Free;
        end
      else Image.SaveToFile(FileName);
    finally
      fBitmap.Free;
      Image.Free;
      ReleaseDC(AHandle, DC);
    end;
end;

//v2
//WindowSnap(Self.Handle, Image1.Picture.Bitmap) ;
//Image1.Refresh;
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(huser32, '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; (*WindowSnap*)

//v3
procedure TForm1.Button1Click(Sender: TObject);
const
  FullWindow = True; // Set to false if you only want the client area.
var
  Win: HWND;
  DC: HDC;
  Bmp: TBitmap;
  FileName: string;
  WinRect: TRect;
  Width: Integer;
  Height: Integer;
begin
  Form1.Hide;
  try
    Application.ProcessMessages; // Was Sleep(500);
    Win := GetForegroundWindow;

    if FullWindow then
    begin
      GetWindowRect(Win, WinRect);
      DC := GetWindowDC(Win);
    end else
    begin
      Windows.GetClientRect(Win, WinRect);
      DC := GetDC(Win);
    end;
    try
      Width := WinRect.Right - WinRect.Left;
      Height := WinRect.Bottom - WinRect.Top;

      Bmp := TBitmap.Create;
      try
        Bmp.Height := Height;
        Bmp.Width := Width;
        BitBlt(Bmp.Canvas.Handle, 0, 0, Width, Height, DC, 0, 0, SRCCOPY);
        FileName := 'Screenshot_' + 
          FormatDateTime('mm-dd-yyyy-hhnnss', Now());
        Bmp.SaveToFile(Format('C:\Screenshots\%s.bmp', [FileName]));
      finally
        Bmp.Free;
      end;
    finally
      ReleaseDC(Win, DC);
    end;
  finally
    Form1.Show;
  end;
end;

[nixon232]

Первый вариант - так и не смог скомпилировать, не знаю, что за объекты\ методы там используются (хотя куда сохранять не критично думаю. схожий вариант делал - не помогло)
Вариант второй - был с ошибками, но работает. Итог : Слева/верху лишнего нет, но высота и ширина не те. Плюс на скрине (только) стиль окна вин 7 ,а по факту вин 10.

4.BMP

Третий - пробовал ранее.

[Alegun]

Интересная геометрия у экрана, почти 2:1, обычно это у ноутов 1.5:1, наверное что-то типа нестандарта, а виндовская "окнопечатка" нормально в буфер снимок копирует?, тогда здесь может эмуляция жима комбинации Alt+PrintScrn подойдёт, при обнаружении растяжки

[nixon232]

А как вы геометрию определяете? Я окно вручную растягивал. Или вы про 15хх на 8хх? вроде стандартный 15" Моник. Как доберусь до рабочего 27" проверю как там с масштабированием, но мне кажется, что баг останется

[nixon232]

Как и предпологал, ноут как таковой не причем. на стационаром та же ситуация. Любой Scale и беда с WindowRect'om