[dr. F.I.N.]

Добрый день. Стыдно, что обращаюсь, но до не могу понять, в чем загвоздка.
Суть в следующем: необходимо сделать снимок окна под курсором.
Зарегал глобарьную горячую клавишу. По событию на неё получаю Хендл окна под курсором и делаю с него снимок.

Код:

procedure TfMain.WMHotKey(var Msg: TWMHotKey);
var
  lpPoint: TPoint;
  DestDC: HDC;
  r: TRect;
  b: TBitmap;
begin
  if Msg.HotKey = id_Search then
  begin
    GetCursorPos(lpPoint);
    DestWND := WindowFromPoint(lpPoint);
    GetWindowRect(DestWnd, r);
    b := TBitmap.Create;
    b.Width := r.Right - r.Left;
    b.Height := r.Bottom - r.Top;
    DestDC := GetWindowDC(DestWND);
    try
      BitBlt(b.Canvas.Handle, 0, 0, r.Right - r.Left, r.Bottom - r.Top, DestDC, 0, 0, SRCCOPY);
      b.SaveToFile('c:\1.bmp');
      b.Free;
    finally
      ReleaseDC(DestWND, DestDC);
    end;
  end;
end;

В результате получаю снимок области ограниценной положением того окна, т.е. само это окно и все то, что лежит поверх него. А хотелось бы получить только изображение окна. В чем я ошибся?

[Pyro]

PrintWindow должен уметь это

[v1s2222]

Код:

var
  rcSrc:Trect;
  hSrcWnd:HWND;
  hDC1:HDC;
  hSrcDC:HDC;
  hBmp:HBITMAP ;
  Bmp:TBitmap;
  lpPoint: TPoint;
begin
  GetCursorPos(lpPoint);
  hSrcWnd := WindowFromPoint(lpPoint);
  bmp:=TBitmap.Create;
  GetWindowRect(hSrcWnd, rcSrc);
  if (rcSrc.Right - rcSrc.Left < 170) and (rcSrc.Bottom - rcSrc.Top < 40) then
  begin
    ShowWindow(hSrcWnd, SW_SHOWNORMAL);
    sleep(100);
    GetWindowRect(hSrcWnd, rcSrc);
  end;

  hDC1:= GetDC(hSrcWnd);
  hSrcDC:=CreateCompatibleDC(hDC1);
  hBmp := CreateCompatibleBitmap(hDC1, rcSrc.right - rcSrc.left, rcSrc.bottom - rcSrc.top);

  SelectObject(hSrcDC, hBmp);
  PrintWindow(hSrcWnd, hSrcDC, 0);
  BitBlt(
    hDC1,
    0,
    0,
    rcSrc.right - rcSrc.left,
    rcSrc.bottom - rcSrc.top,
    hSrcDC,
    0,
    0,
    SRCCOPY);

  bmp.Handle:=hbmp;
  bmp.SaveToFile('c:\screen_shot.bmp');

  DeleteObject(hBmp);
  DeleteDC(hSrcDC);
  ReleaseDC(hSrcWnd, hDC1);
  bmp.Free;

  Image1.Picture.LoadFromFile('c:\screen_shot.bmp');

При этом:

Код:

function PrintWindow(hwnd: HWND; hdcBlt: HDC; nFlags: UINT): BOOL; stdcall;
...
function PrintWindow; external user32 name 'PrintWindow';

[angvelem]

Сообщение от dr. F.I.N.

В результате получаю снимок области ограниценной положением того окна, т.е. само это окно и все то, что лежит поверх него. А хотелось бы получить только изображение окна. В чем я ошибся?

Код:

  BitBlt(b.Canvas.Handle, 0, 0, r.Right - r.Left, r.Bottom - r.Top, DestDC, 0, 0, SRCCOPY);

Почему здесь нули?

[angvelem]

Что то я тормознул с нулями. Вот небольшой пример, но на API.

Код:

program HotKey;

uses
  Windows, Messages;

type
  HATOM		= Integer;

var
  Wnd		: HWND;
  Msg		: TMsg;
  WndClass	: TWndClassEX;
  SnapShot	: HATOM;
  DestWnd	: HWND;
  aRect		: TRect;

function PrintWindow(Wnd : HWND; toDC : HDC; nFlags : UINT) : Boolean; stdcall external 'user32.dll';

//---------------------------------------------------------

procedure SaveToFile(BmpName : String; bmp : HBITMAP);
var
  bm		: Windows.TBitmap;
  pBitmap	: Pointer;
  BFH		: BITMAPFILEHEADER;
  BI		: BITMAPINFO;
  BitCount      : Word;
  DC            : HDC;
  FileHandle	: THandle;
  Size, Count   : DWORD;

  function BytesPerScanline(PixelsPerScanline, BitsPerPixel, Alignment: Longint): Longint;
  begin
    dec(Alignment);
    Result := ((PixelsPerScanline * BitsPerPixel) + Alignment) and not Alignment;
    Result := Result shr 3;
  end;

begin
  GetObject(bmp, Sizeof(bm), @bm);
  Size := BytesPerScanLine(bm.bmWidth, bm.bmBitsPixel, 32) * bm.bmHeight;
  GetMem(pBitmap, Size);
  try
    BitCount := bm.bmPlanes * bm.bmBitsPixel;

    FillChar(BI, SizeOf(BI), 0);
    with BI.bmiHeader do
    begin
      biSize          := SizeOf(BITMAPINFOHEADER);
      biWidth         := bm.bmWidth;
      biHeight        := bm.bmHeight;
      biPlanes        := 1;
      biBitCount      := BitCount;
      biSizeImage     := Size;
      if (BitCount < 16) then
        biClrUsed     := (1 shl BitCount);
    end;

    FillChar(BFH, SizeOf(BFH), 0);
    BFH.bfType    := $4D42;
    BFH.bfOffBits := SizeOf(BFH) + SizeOf(BITMAPINFOHEADER) + BI.bmiHeader.biClrUsed * SizeOf(RGBQUAD);
    BFH.bfSize    := BFH.bfOffBits + Size;

    DC := GetDC(0);
    GetDIBits(DC, bmp, 0, bm.bmHeight, pBitmap, BI, DIB_RGB_COLORS);
    ReleaseDC(0, DC);

    FileHandle := CreateFile(PChar(BmpName), GENERIC_WRITE, FILE_SHARE_WRITE, NIL, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
    WriteFile(FileHandle, BFH, SizeOf(BFH), Count, NIL);
    WriteFile(FileHandle, BI, SizeOf(BITMAPINFOHEADER) + BI.bmiHeader.biClrUsed * SizeOf(RGBQUAD), Count, NIL);
    WriteFile(FileHandle, pBitmap^, Size, Count, NIL);
    CloseHandle(FileHandle);
  finally
    FreeMem(pBitmap);
  end;
end;

//---------------------------------------------------------

procedure Method1;
var
  DC,
  DestDC,
  bmpDC   : HDC;
  bmp,
  oldbmp  : HBITMAP;
begin
  DC := GetDC(0);
  try
    bmpDC  := CreateCompatibleDC(DC);
    bmp    := CreateCompatibleBitmap(DC, aRect.Right - aRect.Left, aRect.Bottom - aRect.Top);
    oldbmp := SelectObject(bmpDC, bmp);
    try
      DestDC := GetWindowDC(DestWND);
      try
        BitBlt(bmpDC, 0, 0, aRect.Right - aRect.Left, aRect.Bottom - aRect.Top, DestDC, 0, 0, SRCCOPY);
        SaveToFile('1.bmp', bmp);
      finally
        ReleaseDC(DestWND, DestDC);
      end;
    finally
      DeleteObject(SelectObject(bmpDC, oldbmp));
    end;
  finally
    ReleaseDC(0, DC);
  end;
end;

//---------------------------------------------------------

procedure Method2;
var
  DC,
  bmpDC   : HDC;
  bmp,
  oldbmp  : HBITMAP;
begin
  DC := GetDC(0);
  try
    bmpDC  := CreateCompatibleDC(DC);
    bmp    := CreateCompatibleBitmap(DC, aRect.Right - aRect.Left, aRect.Bottom - aRect.Top);
    oldbmp := SelectObject(bmpDC, bmp);
    try
      PrintWindow(DestWnd, bmpDC, 0);
      SaveToFile('11.bmp', bmp);
    finally
      DeleteObject(SelectObject(bmpDC, oldbmp));
    end;
  finally
    ReleaseDC(0, DC);
  end;
end;

//---------------------------------------------------------

procedure CreateSnapShot;
var
  Pt      : TPoint;
begin
  GetCursorPos(Pt);
  DestWND := WindowFromPoint(Pt);
  GetWindowRect(DestWnd, aRect);
  Method1;
  Method2;
end;

//---------------------------------------------------------

function MainProc(Wnd : HWND; Msg : Integer; wParam, lParam : Longint): Integer; stdcall;
begin
  Result := 0;

  case Msg of
    WM_CREATE :
    begin
      SnapShot := GlobalAddAtom('HotKey1');
      RegisterHotKey(Wnd, SnapShot, MOD_CONTROL or MOD_ALT, VK_SNAPSHOT);
    end;

    WM_HOTKEY :
      if wParam = SnapShot then
        CreateSnapShot;

    WM_DESTROY :
    begin
      UnRegisterHotKey(Wnd, SnapShot);
      GlobalDeleteAtom(SnapShot);
      PostQuitMessage(0);
      Exit;
    end;
  end;
  Result := DefWindowProc(Wnd, Msg, wParam, lParam);
end;

//---------------------------------------------------------

begin
  FillChar(WndClass, SizeOf(TWndClassEx), 0);
  WndClass.cbSize		:= SizeOf(TWndClassEx);
  WndClass.style		:= CS_HREDRAW or CS_VREDRAW;
  WndClass.lpfnWndProc		:= @MainProc;
  WndClass.cbClsExtra		:= 0;
  WndClass.cbWndExtra		:= 0;
  WndClass.hInstance		:= hInstance;
  WndClass.hCursor		:= LoadCursor(0, IDC_ARROW);
  WndClass.hbrBackGround	:= GetSysColorBrush(COLOR_BTNFACE);
  WndClass.lpszClassName	:= 'HotKey';

  if RegisterClassEx(WndClass) = 0 then
    Halt(255);

  Wnd := CreateWindowEx(0, 'HotKey', 'HotKey', WS_DLGFRAME or WS_SYSMENU or WS_MINIMIZE,
			0, 0, 320, 200, 0, 0, hInstance, NIL);

  ShowWindow(Wnd, SW_SHOWMINIMIZED);

  while(GetMessage(msg, 0, 0, 0)) do
  begin
    TranslateMessage(msg);
    DispatchMessage(msg);
  end;
  Halt(msg.wParam);
end.

Method2, использующий PrintWindow, корректно "снимает" перекрытое окно.